X-Git-Url: https://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=ast.scm;h=8dac3b68833ca430d27015b8a97263a72c531f37;hp=2ffad975f66f1ec4fbca3f32f095e484658ed726;hb=31e29e5a1880862f7786abd7f1df911f5acf651d;hpb=8aacba5976424791fb51d5d36118269d32c4096a diff --git a/ast.scm b/ast.scm index 2ffad97..8dac3b6 100644 --- a/ast.scm +++ b/ast.scm @@ -1,11 +1,28 @@ -(define (app? x) - (and (list? x) - (>= (length x) 2) - (not (eq? (car x) 'let)) - (not (eq? (car x) 'lambda)))) +(define (ast-type x) + (define (builtin? x) + (case x + ('+ #t) + ('- #t) + ('* #t) + ('! #t) + ('= #t) + ('bool->int #t) + (else #f))) + (cond + ((list? x) + (case (car x) + ('if 'if) + ('let 'let) + ('lambda 'lambda) + ('closure 'closure) ; only available in codegen + (else 'app))) + ((builtin? x) 'builtin) + ((symbol? x) 'var) + ((integer? x) 'int-literal) + ((boolean? x) 'bool-literal))) -(define (let? x) - (and (list? x) (eq? (car x) 'let))) +;; (define (ast-recurse f x) +;; (cond ( (define let-bindings cadr) (define let-body cddr) @@ -18,15 +35,3 @@ ; for use elsewhere (define lambda-args cadr) (define lambda-body caddr) - -(define (var? x) - (and (not (list? x)) (symbol? x))) - -(define (builtin? x) - (case x - ('+ #t) - ('- #t) - ('* #t) - ('! #t) - ('bool->int #t) - (else #f)))