Crook

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

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

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)
 

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)

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

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]

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

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

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