Keep track of lexical variables, be more careful about (if)

This commit is contained in:
Justin Ethier 2019-09-09 18:26:32 -04:00
parent 2ad35be419
commit da4ffd84a3

View file

@ -37,9 +37,11 @@
;; TODO: could check primitives, etc ;; TODO: could check primitives, etc
;; TODO: what if any keywords are shadowed? need to populate vars ;; TODO: what if any keywords are shadowed? need to populate vars
(define (update-vars syms vars)
(append vars (filter include-var? syms)))
(define (search exp vars) (define (search exp vars)
;(pretty-print `(search ,exp))(newline) (pretty-print `(search ,exp ,vars))(newline)
(cond (cond
;((ast:lambda? exp) 'TODO) ;((ast:lambda? exp) 'TODO)
((const? exp) #f) ((const? exp) #f)
@ -49,26 +51,28 @@
(if (not (member 'lambda vars)) (check-lambda exp)) (if (not (member 'lambda vars)) (check-lambda exp))
(for-each (for-each
(lambda (e) (lambda (e)
(search e vars)) (search e (update-vars (lambda-formals->list exp) vars)))
(lambda->exp exp)) (lambda->exp exp))
) )
((if? exp) ((and (if? exp)
(if (not (member 'if vars)) (check-if exp)) (not (member 'if vars)))
(check-if exp)
(search (if->condition exp) vars) (search (if->condition exp) vars)
(search (if->then exp) vars) (search (if->then exp) vars)
(search (if->else exp) vars)) (when (> (length exp) 3)
(search (if->else exp) vars)))
((define? exp) ((define? exp)
(if (not (member 'define vars)) (check-define exp)) (if (not (member 'define vars)) (check-define exp))
(search (define->var exp) vars) (search (define->var exp) vars)
(for-each (for-each
(lambda (e) (lambda (e)
(search e vars)) (search e (update-vars (list (define->var exp)) vars)))
(define->exp exp))) (define->exp exp)))
((define-c? exp) #f) ((define-c? exp) #f)
((set!? exp) ((set!? exp)
(if (not (member 'set! vars)) (check-set exp)) (if (not (member 'set! vars)) (check-set exp))
(search (set!->var exp) vars) (search (set!->var exp) vars)
(search (set!->exp exp) vars)) (search (set!->exp exp) (update-vars (list (set!->var exp)) vars)))
; Future? ; Future?
;((tagged-list? 'let exp) ;((tagged-list? 'let exp)
; (set! let-vars (append (map car (cadr exp)) let-vars)) ; (set! let-vars (append (map car (cadr exp)) let-vars))