suzanne.soy/compatibility
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

.

Browse Source 
original commit: a34321d80bc6c79fb96dd1ebfeae0938d7820fcf
This commit is contained in:
Matthew Flatt 2001-01-07 04:00:48 +00:00
parent bc23159364
commit bbb274eb0a
2 changed files with 1158 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1124
collects/mzlib/signedunit.ss Normal file
View File

File diff suppressed because it is too large Load Diff

60
collects/mzlib/unit.ss
View File

@ -217,25 +217,30 @@
(set! id tmp)))]
[(bound-identifier=? (car evars) id)
;; set! exported id:
(with-syntax ([loc (car elocs)]
[tmp
(if name
(with-syntax ([tmp tmp]
[name name])
(syntax (let ([name tmp])
name)))
tmp)])
(with-syntax
([loc (car elocs)]
[tmp
(if name
(with-syntax
([tmp tmp]
[name name])
(syntax
(let ([name tmp])
name)))
tmp)])
(syntax/loc
defn-or-expr
(set-box! loc tmp)))]
[else (loop (cdr evars) (cdr elocs))])))])
[else (loop (cdr evars)
(cdr elocs))])))])
(if (null? (cdr ids))
(do-one (car ids) (syntax expr) (car ids))
(let ([tmps (generate-temporaries ids)])
(with-syntax ([(tmp ...) tmps]
[(set ...) (map (lambda (id tmp)
(do-one id tmp #f))
ids tmps)])
[(set ...)
(map (lambda (id tmp)
(do-one id tmp #f))
ids tmps)])
(syntax/loc
defn-or-expr
(let-values ([(tmp ...) expr])
@ -254,20 +259,23 @@
(with-syntax ([rest (loop (cdr l))]
[(var loc) (car l)])
(syntax
((letrec-syntax ([var
(set!-expander
(lambda (sstx)
(syntax-case sstx (set!)
[vr (identifier? (syntax vr)) (syntax (unbox loc))]
[(set! vr val)
(raise-syntax-error
'unit
"cannot set! imported or exported variables"
sstx)]
[(vr . args) (syntax ((unbox loc) . args))])))])
. rest))))))]
[num-imports (datum->syntax (length (syntax->list (syntax (iloc ...))))
#f (quote-syntax here))])
((letrec-syntax
([var
(set!-expander
(lambda (sstx)
(syntax-case sstx (set!)
[vr (identifier? (syntax vr))
(syntax (unbox loc))]
[(set! vr val)
(raise-syntax-error
'unit
"cannot set! imported or exported variables"
sstx)]
[(vr . args) (syntax ((unbox loc) . args))])))])
. rest))))))]
[num-imports (datum->syntax
(length (syntax->list (syntax (iloc ...))))
#f (quote-syntax here))])
(syntax/loc
stx
(make-unit