diff --git a/dupe-plus-plus/parse.rkt b/dupe-plus-plus/parse.rkt index 23280cc..ce769d6 100644 --- a/dupe-plus-plus/parse.rkt +++ b/dupe-plus-plus/parse.rkt @@ -57,8 +57,7 @@ ;; S-Expr -> Datum (define (parse-datum s) - (if (or (integer? s) - (boolean? s)) + (if (datum? s) s (error "parse error: not a datum"))) diff --git a/extort-plus/assert.rkt b/extort-plus/assert.rkt index 6587cb3..9d88901 100644 --- a/extort-plus/assert.rkt +++ b/extort-plus/assert.rkt @@ -3,20 +3,20 @@ (require a86/ast) (require "types.rkt") -(define r9 'r9) - ;; Register -> Asm (define (assert-integer r) - (seq (Mov r9 r) - (And r9 mask-int) - (Cmp r9 type-int) + (seq (Push r) + (And r mask-int) + (Cmp r type-int) + (Pop r) (Jne 'err))) ;; Register -> Asm (define (assert-char r) - (seq (Mov r9 r) - (And r9 mask-char) - (Cmp r9 type-char) + (seq (Push r) + (And r mask-char) + (Cmp r type-char) + (Pop r) (Jne 'err))) ;; Register -> Asm diff --git a/extort-plus/ast.rkt b/extort-plus/ast.rkt index 20933ce..fa97561 100644 --- a/extort-plus/ast.rkt +++ b/extort-plus/ast.rkt @@ -1,11 +1,13 @@ #lang racket -(provide Lit Prim0 Prim1 If +(provide Lit Prim0 Prim1 If Cond Case Eof Begin) ;; type Expr = (Lit Datum) ;; | (Eof) ;; | (Prim0 Op0) ;; | (Prim1 Op1 Expr) ;; | (If Expr Expr Expr) +;; | (Cond [Listof Expr] [Listof Expr] Expr) +;; | (Case Expr [Listof [Listof Datum]] [Listof Expr] Expr) ;; | (Begin Expr Expr) ;; type Datum = Integer ;; | Boolean @@ -22,4 +24,6 @@ (struct Prim1 (p e) #:prefab) (struct If (e1 e2 e3) #:prefab) (struct Begin (e1 e2) #:prefab) +(struct Cond (cs es el) #:prefab) +(struct Case (e ds es el) #:prefab) diff --git a/extort-plus/compile-ops.rkt b/extort-plus/compile-ops.rkt index 2cbc5b9..c34057c 100644 --- a/extort-plus/compile-ops.rkt +++ b/extort-plus/compile-ops.rkt @@ -25,6 +25,15 @@ (seq (assert-integer rax) (Cmp rax 0) if-equal)] + ['abs + ;; TODO + (seq)] + ['- + ;; TODO + (seq)] + ['not + ;; TODO + (seq)] ['char? (seq (And rax mask-char) (Cmp rax type-char) diff --git a/extort-plus/compile.rkt b/extort-plus/compile.rkt index 0086c31..f5fcc02 100644 --- a/extort-plus/compile.rkt +++ b/extort-plus/compile.rkt @@ -32,6 +32,10 @@ [(Prim1 p e) (compile-prim1 p e)] [(If e1 e2 e3) (compile-if e1 e2 e3)] + [(Cond eqs eas el) ;; TODO + (seq)] + [(Case e ds es el) ;; TODO + (seq)] [(Begin e1 e2) (compile-begin e1 e2)])) diff --git a/extort-plus/interp.rkt b/extort-plus/interp.rkt index a67798a..7a91e4b 100644 --- a/extort-plus/interp.rkt +++ b/extort-plus/interp.rkt @@ -22,6 +22,12 @@ (match (interp e) ['err 'err] [v (interp-prim1 p v)])] + [(Cond eqs eas el) + ;; TODO + 0] + [(Case e ds es el) + ;; TODO + 0] [(If e1 e2 e3) (match (interp e1) ['err 'err] diff --git a/extort-plus/parse.rkt b/extort-plus/parse.rkt index 765c58f..a4482be 100644 --- a/extort-plus/parse.rkt +++ b/extort-plus/parse.rkt @@ -28,9 +28,49 @@ [(list s1 s2 s3) (If (parse s1) (parse s2) (parse s3))] [_ (error "if: bad syntax" s)])] + ['cond + (parse-cond sr)] + ['case + (parse-case sr)] [_ (error "parse error" s)])] [_ (error "parse error" s)])) +;; S-Expr -> Cond +(define (parse-cond s) + (match s + [(list (list 'else s)) (Cond '() '() (parse s))] + [(cons (list s1 s2) sr) + (match (parse-cond sr) + [(Cond qs es e) + (Cond (cons (parse s1) qs) (cons (parse s2) es) e)])] + [_ (error "parse error")])) + +;; S-Expr -> Case +(define (parse-case s) + (match s + [(cons s sr) + (parse-case-clauses s sr)] + [_ + (error "parse error")])) + +;; S-Expr S-Expr -> Case +(define (parse-case-clauses s sr) + (match sr + [(list (list 'else s2)) (Case (parse s) '() '() (parse s2))] + [(cons (list d1 s1) sr) + (match (parse-case-clauses s sr) + [(Case e ds es el) + (Case e + (cons (map parse-datum d1) ds) + (cons (parse s1) es) + el)])])) + +;; S-Expr -> Datum +(define (parse-datum s) + (if (datum? s) + s + (error "parse error: not a datum"))) + ;; Any -> Boolean (define (datum? x) (or (exact-integer? x) @@ -42,7 +82,7 @@ (memq x '(read-byte peek-byte void))) (define (op1? x) - (memq x '(add1 sub1 zero? + (memq x '(add1 sub1 zero? abs - not char? integer->char char->integer write-byte eof-object?))) diff --git a/iniquity-plus/assert.rkt b/iniquity-plus/assert.rkt index 8327110..cfc110a 100644 --- a/iniquity-plus/assert.rkt +++ b/iniquity-plus/assert.rkt @@ -5,13 +5,12 @@ (require a86/ast) (require "types.rkt") -(define r9 'r9) - (define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) + (λ (r) + (seq (Push r) + (And r mask) + (Cmp r type) + (Pop r) (Jne 'err)))) ;; Register -> Asm diff --git a/knock-plus/assert.rkt b/knock-plus/assert.rkt index 8327110..cfc110a 100644 --- a/knock-plus/assert.rkt +++ b/knock-plus/assert.rkt @@ -5,13 +5,12 @@ (require a86/ast) (require "types.rkt") -(define r9 'r9) - (define (assert-type mask type) - (λ (arg) - (seq (Mov r9 arg) - (And r9 mask) - (Cmp r9 type) + (λ (r) + (seq (Push r) + (And r mask) + (Cmp r type) + (Pop r) (Jne 'err)))) ;; Register -> Asm