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

Added debugging code

Browse source
This commit is contained in:
Justin Ethier 2018-02-07 19:20:57 -05:00
parent ee0b7c181c
commit acde9d9b30
1 changed files with 41 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
scheme/eval.sld
View file

@ -463,10 +463,14 @@
;; TODO: probably just create a fresh env for renames ;; TODO: probably just create a fresh env for renames
;; TODO: expand, do we need to clean as well? ;; TODO: expand, do we need to clean as well?
;; TODO: run results back through analyze: (analyze (expand env? rename-env? ;; TODO: run results back through analyze: (analyze (expand env? rename-env?
;;(display "/* ") (display "/* ")
;;(write `(DEBUG ,cleaned)) (write `(DEBUG let-syntax ,exp ))
;;(display "*/ ") (newline)
;;(newline) (write `(DEBUG EXPANDED ,expanded))
(newline)
(write `(DEBUG CLEANED ,cleaned))
(display "*/ ")
(newline)
(analyze cleaned a-env rename-env))) (analyze cleaned a-env rename-env)))
(define (analyze-letrec-syntax exp a-env rename-env) (define (analyze-letrec-syntax exp a-env rename-env)
@ -491,6 +495,12 @@
(expanded (expand exp macro-env rename-env)) (expanded (expand exp macro-env rename-env))
(cleaned (macro:cleanup expanded rename-env)) (cleaned (macro:cleanup expanded rename-env))
) )
(display "/* ")
(write `(DEBUG letrec-syntax ,exp ))
(newline)
(write `(DEBUG EXPANDED ,cleaned))
(display "*/ ")
(newline)
(analyze cleaned a-env rename-env))) (analyze cleaned a-env rename-env)))
(define (analyze-syntax exp a-env) (define (analyze-syntax exp a-env)
@ -562,21 +572,37 @@
;(define use-env (env:extend-environment '() '() '())) ;(define use-env (env:extend-environment '() '() '()))
(if (Cyc-macro? macro-op) (if (Cyc-macro? macro-op)
;; Compiled macro, call directly ;; Compiled macro, call directly
(analyze (apply macro-op (let ((expanded
(apply macro-op
(list (cons (car exp) (operands exp)) (list (cons (car exp) (operands exp))
(Cyc-er-rename rename-env a-env '()) (Cyc-er-rename rename-env a-env '())
(Cyc-er-compare? rename-env a-env))) (Cyc-er-compare? rename-env a-env)))))
a-env (display "/* ")
rename-env) (write `(DEBUG expand ,exp ))
(newline)
(write `(EXPANDED ,expanded))
(display "*/ ")
(newline)
(analyze expanded
a-env
rename-env))
;; Interpreted macro, build expression and eval ;; Interpreted macro, build expression and eval
(let ((expr (cons macro-op (let* ((expr (cons macro-op
(list (cons 'quote (list (cons 'quote
(list (cons (car exp) (list (cons (car exp)
(operands exp)))) (operands exp))))
(Cyc-er-rename rename-env a-env '()) (Cyc-er-rename rename-env a-env '())
(Cyc-er-compare? rename-env a-env))))) (Cyc-er-compare? rename-env a-env))))
(expanded (eval expr a-env)) ;; Expand macro
)
(display "/* ")
(write `(DEBUG expand ,exp))
(newline)
(write `(EXPANDED ,expanded))
(display "*/ ")
(newline)
(analyze (analyze
(eval expr a-env) ;; Expand macro expanded
a-env a-env
rename-env)))))) rename-env))))))
(cond (cond
@ -885,10 +911,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)
((and (prim? exp) ;; Allow lambda vars to shadown primitives ((and (prim? exp) ;; Allow lambda vars to shadown primitives