Scaffold validation calls

This commit is contained in:
Justin Ethier 2019-09-05 13:24:13 -04:00
parent 5f5363a8e2
commit 2ad35be419

View file

@ -23,6 +23,21 @@
((> args 4) ((> args 4)
(error "Too many arguments" exp))))) (error "Too many arguments" exp)))))
(define (check-define exp)
'todo)
(define (check-set exp)
'todo)
(define (check-lambda exp)
;(difference (reduce union (map search (lambda->exp exp)) '())
; (lambda-formals->list exp))
'todo)
;; TODO: could check primitives, etc
;; TODO: what if any keywords are shadowed? need to populate vars
(define (search exp vars) (define (search exp vars)
;(pretty-print `(search ,exp))(newline) ;(pretty-print `(search ,exp))(newline)
(cond (cond
@ -31,23 +46,19 @@
((quote? exp) #f) ((quote? exp) #f)
((ref? exp) #f) ((ref? exp) #f)
((lambda? exp) ((lambda? exp)
;(difference (reduce union (map search (lambda->exp exp)) '()) (if (not (member 'lambda vars)) (check-lambda exp))
; (lambda-formals->list exp))
;; TODO: validation checks
(for-each (for-each
(lambda (e) (lambda (e)
(search e vars)) (search e vars))
(lambda-formals->list exp)) (lambda->exp exp))
) )
((if? exp) ((if? exp)
(check-if exp) (if (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)) (search (if->else exp) vars))
((define? exp) ((define? exp)
;; TODO: validation (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)
@ -55,8 +66,10 @@
(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))
(search (set!->var exp) vars) (search (set!->var exp) vars)
(search (set!->exp exp) vars)) (search (set!->exp exp) vars))
; 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))
; (search (cdr exp))) ; (search (cdr exp)))