#lang plai (require redex/reduction-semantics) ;; Step 6: now we finish up inlining the rest of the cases ;; drop fill, and rename find to norm/k (define-type context [let-ctxt (x var?) (b L4-e?) (k (-> d? L3-e?))] [if-ctxt (t L4-e?) (e L4-e?) (k (-> d? L3-e?))] [fun-ctxt (a L4-e?) (k (-> d? L3-e?))] [arg-ctxt (f val?) (k (-> d? L3-e?))] [no-ctxt]) ;; find : L3e (d -> L2e) -> L2e (define (norm/k e k) (match e [`(,f ,a) (norm/k f (λ (d) (if (val? d) (norm/k a (let ([f d]) (λ (d) (if (val? d) (k `(,f ,d)) (let ([x (fresh-var)]) `(let ([,x ,d]) ,(k `(,f ,x)))))))) (let ([x (fresh-var)]) `(let ([,x ,d]) ,(norm/k a (let ([f x]) (λ (d) (if (val? d) (k `(,f ,d)) (let ([x (fresh-var)]) `(let ([,x ,d]) ,(k `(,f ,x)))))))))))))] [`(let ([,x ,r]) ,b) (norm/k r (λ (d) `(let ([,x ,d]) ,(norm/k b k))))] [`(if ,c ,t ,e) (norm/k c (λ (d) (if (val? d) `(if ,d ,(norm/k t k) ,(norm/k e k)) (let ([x (fresh-var)]) `(let ([,x ,d]) (if ,x ,(norm/k t k) ,(norm/k e k)))))))] [(? val?) (k e)])) ;; fill : context -> d -> L2e (define (norm e) (norm/k e (λ (x) x))) (define-language L3 (p (e (l (x ...) e) ...)) ;; a main expression followed by function definitions (d (biop v v) (pred v) (v v ...) (new-array v v) (new-tuple v ...) (aref v v) (aset v v v) (alen v) (print v) (make-closure l v) (closure-proc v) (closure-vars v) v) (e d (let ([x d]) e) (if v e e)) (v x l num) (x (side-condition (name x variable-not-otherwise-mentioned) (variable? (term x)))) (l (side-condition (name x (variable-prefix :)) (regexp-match #rx"^:[a-zA-Z_0-9]*\$" (symbol->string (term x))))) (biop + - * cmpop) (cmpop < <= =) (pred number? a?) (num (side-condition number_1 (32-bit-int? (term number_1))))) (define-extended-language L4 L3 (e x l (biop e e) (pred e) (let ([x e]) e) (if e e e) (new-array e e) (new-tuple e ...) (aref e e) (aset e e e) (alen e) (e e ...) (begin e e) (print e) (make-closure l e) (closure-proc e) (closure-vars e) num)) (define (variable? x) (and (not (label? x)) (not (real-register? x)))) (define (label? x) (and (symbol? x) (regexp-match #rx"^:" (symbol->string x)))) (define (real-register? x) (member x '(eax ebx ecx edx esi edi esp ebp))) (define (32-bit-int? x) (and (integer? x) (<= (- (expt 2 31)) x) (< x (expt 2 31)))) (define (var? x) (symbol? x)) (define (val? x) (or (symbol? x) (number? x))) (define d? (redex-match L3 d)) (define L4-e? (redex-match L4 e)) (define L3-e? (redex-match L3 e)) (define count 0) (define (fresh-var) (set! count (+ count 1)) (string->symbol (format "x_~a" count))) (print-only-errors #t) (test (norm '((a b) (c d))) '(let ([x_1 (a b)]) (let ([x_2 (c d)]) (x_1 x_2)))) (test (norm '(f (if a b c))) '(if a (f b) (f c))) (test (norm '(if (a b) c d)) '(let ([x_3 (a b)]) (if x_3 c d))) (test (norm '(f (let ([x (a b)]) x))) '(let ([x (a b)]) (f x)))