diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a13427f --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +compiled \ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3fee9b9 --- /dev/null +++ b/Makefile @@ -0,0 +1,9 @@ +compile: *.rkt + raco make *.rkt + +test: tests/*.rkt + racket tests/*.rkt + +.PHONY : compile clean test +clean: + rm -r compiled diff --git a/ast.rkt b/ast.rkt index 4bb9039..594e47d 100644 --- a/ast.rkt +++ b/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) diff --git a/parser.rkt b/parser.rkt index 9cccd92..7ca1c18 100644 --- a/parser.rkt +++ b/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)]]])) diff --git a/prelude.core b/prelude.core new file mode 100644 index 0000000..1cb6b28 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/printer.rkt b/printer.rkt index 7de8dad..000765b 100644 --- a/printer.rkt +++ b/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 diff --git a/semantics.rkt b/semantics.rkt index a05eeeb..befd578 100644 --- a/semantics.rkt +++ b/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)) diff --git a/tests/parser.rkt b/tests/parser.rkt new file mode 100644 index 0000000..0b61ce8 --- /dev/null +++ b/tests/parser.rkt @@ -0,0 +1,37 @@ +#lang typed/racket +(require "../typed-parser.rkt") +(require typed/rackunit) + +(test-begin + (check-equal? (parse-from-string + #< -> 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 + #<