This commit is contained in:
Michael Zhang 2018-02-13 17:43:40 -06:00
commit bbd73d5f4a
No known key found for this signature in database
GPG key ID: A1B65B603268116B
6 changed files with 106 additions and 0 deletions

6
.gitignore vendored Normal file
View file

@ -0,0 +1,6 @@
lexer.ml
parser.ml
parser.mli
*.cmo
*.cmi

28
Makefile Normal file
View file

@ -0,0 +1,28 @@
.PHONY: all clean
types.cmo: types.ml
ocamlc -o $@ -c $^
parser: parser.mly
ocamlyacc $^
parser.cmo: parser
ocamlc -c parser.mli
ocamlc -c parser.ml
lexer.cmo: lexer.ml
ocamlc -o $@ -c $^
lexer.ml: parser.cmo
ocamllex lexer.mll
lambda.cmo: lambda.ml
ocamlc -o $@ -c $^
clean:
rm -f lexer.ml parser.ml parser.mli
rm -f *.cmo *.cmi
all: types.cmo lexer.cmo parser.cmo lambda.cmo
ocaml types.cmo parser.cmo lexer.cmo lambda.cmo

26
lambda.ml Normal file
View file

@ -0,0 +1,26 @@
open Lexer
open Lexing
open Parser
open Types
let rec string_of_term (t:term) =
match t with
| TmAbs(x, t1) ->
"(\\" ^ (String.make 1 x) ^ "." ^ (string_of_term t1) ^ ")"
| TmApp(t1, t2) ->
"(" ^ (string_of_term t1) ^ (string_of_term t2) ^ ")"
| TmVar(x) ->
String.make 1 x
let _ =
try
let rec loop ctx =
print_string "> "; flush stdout;
let lexbuf = Lexing.from_channel stdin in
let result = Parser.main Lexer.token lexbuf in
print_endline (string_of_term result); flush stdout;
loop ctx in
loop []
with Lexer.Eof ->
print_endline "error";
exit 0

12
lexer.mll Normal file
View file

@ -0,0 +1,12 @@
{
open Parser
exception Eof
}
rule token = parse
| ' ' | '\t' { token lexbuf }
| '\n' { EOL }
| '\\' { Lambda }
| '.' { Dot }
| ['a'-'z'] as c | ['A'-'Z'] as c { Ident(c) }
| eof { raise Eof }

25
parser.mly Normal file
View file

@ -0,0 +1,25 @@
%{
open Types
%}
%token EOL
%token Dot
%token <char> Ident
%token Lambda
%start main
%type <Types.term> main
%%
main:
expr EOL { $1 }
;
expr:
| var { Types.TmVar($1) }
| Lambda var Dot expr { Types.TmAbs($2, $4) }
| expr expr { Types.TmApp ($1, $2) }
;
var:
Ident { $1 }
;

9
types.ml Normal file
View file

@ -0,0 +1,9 @@
type term =
| TmVar of char
| TmAbs of char * term
| TmApp of term * term
type binding = NameBind
type context = (char * binding) list