Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +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)
(let* ((rename-env (env:extend-environment '() '() '()))
; (vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env))
; (vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env))
; (zipped (apply map list vars (list vals)))
; (defined-macros
; (filter
; (lambda (v)
; (Cyc-macro? (Cyc-get-cvar (cadr v))))
; zipped))
; (macro-env
; (env:extend-environment
; (map car defined-macros)
; (map (lambda (v)
; (list 'macro (cadr v)))
; defined-macros)
; '())) ;; base-env
(vars (foldl (lambda (lis acc) (append acc (car lis))) '() a-env))
(vals (foldl (lambda (lis acc) (append acc (cdr lis))) '() a-env))
(zipped (apply map list vars (list vals)))
(defined-macros
(filter
(lambda (v)
(Cyc-macro? (Cyc-get-cvar (cadr v))))
zipped))
(macro-env
(env:extend-environment
(map car defined-macros)
(map (lambda (v)
(list 'macro (cadr v)))
defined-macros)
(create-environment '() '())))
;(expanded (expand exp macro-env rename-env))
(expanded (expand exp a-env rename-env))
(expanded (expand exp macro-env rename-env))
;(expanded (expand exp a-env rename-env))
(cleaned (macro:cleanup expanded rename-env))
)
(analyze cleaned a-env)))
@ -876,10 +876,10 @@
(current-error-port))
(newline (current-error-port)))
;(log exp)
(display "/* ")
(write `(expand ,exp))
(display "*/ ")
(newline)
;;(display "/* ")
;;(write `(expand ,exp))
;;(display "*/ ")
;;(newline)
(cond
((const? exp) exp)
((prim? exp) exp)
@ -1006,10 +1006,10 @@
#;(if v
v
(env:lookup (car exp) rename-env #f)))))))
(display "/* ")
(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f)))
(display "*/ ")
(newline)
;;(display "/* ")
;;(write `(app DEBUG ,(car exp) ,val ,env ,local-env ,rename-env ,(env:lookup (car exp) env #f)))
;;(display "*/ ")
;;(newline)
(cond
((tagged-list? 'macro val)
(_expand ; Could expand into another macro