A bit more work on ADT codegen

diff --git a/codegen.scm b/codegen.scm
index 55189cf6db556dc21bb3c294dc7cdba85491c4fb..b90e7cdcefff689f56ce3b9cb911de408949b872 100644 (file)
--- a/codegen.scm
+++ b/codegen.scm
@@ -369,7 +369,13 @@
 (define (codegen-data-tor e si env)
 
   (define (codegen-destructor tor)
-    (codegen-expr (cadr e) si env)
+    (when (not (eqv? 'stack (ast-type (cadr e))))
+      (error #f "expected stack value"))
+    (let* ([stack-expr (cadr e)]
+         [stack-body (caddr stack-expr)]
+         [stack-type (cadr stack-expr)])
+      
+    (codegen-expr stack-body si env)
     (let ([index (cadr tor)]
          [products 2]
          [to-traverse (list-head products index)]
@@ -378,9 +384,9 @@
                   wordsize ; skip tag in first word
                   to-traverse)])
       3
-      ))
+      )))
   
-  (let ([tor (data-tor env e)]
+  (let* ([tor (data-tor env e)]
         [constructor (eqv? 'constructor (cadr tor))])
     (if constructor
        (codegen-constructor tor)
@@ -423,19 +429,21 @@
     ('static-string (emit "movq ~a@GOTPCREL(%rip), %rax"
                          (cadr e)))
 
+    ('stack (error #f "stack value that needs explicit handling" e))
+
     (else (error #f "don't know how to codegen this"))))
 
                                        ; takes in a expr annotated with types and returns a type-less AST
                                        ; with stack values wrapped
 (define (annotate-stack-values data-layout ann-e)
-  (define (struct-type? type)
+  (define (stack-type? type)
     (assoc type data-layout))
   (define (strip e)
     (ast-traverse strip (ann-expr e)))
   (let* ([e (ann-expr ann-e)]
         [type (ann-type ann-e)])
-    (if (struct-type? type)
-       `(struct ,(type-size data-layout type) ,(ast-traverse strip e))
+    (if (stack-type? type)
+       `(stack ,type ,(ast-traverse strip e))
        (ast-traverse (lambda (x)
                        (annotate-stack-values data-layout x))
                      e))))

diff --git a/tests.scm b/tests.scm
index 87ed2a6461004eaf44ef2fcd3c1e0ea18aa87ef4..648ce073fbb97526b1a70e8327842a905dae35fa 100644 (file)
--- a/tests.scm
+++ b/tests.scm
@@ -227,7 +227,7 @@
 
                                        ; adts and pattern matching
 
-(test-prog '((data (A [foo Int]))
+(test-prog '((data A [foo Int])
             (let ([(foo x) (foo 42)])
               x))
           42)