A bit more work on ADT codegen

[scheme.git] / codegen.scm

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))))