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

Cleanup (scheme write) imports, keep top env on import

Browse source
This commit is contained in:
Justin Ethier 2020-07-27 16:43:14 -04:00
parent d1630c6a4f
commit 152a210619
1 changed files with 27 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
scheme/eval.sld
View file

@ -14,7 +14,7 @@
(scheme cyclone primitives) (scheme cyclone primitives)
(scheme base) (scheme base)
(scheme file) (scheme file)
(scheme write) ;; Only used for debugging ;(scheme write) ;; Only used for debugging
(scheme read)) (scheme read))
(export (export
;environment ;environment
@ -379,7 +379,10 @@
(primitive-procedure-objects) (primitive-procedure-objects)
env:the-empty-environment)) env:the-empty-environment))
(define *initial-environment* (create-initial-environment)) (define *initial-environment* (create-initial-environment))
(define *global-environment* (setup-environment (create-initial-environment))) (define *global-environment*
(env:extend-environment
'() '()
(setup-environment (create-initial-environment))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This step separates syntactic analysis from execution. ;; This step separates syntactic analysis from execution.
@ -766,7 +769,16 @@
;(begin (write `(,lib-name ,us ,loaded? is already loaded skipping)) (newline)) ;(begin (write `(,lib-name ,us ,loaded? is already loaded skipping)) (newline))
))) )))
lib-names) lib-names)
(set! *global-environment* (setup-environment *initial-environment*))
;(newline)
;(display "/* ")
;(write (list 'DEBUG-GLO-ENV *global-environment*))
;(display "*/ ")
(set! *global-environment*
(cons
(car *global-environment*)
(setup-environment *initial-environment*)))
#t)) #t))
;; Is the given library loaded? ;; Is the given library loaded?
@ -824,7 +836,7 @@
(result #f)) (result #f))
;(newline) ;(newline)
;(display "/* ") ;(display "/* ")
;(write (list 'macro:expand exp macro compiled-macro? local-renamed)) ;(write (list 'macro:expand exp (memloc exp) (assoc exp *source-loc-lis*) macro compiled-macro? local-renamed))
;(display "*/ ") ;(display "*/ ")
;; Invoke ER macro ;; Invoke ER macro
@ -946,12 +958,12 @@
;; local-env - Local macro definitions, used by let-syntax ;; local-env - Local macro definitions, used by let-syntax
;; local-renamed - Renamed local variables introduced by lambda expressions ;; local-renamed - Renamed local variables introduced by lambda expressions
(define (_expand exp env rename-env local-env local-renamed) (define (_expand exp env rename-env local-env local-renamed)
(define (log e) ;(define (log e)
(display ; (display
(list 'expand e 'env ; (list 'expand e 'env
(env:frame-variables (env:first-frame env))) ; (env:frame-variables (env:first-frame env)))
(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))
@ -1192,11 +1204,11 @@
(_expand-body result exp env rename-env '() '())) (_expand-body result exp env rename-env '() '()))
(define (_expand-body result exp env rename-env local-env local-renamed) (define (_expand-body result exp env rename-env local-env local-renamed)
(define (log e) ;(define (log e)
(display (list 'expand-body e 'env ; (display (list 'expand-body e 'env
(env:frame-variables (env:first-frame env))) ; (env:frame-variables (env:first-frame env)))
(current-error-port)) ; (current-error-port))
(newline (current-error-port))) ; (newline (current-error-port)))
(if (null? exp) (if (null? exp)
(reverse result) (reverse result)