(define make-env list)
(define env-data-layouts car)
(define env-bindings cadr)
+(define (env-append-bindings env bindings)
+ (make-env (env-data-layouts env)
+ (append bindings (env-bindings env))))
(define (codegen-add xs si env)
(define (go ys)
; checks if equal and returns assoc list of bindings
(define (check-equal jne-label type inner-offset x)
+ ; TODO: tidy this up! comparibles and binds could be merged
; (foo a 2 (bar x)) -> ((2 Int 1) ((bar x) A 2))
; sum: foo
(define (comparibles sum)
- (if (not (list? sum))
- '()
(let ([product-types (cdr (assoc sum (cdr (assoc type dls))))])
+ (if (null? product-types)
+ '()
(filter (lambda (x) (not (eqv? 'var (ast-type (car x)))))
(map (lambda (x t i) (list x t i))
(cdr x)
product-types
(range 0 (length product-types)))))))
+ (define (binds sum)
+ (let ([product-types (cdr (assoc sum (cdr (assoc type dls))))])
+ (if (null? product-types)
+ '()
+ (filter (lambda (x) (eqv? 'var (ast-type (car x))))
+ (map (lambda (x i)
+ (cons x
+ (- inner-offset
+ (data-product-offset dls type sum i))))
+ (cdr x)
+ (range 0 (length (cdr x))))))))
+
+
(let ([sums (assoc type dls)])
(if sums
(let* ([sum (if (list? x) (car x) x)] ; can sometimes be a singleton
; the tag is at the top (beginning) of the adt on the stack
(emit "cmpq $~a, ~a(%rbp)" tag inner-offset)
(emit "jne ~a" jne-label)
+
+ (append (binds sum)
(flat-map
- (lambda (cmpx cmpt cmpi)
+ (lambda (cmp) ; cmp = (x type index)
(check-equal jne-label
- cmpt
- (- inner-offset (data-product-offset dls type sum i))
- cmpx))
- (comparibles sum)))
+ (cadr cmp)
+ (- inner-offset (data-product-offset dls type sum (caddr cmp)))
+ (car cmp)))
+ (comparibles sum))))
(if (eqv? 'var (ast-type x))
(list (cons x inner-offset))
(begin
[expr (cadr case)]
[next-section-label (fresh-label)]
[inner-si (- si (type-size dls type))]
- [new-env (append (check-equal next-section-label type si match)
- env)])
+ [new-env (env-append-bindings env
+ (check-equal next-section-label type si match))])
+
(codegen-expr expr inner-si new-env)
(emit "jmp ~a" exit-label)