Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 20:45:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Working letrec-syntax

Browse source 
Need to understand a bit more why this works, though...
This commit is contained in:
Justin Ethier 2017-12-15 18:10:28 -05:00
parent b397e00522
commit c404a6b588
1 changed files with 25 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
scheme/eval.sld
View file

@ -471,24 +471,24 @@
(define (analyze-letrec-syntax exp a-env) (define (analyze-letrec-syntax exp a-env)
(let* ((rename-env (env:extend-environment '() '() '())) (let* ((rename-env (env:extend-environment '() '() '()))
; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env)) (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env))
; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env)) (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env))
; (zipped (apply map list vars (list vals))) (zipped (apply map list vars (list vals)))
; (defined-macros (defined-macros
; (filter (filter
; (lambda (v) (lambda (v)
; (Cyc-macro? (Cyc-get-cvar (cadr v)))) (Cyc-macro? (Cyc-get-cvar (cadr v))))
; zipped)) zipped))
; (macro-env (macro-env
; (env:extend-environment (env:extend-environment
; (map car defined-macros) (map car defined-macros)
; (map (lambda (v) (map (lambda (v)
; (list 'macro (cadr v))) (list 'macro (cadr v)))
; defined-macros) defined-macros)
; '())) ;; base-env (create-environment '() '())))
;(expanded (expand exp macro-env rename-env)) (expanded (expand exp macro-env rename-env))
(expanded (expand exp a-env rename-env)) ;(expanded (expand exp a-env rename-env))
(cleaned (macro:cleanup expanded rename-env)) (cleaned (macro:cleanup expanded rename-env))
) )
(analyze cleaned a-env))) (analyze cleaned a-env)))
@ -876,10 +876,10 @@
(current-error-port)) (current-error-port))
(newline (current-error-port))) (newline (current-error-port)))
;(log exp) ;(log exp)
(display "/* ") ;;(display "/* ")
(write `(expand ,exp)) ;;(write `(expand ,exp))
(display "*/ ") ;;(display "*/ ")
(newline) ;;(newline)
(cond (cond
((const? exp) exp) ((const? exp) exp)
((prim? exp) exp) ((prim? exp) exp)
@ -1006,10 +1006,10 @@
#;(if v #;(if v
v v
(env:lookup (car exp) rename-env #f))))))) (env:lookup (car exp) rename-env #f)))))))
(display "/* ") ;;(display "/* ")
(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f))) ;;(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f)))
(display "*/ ") ;;(display "*/ ")
(newline) ;;(newline)
(cond (cond
((tagged-list? 'macro val) ((tagged-list? 'macro val)
(_expand ; Could expand into another macro (_expand ; Could expand into another macro