X-Git-Url: http://git.lukelau.me/?p=scheme.git;a=blobdiff_plain;f=ast.scm;h=52e06bcb24d3b4783eb301c8fb657ec7f7e06071;hp=b70317a70e6fd3a14aa9fab5c94be57991427f2e;hb=1b7e2b53e68a39265fd7424910998d2607cc3815;hpb=277cd3c8e4ad4c727e041bf870a79862640c39b3 diff --git a/ast.scm b/ast.scm index b70317a..52e06bc 100644 --- a/ast.scm +++ b/ast.scm @@ -178,10 +178,10 @@ ; | ; v ; (foo . ((A foo constructor) . (abs Int (abs Bool A)))) - ; (foo~0 . ((A foo 0) . (abs A Int))) - ; (foo~1 . ((A foo 1) . (abs A Bool))) + ; (foo~0 . ((A foo 0 Int) . (abs A Int))) + ; (foo~1 . ((A foo 1 Bool) . (abs A Bool))) ; (bar . ((A bar constructor) . (abs Bool A))) - ; (bar~0 . ((A bar 0) . (abs A Bool))) + ; (bar~0 . ((A bar 0 Bool) . (abs A Bool))) ; ------+------------------------------------- ; tor | info | type @@ -190,8 +190,9 @@ (fold-right (lambda (x acc) `(abs ,x ,acc)) t products)) (define (destructor ctor-name prod-type part-type index) - (let ([name (dtor-name ctor-name index)]) - (cons name (cons (list prod-type ctor-name index) `(abs ,prod-type ,part-type))))) + (let* ([name (dtor-name ctor-name index)] + [info (list prod-type ctor-name index part-type)]) + (cons name (cons info `(abs ,prod-type ,part-type))))) (let ([type-name (car data-layout)] [ctors (cdr data-layout)])