scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Subject: Extend type<->sexp conversion to variable type 

type->sexp was not capable of converting the variable type to a
sexp. This caused problems if the module system wanted to tell the
user that the types of exported bindings did not match:

config> (define-structure foo (export (bar :syntax)) (open scheme) (begin (define bar 1)))
; no values returned
config> ,user
> ,open foo

Error: exception
       wrong-type-argument
       (checked-record-ref '(variable #{Type :value #f #f}) '#{Record-type 14 meta-type} 1)

I've now extended TYPE->SEXP by a check for the variable type and let
it produce a list with 'VARIABLE as first and the actual type as
second element. Likewise, I extended SEXP->TYPE to produce a variable
type if 'VARIABEL is the first element of a list.

This seems to work but a second look by someone who really understands
the type system would be appreciated.

(Merge from s48 rev 423)
This commit is contained in:
mainzelm 2003-08-04 07:32:02 +00:00
parent 81c2e22c0c
commit 8eb6a07ec3
1 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
scheme/bcomp/mtype.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Type lattice.
; Sorry this is so hairy, but before it was written, type checking
@ -619,6 +619,8 @@
(reduce join-type (car l) (cdr l))))
((mask->type)
(mask->type (cadr x)))
((variable)
(variable-type (sexp->type (cadr x) r?)))
(else (error "unrecognized type" x))))
(else (error "unrecognized type" x))))
@ -641,18 +643,20 @@
; Convert type to S-expression
(define (type->sexp t r?)
(if (> (bitwise-and (type-mask t) mask/&rest) 0)
(if (same-type? t any-values-type)
':values
`(some-values ,@(rail-type->sexp t r?)))
(let ((j (disjoin-type t)))
(cond ((null? j) ':error)
((null? (cdr j))
(atomic-type->sexp (car j) r?))
(else
`(join ,@(map (lambda (t)
(atomic-type->sexp t r?))
j)))))))
(if (variable-type? t)
`(variable ,(type->sexp (variable-value-type t) r?))
(if (> (bitwise-and (type-mask t) mask/&rest) 0)
(if (same-type? t any-values-type)
':values
`(some-values ,@(rail-type->sexp t r?)))
(let ((j (disjoin-type t)))
(cond ((null? j) ':error)
((null? (cdr j))
(atomic-type->sexp (car j) r?))
(else
`(join ,@(map (lambda (t)
(atomic-type->sexp t r?))
j))))))))
(define (atomic-type->sexp t r?)
(let ((m (type-mask t)))