From 9817ecd465f696ce16ab7f093a0e6fbf1ec3f7a4 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 14 Dec 2017 19:04:15 -0500 Subject: [PATCH] WIP --- scheme/eval.sld | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/scheme/eval.sld b/scheme/eval.sld index c9f02556..912bca51 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -470,6 +470,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 (cdr v)))) +;; zipped)) +;; (macro-env +;; (env:extend-environment +;; (map car defined-macros) +;; (map (lambda (v) +;; (list 'macro (cdr v))) +;; defined-macros) +;; '())) ;; base-env + + ;(expanded (expand exp macro-env rename-env)) (expanded (expand exp a-env rename-env)) (cleaned (macro:cleanup expanded rename-env)) ) @@ -989,7 +1007,7 @@ v (env:lookup (car exp) rename-env #f))))))) (display "/* ") -(write `(app DEBUG ,(car exp) ,val ,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 "*/ ") (newline) (cond