Add tests

.gitignore

@@ -0,0 +1 @@
+compiled

Makefile

@@ -0,0 +1,9 @@
+compile: *.rkt
+	raco make *.rkt
+
+test: tests/*.rkt
+	racket tests/*.rkt
+
+.PHONY : compile clean test
+clean:
+	rm -r compiled

ast.rkt

@@ -7,7 +7,7 @@
 
 (define-type (Bind A) (List A (Expr A)))
 (define-type (Binds A) (Pair (Bind A) (Listof (Bind A))))
-(define-type (Alt A) (List 'branch ConId (Listof A) (Expr A)))
+(define-type (Alt A) (List ConId (Listof A) (Expr A)))
 (define-type (Alts A) (Pair (Alt A) (Listof (Alt A))))
 
 (define-type (Expr A)

parser.rkt

@@ -40,7 +40,7 @@
    [";" (token-SEMICOLON)]
    [(+ numeric) (token-NUM (string->number  lexeme))]
    [(: alphabetic (* (or alphabetic numeric #\_))) (token-VAR (string->symbol lexeme))]
-   [blank (core/lexer input-port)]))
+   [whitespace (core/lexer input-port)]))
 
 (define core/parser
   (parser
@@ -86,7 +86,7 @@
     [vars [() (list)]
           [(vars VAR) (cons $2 $1)]]
     [vars1 [(vars VAR) (cons $2 $1)]]
-    [alt [(LBRAK NUM RBRAK vars ARROW expr) (list 'branch $2 (reverse $4) $6)]]
+    [alt [(LBRAK NUM RBRAK vars ARROW expr) (list $2 (reverse $4) $6)]]
     [alts [(alt) (list $1)]
           [(alts SEMICOLON alt) (cons $3 $1)]]]))
 

prelude.core

@@ -0,0 +1,6 @@
+I x = x ;
+K x y = x ;
+K1 x y = y ;
+S f g x = f x (g x) ;
+compose f g x = f (g x) ;
+twice f = compose f f

printer.rkt

@@ -36,7 +36,7 @@
 (: ppr-alt (-> CoreAlt ISeq))
 (define (ppr-alt a)
   (match a
-    [(list 'branch con xs body)
+    [(list con xs body)
      (iseq-append-with-sep
       " "
       (iseq-append

semantics.rkt

@@ -1,6 +1,10 @@
 #lang typed/racket
 (require "ast.rkt")
 
+(: prelude CoreProgram)
+(define prelude
+  '((define (I x) x) (define (K x y) x) (define (K1 x y) y) (define (S f g x) ((f x) (g x))) (define (compose f g x) (f (g x))) (define (twice f) ((compose f) f))))
+
 (struct State ([stack : Stack] [dump : Dump] [heap : Heap] [globals : Globals] [stats : Stats]))
 (define-type Addr Symbol)
 (define-type Stack (Listof Addr))

tests/parser.rkt

@@ -0,0 +1,37 @@
+#lang typed/racket
+(require "../typed-parser.rkt")
+(require typed/rackunit)
+
+(test-begin
+  (check-equal? (parse-from-string
+                 #<<END
+I x = x ;
+ K x y = x ;
+K1 x y = y ;
+S f g x = f x (g x) ;
+compose f g x = f (g x) ;
+  twice f = compose f f ;
+Q x = Pack {3 , 1 } x ;
+P x = case x of
+        <1> -> 0 ;
+        <2> x -> 1 + P x
+END
+)
+                '((define (I x) x)
+                  (define (K x y) x)
+                  (define (K1 x y) y)
+                  (define (S f g x) ((f x) (g x)))
+                  (define (compose f g x) (f (g x)))
+                  (define (twice f) ((compose f) f))
+                  (define (Q x) ((pack 3 1) x))
+                  (define (P x) (case x ((1 () 0) (2 (x) ((+ 1) (P x))))))))
+  (check-equal? (parse-from-string
+                 #<<END
+foo o = let x = 4 ;
+    y = let z = 3 ;
+            k = 4 in k + z in
+    x + y + o
+END
+) '((define (foo o)
+      (let ((x 4)(y (let ((z 3)(k 4)) ((+ k) z))))
+        ((+ ((+ x) y)) o))))))