conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* all lexicals are now added through the procedure add-lexical in 

(ikarus syntax).
This commit is contained in:
Abdulaziz Ghuloum 2007-05-07 03:22:42 -04:00
parent bb3dac193f
commit 9cdaa11a60
2 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

22
src/ikarus.syntax.ss
View File

@ -104,8 +104,6 @@
(module (make-stx stx? stx-expr stx-mark* stx-subst*) (module (make-stx stx? stx-expr stx-mark* stx-subst*)
(define-record stx (expr mark* subst*))) (define-record stx (expr mark* subst*)))
(define (seal-rib! rib) (define (seal-rib! rib)
(when (rib-sealed/freq rib)
(error 'seal-rib! "rib ~s is already sealed" rib))
(let ([sym* (rib-sym* rib)]) (let ([sym* (rib-sym* rib)])
(unless (null? sym*) (unless (null? sym*)
;;; only seal if rib is not empty. ;;; only seal if rib is not empty.
@ -608,12 +606,18 @@
(stx sym top-mark* '()))))] (stx sym top-mark* '()))))]
[else (stx sym top-mark* '())])))) [else (stx sym top-mark* '())]))))
;;; macros ;;; macros
(define add-lexical
(lambda (lab lex r)
(cons (list* lab 'lexical lex) r)))
;;;
(define add-lexicals (define add-lexicals
(lambda (lab* lex* r) (lambda (lab* lex* r)
(append (map (lambda (lab lex) (cond
(cons lab (cons 'lexical lex))) [(null? lab*) r]
lab* lex*) [else
r))) (add-lexicals (cdr lab*) (cdr lex*)
(add-lexical (car lab*) (car lex*) r))])))
;;;
(define let-values-transformer ;;; go away (define let-values-transformer ;;; go away
(lambda (e r mr) (lambda (e r mr)
(syntax-match e () (syntax-match e ()
@ -1770,7 +1774,7 @@
(extend-rib! rib id lab) (extend-rib! rib id lab)
(f (cdr e*) (f (cdr e*)
module-init** module-init**
(cons (cons lab (cons 'lexical lex)) r) (add-lexical lab lex r)
mr mr
(cons id lhs*) (cons id lhs*)
(cons lex lex*) (cons lex lex*)
@ -1862,7 +1866,7 @@
[lab (gen-label id)]) [lab (gen-label id)])
(extend-rib! rib id lab) (extend-rib! rib id lab)
(f (cdr e*) (f (cdr e*)
(cons (cons lab (cons 'lexical lex)) r) (add-lexical lab lex r)
mr mr
(cons id lhs*) (cons id lhs*)
(cons lex lex*) (cons lex lex*)
@ -1916,7 +1920,7 @@
(extend-rib! rib id lab) (extend-rib! rib id lab)
(f (cdr e*) (f (cdr e*)
module-init** module-init**
(cons (cons lab (cons 'lexical lex)) r) (add-lexical lab lex r)
mr mr
(cons id lhs*) (cons lex lex*) (cons rhs rhs*) (cons id lhs*) (cons lex lex*) (cons rhs rhs*)
kwd*)))] kwd*)))]