mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
WIP
This commit is contained in:
Justin Ethier
parent
d12b628657
commit
910662135b
2 changed files with 251 additions and 205 deletions
128
scheme/eval.sld
128
scheme/eval.sld
|
|
@ -859,9 +859,15 @@
|
|||
; expand : exp -> exp
|
||||
|
||||
(define (expand exp env rename-env)
|
||||
(_expand exp env rename-env '()))
|
||||
(_expand exp env rename-env '() '()))
|
||||
|
||||
(define (_expand exp env rename-env local-env)
|
||||
;; Internal implementation of expand
|
||||
;; exp - Expression to expand
|
||||
;; env - Environment of the expression
|
||||
;; rename-env - Environment of variables renamed directly by macros
|
||||
;; local-env - Local macro definitions, used by let-syntax
|
||||
;; local-renamed - Renamed local variables introduced by lambda expressions
|
||||
(define (_expand exp env rename-env local-env local-renamed)
|
||||
(define (log e)
|
||||
(display
|
||||
(list 'expand e 'env
|
||||
|
|
@ -878,28 +884,42 @@
|
|||
((prim? exp) exp)
|
||||
((ref? exp) exp)
|
||||
((quote? exp) exp)
|
||||
TODO: rename all lambda formals and update rename-env accordingly.
|
||||
will also require renaming refs later on here in expand...
|
||||
can we use Cyc-er-rename to do this? maybe just use gensym directly as a first-cut
|
||||
TODO: also need to figure out how to deep-copy rename-env and associate it with
|
||||
any defined macro. would need to pull that out when macro is expanded later
|
||||
((lambda? exp) `(lambda ,(lambda->formals exp)
|
||||
,@(_expand-body '() (lambda->exp exp) env rename-env local-env)
|
||||
;,@(map
|
||||
; ;; TODO: use extend env here?
|
||||
; (lambda (expr) (_expand expr env rename-env local-env))
|
||||
; (lambda->exp exp))
|
||||
))
|
||||
;; TODO: rename all lambda formals and update rename-env accordingly.
|
||||
;; will also require renaming refs later on here in expand...
|
||||
;; can we use Cyc-er-rename to do this? maybe just use gensym directly as a first-cut
|
||||
;; TODO: also need to figure out how to deep-copy rename-env and associate it with
|
||||
;; any defined macro. would need to pull that out when macro is expanded later
|
||||
((lambda? exp)
|
||||
(let* ((args (lambda-formals->list exp))
|
||||
(ltype (lambda-formals-type exp))
|
||||
(a-lookup (map (lambda (a) (cons a (gensym a))) args))
|
||||
(new-formals
|
||||
(list->lambda-formals
|
||||
(map cdr a-lookup)
|
||||
ltype))
|
||||
)
|
||||
`(lambda ,(lambda->formals exp)
|
||||
;; TODO: want this line instead of the above, but need to solve a crash
|
||||
;; when compiling unit tests first (!!!)
|
||||
;`(lambda ,new-formals ;,(lambda->formals exp)
|
||||
,@(_expand-body
|
||||
'()
|
||||
(lambda->exp exp)
|
||||
env
|
||||
rename-env
|
||||
local-env
|
||||
(append a-lookup local-renamed))
|
||||
)))
|
||||
((define? exp) (if (define-lambda? exp)
|
||||
(_expand (define->lambda exp) env rename-env local-env)
|
||||
`(define ,(_expand (define->var exp) env rename-env local-env)
|
||||
,@(_expand (define->exp exp) env rename-env local-env))))
|
||||
((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env)
|
||||
,(_expand (set!->exp exp) env rename-env local-env)))
|
||||
((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env)
|
||||
,(_expand (if->then exp) env rename-env local-env)
|
||||
(_expand (define->lambda exp) env rename-env local-env local-renamed)
|
||||
`(define ,(_expand (define->var exp) env rename-env local-env local-renamed)
|
||||
,@(_expand (define->exp exp) env rename-env local-env local-renamed))))
|
||||
((set!? exp) `(set! ,(_expand (set!->var exp) env rename-env local-env local-renamed)
|
||||
,(_expand (set!->exp exp) env rename-env local-env local-renamed)))
|
||||
((if-syntax? exp) `(if ,(_expand (if->condition exp) env rename-env local-env local-renamed)
|
||||
,(_expand (if->then exp) env rename-env local-env local-renamed)
|
||||
,(if (if-else? exp)
|
||||
(_expand (if->else exp) env rename-env local-env)
|
||||
(_expand (if->else exp) env rename-env local-env local-renamed)
|
||||
;; Insert default value for missing else clause
|
||||
;; FUTURE: append the empty (unprinted) value
|
||||
;; instead of #f
|
||||
|
|
@ -913,8 +933,8 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(cond
|
||||
((macro:syntax-rules? (env:lookup (car trans) env #f)) ;; Handles renamed 'syntax-rules' identifier
|
||||
(_expand
|
||||
`(define-syntax ,name ,(_expand trans env rename-env local-env))
|
||||
env rename-env local-env))
|
||||
`(define-syntax ,name ,(_expand trans env rename-env local-env local-renamed))
|
||||
env rename-env local-env local-renamed))
|
||||
(else
|
||||
;; TODO: for now, do not let a compiled macro be re-defined.
|
||||
;; this is a hack for performance compiling (scheme base)
|
||||
|
|
@ -936,7 +956,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
;; TODO: may run into issues with expanding now, before some
|
||||
;; of the macros are defined. may need to make a special pass
|
||||
;; to do loading or expansion of macro bodies
|
||||
`(define ,name ,(_expand body env rename-env local-env)))))))
|
||||
`(define ,name ,(_expand body env rename-env local-env local-renamed)))))))
|
||||
((let-syntax? exp)
|
||||
(let* ((body (cons 'begin (cddr exp)))
|
||||
(bindings (cadr exp))
|
||||
|
|
@ -962,13 +982,13 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
;; Broken for renames, replace w/below: (if (tagged-list? 'syntax-rules binding)
|
||||
(if (macro:syntax-rules? (env:lookup (car binding) env #f))
|
||||
;; TODO: is this ok?
|
||||
(cadr (_expand binding env rename-env local-env))
|
||||
(cadr (_expand binding env rename-env local-env local-renamed))
|
||||
binding-body)))))
|
||||
bindings))
|
||||
(new-local-macro-env (append bindings-as-macros local-env))
|
||||
)
|
||||
;(trace:error `(let-syntax ,new-local-macro-env))
|
||||
(_expand body env rename-env new-local-macro-env) ;; TODO: new-local-macro-env
|
||||
(_expand body env rename-env new-local-macro-env local-renamed) ;; TODO: new-local-macro-env
|
||||
))
|
||||
((letrec-syntax? exp)
|
||||
(let* ((body (cons 'begin (cddr exp)))
|
||||
|
|
@ -984,11 +1004,11 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(list
|
||||
'macro
|
||||
(if (macro:syntax-rules? (env:lookup (car binding) body-env #f))
|
||||
(cadr (_expand binding body-env rename-env local-env))
|
||||
(cadr (_expand binding body-env rename-env local-env local-renamed))
|
||||
binding-body))))
|
||||
(env:define-variable! name macro-val) body-env))
|
||||
bindings)
|
||||
(_expand body body-env rename-env local-env)
|
||||
(_expand body body-env rename-env local-env local-renamed)
|
||||
))
|
||||
((app? exp)
|
||||
(cond
|
||||
|
|
@ -1012,13 +1032,13 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(macro:expand exp val env rename-env)
|
||||
env
|
||||
rename-env
|
||||
local-env))
|
||||
local-env local-renamed))
|
||||
((Cyc-macro? val)
|
||||
(_expand ; Could expand into another macro
|
||||
(macro:expand exp (list 'macro val) env rename-env)
|
||||
env
|
||||
rename-env
|
||||
local-env))
|
||||
local-env local-renamed))
|
||||
;; TODO: if we are doing this, only want to do so if the original variable is a macro.
|
||||
;; this is starting to get overly complicated though.
|
||||
;; if nothing else should encapsulate the above lookup into a function and call that
|
||||
|
|
@ -1033,10 +1053,10 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
;;(newline)
|
||||
;; (_expand
|
||||
;; (cons val (cdr exp))
|
||||
;; env rename-env local-env))
|
||||
;; env rename-env local-env local-renamed))
|
||||
(else
|
||||
(map
|
||||
(lambda (expr) (_expand expr env rename-env local-env))
|
||||
(lambda (expr) (_expand expr env rename-env local-env local-renamed))
|
||||
exp)))))
|
||||
(else
|
||||
;; TODO: note that map does not guarantee that expressions are
|
||||
|
|
@ -1044,7 +1064,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
;; in reverse order. Might be better to use a fold here and
|
||||
;; elsewhere in (expand).
|
||||
(map
|
||||
(lambda (expr) (_expand expr env rename-env local-env))
|
||||
(lambda (expr) (_expand expr env rename-env local-env local-renamed))
|
||||
exp))))
|
||||
(else
|
||||
(error "unknown exp: " exp))))
|
||||
|
|
@ -1062,9 +1082,9 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
|
||||
;; Helper to expand a lambda body, so we can splice in any begin's
|
||||
(define (expand-body result exp env rename-env)
|
||||
(_expand-body result exp env rename-env '()))
|
||||
(_expand-body result exp env rename-env '() '()))
|
||||
|
||||
(define (_expand-body result exp env rename-env local-env)
|
||||
(define (_expand-body result exp env rename-env local-env local-renamed)
|
||||
(define (log e)
|
||||
(display (list 'expand-body e 'env
|
||||
(env:frame-variables (env:first-frame env)))
|
||||
|
|
@ -1083,7 +1103,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(quote? this-exp)
|
||||
(define-c? this-exp))
|
||||
;(log this-exp)
|
||||
(_expand-body (cons this-exp result) (cdr exp) env rename-env local-env))
|
||||
(_expand-body (cons this-exp result) (cdr exp) env rename-env local-env local-renamed))
|
||||
((define? this-exp)
|
||||
;(log this-exp)
|
||||
(_expand-body
|
||||
|
|
@ -1093,7 +1113,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(cdr exp)
|
||||
env
|
||||
rename-env
|
||||
local-env))
|
||||
local-env local-renamed))
|
||||
((or (define-syntax? this-exp)
|
||||
(letrec-syntax? this-exp)
|
||||
(let-syntax? this-exp)
|
||||
|
|
@ -1103,12 +1123,12 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
;(log (car this-exp))
|
||||
(_expand-body
|
||||
(cons
|
||||
(_expand this-exp env rename-env local-env)
|
||||
(_expand this-exp env rename-env local-env local-renamed)
|
||||
result)
|
||||
(cdr exp)
|
||||
env
|
||||
rename-env
|
||||
local-env))
|
||||
local-env local-renamed))
|
||||
;; Splice in begin contents and keep expanding body
|
||||
((begin? this-exp)
|
||||
(let* ((expr this-exp)
|
||||
|
|
@ -1119,7 +1139,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(append begin-exprs (cdr exp))
|
||||
env
|
||||
rename-env
|
||||
local-env)))
|
||||
local-env local-renamed)))
|
||||
((app? this-exp)
|
||||
(cond
|
||||
((symbol? (caar exp))
|
||||
|
|
@ -1141,7 +1161,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(cdr exp))
|
||||
env
|
||||
rename-env
|
||||
local-env))
|
||||
local-env local-renamed))
|
||||
;; No macro, use main expand function to process
|
||||
(_expand-body
|
||||
(cons
|
||||
|
|
@ -1152,7 +1172,7 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(cdr exp)
|
||||
env
|
||||
rename-env
|
||||
local-env))))
|
||||
local-env local-renamed))))
|
||||
(else
|
||||
;(log 'app)
|
||||
(_expand-body
|
||||
|
|
@ -1164,10 +1184,30 @@ any defined macro. would need to pull that out when macro is expanded later
|
|||
(cdr exp)
|
||||
env
|
||||
rename-env
|
||||
local-env))))
|
||||
local-env local-renamed))))
|
||||
(else
|
||||
(error "unknown exp: " this-exp))))))
|
||||
|
||||
;; TODO: this is copied from (scheme cyclone transforms) need to relocate both into a common place
|
||||
(define (list->lambda-formals args type)
|
||||
(cond
|
||||
((eq? type 'args:fixed) args)
|
||||
((eq? type 'args:fixed-with-varargs) (list->pair args))
|
||||
((eq? type 'args:varargs)
|
||||
(if (> (length args) 1)
|
||||
(error `(Too many args for varargs ,args))
|
||||
(car args)))
|
||||
(else (error `(Unexpected type ,type)))))
|
||||
(define (list->pair l)
|
||||
(let loop ((lst l))
|
||||
(cond
|
||||
((not (pair? lst))
|
||||
lst)
|
||||
((null? (cdr lst))
|
||||
(car lst))
|
||||
(else
|
||||
(cons (car lst) (loop (cdr lst)))))))
|
||||
|
||||
;; Container for built-in macros
|
||||
(define (get-macros) *defined-macros*)
|
||||
(define *defined-macros* (list))
|
||||
|
|
|
|||
|
|
@ -1,166 +1,172 @@
|
|||
(import (scheme base) (scheme write) (scheme cyclone pretty-print))
|
||||
|
||||
;; Just testing, may want to remove this one once the recursive macro expansion works
|
||||
; (define-syntax my-or2 (syntax-rules ()
|
||||
; ((my-or2) #f)
|
||||
; ((my-or2 e) e)
|
||||
; ((my-or2 e1 e2 ...)
|
||||
; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
|
||||
;(write (my-or2 #t))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
; (define-syntax my-or (syntax-rules ()
|
||||
; ((my-or) #f)
|
||||
; ((my-or e) e)
|
||||
; ((my-or e1 e2 ...)
|
||||
; (let ((temp e1)) (if temp temp (my-or e2 ...))))))
|
||||
; (write
|
||||
; (let ((x #f)
|
||||
; (y 7)
|
||||
; (temp 8)
|
||||
; (my-let odd?)
|
||||
; (my-if even?))
|
||||
; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
;
|
||||
; (define-syntax foo (syntax-rules ()
|
||||
; ((_ b)
|
||||
; (bar a b))))
|
||||
; (define-syntax bar (syntax-rules () ((_ c d)
|
||||
; (cons c (let ((c 3))
|
||||
; (list d c 'c))))))
|
||||
; (write
|
||||
; (let ((a 2))
|
||||
; (foo a)))
|
||||
|
||||
;; Chibi also fails with the same error when this is a let-synatx macro,
|
||||
;; so it may be that Cyclone works just fine here! Obviously it needs
|
||||
;; to be able to handle this macro in letrec-syntax form, though
|
||||
#;(let-syntax
|
||||
((my-or (syntax-rules ()
|
||||
((my-or) #f)
|
||||
((my-or e) e)
|
||||
((my-or e1 e2 ...)
|
||||
(let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
||||
(let ((x #f)
|
||||
(y 7)
|
||||
(temp 8)
|
||||
(my-let odd?)
|
||||
(my-if even?))
|
||||
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
|
||||
;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
|
||||
;; TODO: below does not work in eval - WTF?
|
||||
(write
|
||||
(letrec-syntax
|
||||
((my-or (syntax-rules ()
|
||||
((my-or) #f)
|
||||
((my-or e) e)
|
||||
((my-or e1 e2 ...)
|
||||
(let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
||||
(let ((x #f)
|
||||
(y 7)
|
||||
(temp 8)
|
||||
(my-let odd?)
|
||||
(my-if even?))
|
||||
(my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
)
|
||||
|
||||
|
||||
;; From Chibi - isn't this a bug though?
|
||||
;(write
|
||||
;(let ()
|
||||
; (letrec-syntax ()
|
||||
; (define internal-def 'ok))
|
||||
; internal-def)
|
||||
;)
|
||||
|
||||
;; From Husk:
|
||||
;;
|
||||
; Examples from the source to R5RS pitfall 3.3
|
||||
;; (assert/equal
|
||||
;; (let ((a 1))
|
||||
;; (letrec-syntax
|
||||
;; ((foo (syntax-rules ()
|
||||
;; ((_ b)
|
||||
;; (bar a b))))
|
||||
;; (bar (syntax-rules ()
|
||||
;; ((_ c d)
|
||||
;; (cons c (let ((c 3))
|
||||
;; (list d c 'c)))))))
|
||||
;; (let ((a 2))
|
||||
;; (foo a))))
|
||||
;; '(1 2 3 a))
|
||||
;;
|
||||
;; ; Examples from/based on pitfall 8.3 (assert/equal 1
|
||||
;; (let ((x 1))
|
||||
;; (let-syntax ((foo (syntax-rules () ((_) 2))))
|
||||
;; (define x (foo))
|
||||
;; 3)
|
||||
;; x))
|
||||
;; (assert/equal 1
|
||||
;; (let ((x 1))
|
||||
;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
|
||||
;; 3)
|
||||
;; x))
|
||||
;;
|
||||
;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
|
||||
;; (assert/equal
|
||||
;; (let ((unquote 'foo)) `(,'bar))
|
||||
;; '(,'bar))
|
||||
|
||||
|
||||
#;(let ((a 1))
|
||||
(let-syntax
|
||||
;;(letrec-syntax
|
||||
((foo (syntax-rules ()
|
||||
((_ b)
|
||||
(bar a b))))
|
||||
(bar (syntax-rules () ((_ c d)
|
||||
(cons c (let ((c 3))
|
||||
(list d c 'c)))))))
|
||||
(let ((a 2))
|
||||
(foo a))))
|
||||
|
||||
|
||||
(define-syntax my-let
|
||||
(syntax-rules
|
||||
()
|
||||
((my-let ((name val) ...) body1 body2 ...)
|
||||
((lambda (name ...) body1 body2 ...) val ...))
|
||||
((my-let tag ((name val) ...) body1 body2 ...)
|
||||
((letrec ((tag (lambda (name ...) body1 body2 ...)))
|
||||
tag)
|
||||
val ...))))
|
||||
(write
|
||||
(my-let ((x 'outer))
|
||||
(let-syntax ((m (syntax-rules () ((m) x))))
|
||||
(my-let ((x 'inner))
|
||||
(m)))) ;; Should be outer
|
||||
)
|
||||
|
||||
|
||||
;; (let-syntax ((given-that (syntax-rules ()
|
||||
;; ((given-that test stmt1 stmt2 ...)
|
||||
;; (if test
|
||||
;; (begin stmt1
|
||||
;; stmt2 ...))))))
|
||||
;; (let ((if #t))
|
||||
;; (given-that if (set! if 'now))
|
||||
;; if)) ;; => now
|
||||
|
||||
(write
|
||||
(let ((x 'outer))
|
||||
(let-syntax ((m (syntax-rules () ((m) x))))
|
||||
;(let-syntax ((m (syntax-rules () ((m) x))))
|
||||
(let ((x 'inner))
|
||||
(m)))) ;; Should be outer
|
||||
)
|
||||
|
||||
;(write
|
||||
;(let ((x 'outer))
|
||||
; (define-syntax m ;; Testing this out, but let-syntax needs to work, too
|
||||
; (syntax-rules () ((m) x)))
|
||||
; (let ((x 'inner))
|
||||
; (m))) ;; Should be outer
|
||||
; )
|
||||
;
|
||||
;(write (m)) ;; Should be an error, of course
|
||||
(list)))) ;; Should be outer
|
||||
; )
|
||||
;;;; Just testing, may want to remove this one once the recursive macro expansion works
|
||||
;;; (define-syntax my-or2 (syntax-rules ()
|
||||
;;; ((my-or2) #f)
|
||||
;;; ((my-or2 e) e)
|
||||
;;; ((my-or2 e1 e2 ...)
|
||||
;;; (let ((temp e1)) (if temp temp (my-or2 e2 ...))))))
|
||||
;;;(write (my-or2 #t))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; (define-syntax my-or (syntax-rules ()
|
||||
;;; ((my-or) #f)
|
||||
;;; ((my-or e) e)
|
||||
;;; ((my-or e1 e2 ...)
|
||||
;;; (let ((temp e1)) (if temp temp (my-or e2 ...))))))
|
||||
;;; (write
|
||||
;;; (let ((x #f)
|
||||
;;; (y 7)
|
||||
;;; (temp 8)
|
||||
;;; (my-let odd?)
|
||||
;;; (my-if even?))
|
||||
;;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
;;;
|
||||
;;; (define-syntax foo (syntax-rules ()
|
||||
;;; ((_ b)
|
||||
;;; (bar a b))))
|
||||
;;; (define-syntax bar (syntax-rules () ((_ c d)
|
||||
;;; (cons c (let ((c 3))
|
||||
;;; (list d c 'c))))))
|
||||
;;; (write
|
||||
;;; (let ((a 2))
|
||||
;;; (foo a)))
|
||||
;;
|
||||
;;;; Chibi also fails with the same error when this is a let-synatx macro,
|
||||
;;;; so it may be that Cyclone works just fine here! Obviously it needs
|
||||
;;;; to be able to handle this macro in letrec-syntax form, though
|
||||
;;#;(let-syntax
|
||||
;; ((my-or (syntax-rules ()
|
||||
;; ((my-or) #f)
|
||||
;; ((my-or e) e)
|
||||
;; ((my-or e1 e2 ...)
|
||||
;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
||||
;; (let ((x #f)
|
||||
;; (y 7)
|
||||
;; (temp 8)
|
||||
;; (my-let odd?)
|
||||
;; (my-if even?))
|
||||
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
;;
|
||||
;;;; TODO: below should work with "let" and "if" instead of "my-let" and "my-if"
|
||||
;;;; TODO: below does not work in eval - WTF?
|
||||
;;(write
|
||||
;;(letrec-syntax
|
||||
;; ((my-or (syntax-rules ()
|
||||
;; ((my-or) #f)
|
||||
;; ((my-or e) e)
|
||||
;; ((my-or e1 e2 ...)
|
||||
;; (let ((temp e1)) (if temp temp (my-or e2 ...)))))))
|
||||
;; (let ((x #f)
|
||||
;; (y 7)
|
||||
;; (temp 8)
|
||||
;; (my-let odd?)
|
||||
;; (my-if even?))
|
||||
;; (my-or x (my-let temp) (my-if y) y))) ;; ==> 7
|
||||
;;)
|
||||
;;
|
||||
;;
|
||||
;;;; From Chibi - isn't this a bug though?
|
||||
;;;(write
|
||||
;;;(let ()
|
||||
;;; (letrec-syntax ()
|
||||
;;; (define internal-def 'ok))
|
||||
;;; internal-def)
|
||||
;;;)
|
||||
;;
|
||||
;;;; From Husk:
|
||||
;;;;
|
||||
;;; Examples from the source to R5RS pitfall 3.3
|
||||
;;;; (assert/equal
|
||||
;;;; (let ((a 1))
|
||||
;;;; (letrec-syntax
|
||||
;;;; ((foo (syntax-rules ()
|
||||
;;;; ((_ b)
|
||||
;;;; (bar a b))))
|
||||
;;;; (bar (syntax-rules ()
|
||||
;;;; ((_ c d)
|
||||
;;;; (cons c (let ((c 3))
|
||||
;;;; (list d c 'c)))))))
|
||||
;;;; (let ((a 2))
|
||||
;;;; (foo a))))
|
||||
;;;; '(1 2 3 a))
|
||||
;;;;
|
||||
;;;; ; Examples from/based on pitfall 8.3 (assert/equal 1
|
||||
;;;; (let ((x 1))
|
||||
;;;; (let-syntax ((foo (syntax-rules () ((_) 2))))
|
||||
;;;; (define x (foo))
|
||||
;;;; 3)
|
||||
;;;; x))
|
||||
;;;; (assert/equal 1
|
||||
;;;; (let ((x 1))
|
||||
;;;; (letrec-syntax ((foo (syntax-rules () ((_) 2)))) (define x (foo))
|
||||
;;;; 3)
|
||||
;;;; x))
|
||||
;;;;
|
||||
;;;; ; Issue #151 - Preserve hygiene across syntax-rules and ER macros
|
||||
;;;; (assert/equal
|
||||
;;;; (let ((unquote 'foo)) `(,'bar))
|
||||
;;;; '(,'bar))
|
||||
;;
|
||||
;;
|
||||
;;#;(let ((a 1))
|
||||
;; (let-syntax
|
||||
;; ;;(letrec-syntax
|
||||
;; ((foo (syntax-rules ()
|
||||
;; ((_ b)
|
||||
;; (bar a b))))
|
||||
;; (bar (syntax-rules () ((_ c d)
|
||||
;; (cons c (let ((c 3))
|
||||
;; (list d c 'c)))))))
|
||||
;; (let ((a 2))
|
||||
;; (foo a))))
|
||||
;;
|
||||
;;
|
||||
;;(define-syntax my-let
|
||||
;; (syntax-rules
|
||||
;; ()
|
||||
;; ((my-let ((name val) ...) body1 body2 ...)
|
||||
;; ((lambda (name ...) body1 body2 ...) val ...))
|
||||
;; ((my-let tag ((name val) ...) body1 body2 ...)
|
||||
;; ((letrec ((tag (lambda (name ...) body1 body2 ...)))
|
||||
;; tag)
|
||||
;; val ...))))
|
||||
;;(write
|
||||
;;(my-let ((x 'outer))
|
||||
;; (let-syntax ((m (syntax-rules () ((m) x))))
|
||||
;; (my-let ((x 'inner))
|
||||
;; (m)))) ;; Should be outer
|
||||
;; )
|
||||
;;
|
||||
;;
|
||||
;;;; (let-syntax ((given-that (syntax-rules ()
|
||||
;;;; ((given-that test stmt1 stmt2 ...)
|
||||
;;;; (if test
|
||||
;;;; (begin stmt1
|
||||
;;;; stmt2 ...))))))
|
||||
;;;; (let ((if #t))
|
||||
;;;; (given-that if (set! if 'now))
|
||||
;;;; if)) ;; => now
|
||||
;;
|
||||
;;(write
|
||||
;;(let ((x 'outer))
|
||||
;; (let-syntax ((m (syntax-rules () ((m) x))))
|
||||
;; (let ((x 'inner))
|
||||
;; (m)))) ;; Should be outer
|
||||
;; )
|
||||
;;
|
||||
;;;(write
|
||||
;;;(let ((x 'outer))
|
||||
;;; (define-syntax m ;; Testing this out, but let-syntax needs to work, too
|
||||
;;; (syntax-rules () ((m) x)))
|
||||
;;; (let ((x 'inner))
|
||||
;;; (m))) ;; Should be outer
|
||||
;;; )
|
||||
;;;
|
||||
;;;(write (m)) ;; Should be an error, of course
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue