initial import
This commit is contained in:
commit
d6feb2f2d7
|
@ -0,0 +1,7 @@
|
|||
all:
|
||||
dune build bin/main.exe
|
||||
|
||||
clean:
|
||||
dune clean
|
||||
|
||||
.PHONY: all clean
|
|
@ -0,0 +1,4 @@
|
|||
(executable
|
||||
(public_name zml)
|
||||
(name main)
|
||||
(libraries zml))
|
|
@ -0,0 +1 @@
|
|||
let () = print_endline "Hello, World!"
|
|
@ -0,0 +1,2 @@
|
|||
(lang dune 1.11)
|
||||
(name zml)
|
|
@ -0,0 +1,34 @@
|
|||
(* Abstract syntax. *)
|
||||
|
||||
type position = { line: int; column: int }
|
||||
type location = { startp: position; endp: position }
|
||||
type 'a located = { t: 'a; l: location }
|
||||
|
||||
(* Variable names *)
|
||||
type name = string
|
||||
|
||||
(* Types *)
|
||||
type ty =
|
||||
| TInt (* Integers *)
|
||||
| TBool (* Booleans *)
|
||||
| TArrow of ty * ty (* Functions *)
|
||||
|
||||
(* Expressions *)
|
||||
type expr = expr' located
|
||||
and expr' =
|
||||
| Var of name (* Variable *)
|
||||
| Int of int (* Non-negative integer constant *)
|
||||
| Bool of bool (* Boolean constant *)
|
||||
| Times of expr * expr (* Product [e1 * e2] *)
|
||||
| Plus of expr * expr (* Sum [e1 + e2] *)
|
||||
| Minus of expr * expr (* Difference [e1 - e2] *)
|
||||
| Equal of expr * expr (* Integer comparison [e1 = e2] *)
|
||||
| Less of expr * expr (* Integer comparison [e1 < e2] *)
|
||||
| If of expr * expr * expr (* Conditional [if e1 then e2 else e3] *)
|
||||
| Fun of name * name * ty * ty * expr (* Function [fun f(x:s):t is e] *)
|
||||
| Apply of expr * expr (* Application [e1 e2] *)
|
||||
|
||||
(* Toplevel commands *)
|
||||
type command =
|
||||
| Expr of expr (* Expression *)
|
||||
| Def of name * expr (* Value definition [let x = e] *)
|
|
@ -0,0 +1,134 @@
|
|||
{
|
||||
open Ast
|
||||
open Parser
|
||||
|
||||
let position pos =
|
||||
let line = pos.Lexing.pos_lnum in
|
||||
let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
|
||||
{ line; column }
|
||||
|
||||
let lexbuf_location lexbuf =
|
||||
let startp = lexbuf.Lexing.lex_start_p in
|
||||
let endp = lexbuf.Lexing.lex_curr_p in
|
||||
{ startp = position startp; endp = position endp }
|
||||
|
||||
let lexbuf_located t lexbuf =
|
||||
{ t; p = lexbuf_location lexbuf }
|
||||
|
||||
let temp_buffer = Buffer.create 127
|
||||
|
||||
let flush_buffer () =
|
||||
let str = Buffer.contents temp_buffer in
|
||||
Buffer.reset temp_buffer;
|
||||
str
|
||||
|
||||
let hashtable lst =
|
||||
let table = Hashtbl.create (List.length lst) in
|
||||
List.iter (fun (k, v) -> Hashtbl.add table k v) lst;
|
||||
table
|
||||
|
||||
let idents = hashtable [
|
||||
"type" , TYPE;
|
||||
"rec" , REC;
|
||||
"let" , LET;
|
||||
"match" , MATCH;
|
||||
"with" , WITH;
|
||||
"end" , END;
|
||||
"and" , AND;
|
||||
"if" , IF;
|
||||
"then" , THEN;
|
||||
"else" , ELSE;
|
||||
"fn" , FN;
|
||||
"def" , DEF;
|
||||
]
|
||||
|
||||
type error =
|
||||
| Unknown_word of string
|
||||
| Unterminated_string
|
||||
| Invalid_escape of char
|
||||
|
||||
exception Error of Lexing.position * error
|
||||
let error lexbuf x =
|
||||
Buffer.reset temp_buffer;
|
||||
raise (Error (lexbuf.Lexing.lex_curr_p, x))
|
||||
|
||||
|
||||
let () = Printexc.register_printer (function
|
||||
| Error (pos, e) ->
|
||||
let msg = match e with
|
||||
| Unknown_word word -> Printf.sprintf "unknown word %S" word
|
||||
| Unterminated_string -> "unterminated string"
|
||||
| Invalid_escape c -> Printf.sprintf "invalid escape %C" c
|
||||
in
|
||||
Some (
|
||||
Printf.sprintf "Lexer.Error in %S, line %d column %d: %s"
|
||||
pos.Lexing.pos_fname
|
||||
pos.Lexing.pos_lnum
|
||||
(pos.Lexing.pos_cnum - pos.Lexing.pos_bol)
|
||||
msg
|
||||
)
|
||||
| _ -> None
|
||||
)
|
||||
}
|
||||
|
||||
let identchar = ['a'-'z' 'A'-'Z' '0'-'9' '_']
|
||||
let lident = ['a'-'z' '_'] identchar*
|
||||
let uident = ['A'-'Z'] identchar*
|
||||
|
||||
let digit = ['0'-'9']
|
||||
let number = digit+
|
||||
|
||||
rule token = parse
|
||||
| number as n { NUMBER (Number n) }
|
||||
| ":<" { COLON_LANGLE }
|
||||
| ">" { RANGLE }
|
||||
| "(" { LPAREN }
|
||||
| ")" { RPAREN }
|
||||
| "|" { BAR }
|
||||
| "=" { EQUAL }
|
||||
| ":" { COLON }
|
||||
| ";" { SEMI }
|
||||
| "," { COMMA }
|
||||
| "=>" { EQUAL_RANGLE }
|
||||
| "_" { UNDERSCORE }
|
||||
| lident as id {
|
||||
try Hashtbl.find idents id
|
||||
with Not_found -> error lexbuf (Unknown_word id)
|
||||
}
|
||||
| uident as id { UIDENT id }
|
||||
| '"' { Buffer.reset temp_buffer; string lexbuf }
|
||||
| "//" { Buffer.reset temp_buffer; comment lexbuf }
|
||||
| ('\n' | "\r\n") { Lexing.new_line lexbuf; token lexbuf }
|
||||
| [' ' '\t']+ { token lexbuf }
|
||||
| eof { EOF }
|
||||
|
||||
and comment = parse
|
||||
| [^'\n']+ as str {
|
||||
Buffer.add_string temp_buffer str;
|
||||
comment lexbuf
|
||||
}
|
||||
| '\n' { Lexing.new_line lexbuf; COMMENT (flush_buffer ()) }
|
||||
| eof { COMMENT (flush_buffer ()) }
|
||||
|
||||
and string = parse
|
||||
| ([^ '"' '\n' '\\']+) as str {
|
||||
Buffer.add_string temp_buffer str;
|
||||
string lexbuf
|
||||
}
|
||||
| '\n' { Lexing.new_line lexbuf; Buffer.add_char temp_buffer '\n'; string lexbuf }
|
||||
| "\\" (_ as c) {
|
||||
let c = match c with
|
||||
| 'n' -> '\n'
|
||||
| 'r' -> '\r'
|
||||
| 't' -> '\t'
|
||||
| '"' -> '"'
|
||||
| c -> error lexbuf (Invalid_escape c)
|
||||
in
|
||||
Buffer.add_char temp_buffer c;
|
||||
string lexbuf
|
||||
}
|
||||
| '"' { STRING (flush_buffer ()) }
|
||||
| eof { error lexbuf Unterminated_string }
|
||||
|
||||
{
|
||||
}
|
|
@ -0,0 +1,183 @@
|
|||
%{
|
||||
open Syntax
|
||||
%}
|
||||
|
||||
%token COLON_LANGLE ":<"
|
||||
(*%token LANGLE "<"*)
|
||||
%token BAR "|"
|
||||
%token COLON ":"
|
||||
%token COMMA ","
|
||||
%token EQUAL "="
|
||||
%token EQUAL_RANGLE "=>"
|
||||
%token LPAREN "("
|
||||
%token RPAREN ")"
|
||||
%token RANGLE ">"
|
||||
%token SEMI ";"
|
||||
%token UNDERSCORE "_"
|
||||
%token AND "and"
|
||||
%token DEF "def"
|
||||
%token ELSE "else"
|
||||
%token END "end"
|
||||
%token FN "fn"
|
||||
%token IF "if"
|
||||
%token LET "let"
|
||||
%token MATCH "match"
|
||||
%token REC "rec"
|
||||
%token THEN "then"
|
||||
%token TYPE "type"
|
||||
%token WITH "with"
|
||||
%token EOF
|
||||
%token<string Syntax.located> INT
|
||||
%token<string Syntax.located> LIDENT UIDENT
|
||||
%token<string Syntax.located> STRING
|
||||
%token COMMENT
|
||||
|
||||
%start file
|
||||
%type <Syntax.program> file
|
||||
|
||||
%%
|
||||
|
||||
(* Useful definitions *)
|
||||
|
||||
%inline with_loc(T):
|
||||
| T { failwith "TODO" }
|
||||
;
|
||||
|
||||
nonempty_sep_list(SEP, T):
|
||||
| T { [$1] }
|
||||
| T SEP sep_list(SEP, T) { $1 :: $3 }
|
||||
;
|
||||
|
||||
sep_list(SEP, T):
|
||||
| (* empty *) { [] }
|
||||
| nonempty_sep_list(SEP, T) { $1 }
|
||||
;
|
||||
|
||||
comma_list(T):
|
||||
| sep_list(",", T) { $1 }
|
||||
;
|
||||
|
||||
(* Type definition *)
|
||||
|
||||
type_parameters:
|
||||
| (* empty *) { [] }
|
||||
| ":<" comma_list(LIDENT) ">" { $2 }
|
||||
;
|
||||
|
||||
(* Data constructors definition *)
|
||||
constructor_definition:
|
||||
| UIDENT
|
||||
{ failwith "TODO" }
|
||||
| UIDENT "(" comma_list(type_expr) ")"
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
type_body:
|
||||
| "|"? nonempty_sep_list("|", constructor_definition)
|
||||
{ $2 }
|
||||
;
|
||||
|
||||
type_definition:
|
||||
| LIDENT type_parameters "=" type_body
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
type_definitions:
|
||||
| "type" "rec"? nonempty_sep_list("and", type_definition)
|
||||
{ $2, $3 }
|
||||
;
|
||||
|
||||
(* Let definitions *)
|
||||
|
||||
func_parameter:
|
||||
| LIDENT ":" type_expr
|
||||
{ $1, $3 }
|
||||
;
|
||||
|
||||
func_parameters:
|
||||
| "(" comma_list(func_parameter) ")"
|
||||
{ $2 }
|
||||
;
|
||||
|
||||
return_type:
|
||||
| ":" type_expr
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
let_definition:
|
||||
| UIDENT type_parameters func_parameters? return_type? "=" expr
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
let_definitions:
|
||||
| "def" "rec"? nonempty_sep_list("and", let_definition)
|
||||
{ $2, $3 }
|
||||
;
|
||||
|
||||
(* Type expressions *)
|
||||
|
||||
type_arguments:
|
||||
| (* empty *)
|
||||
{ [] }
|
||||
| ":<" comma_list(type_expr) ">"
|
||||
{ $2 }
|
||||
;
|
||||
|
||||
type_expr: with_loc(type_expr_) { $1 };
|
||||
type_expr_:
|
||||
| LIDENT type_arguments
|
||||
| "fn" "(" comma_list(type_expr) ")" ":" type_expr
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
(* Expressions *)
|
||||
|
||||
constant: with_loc(constant_) { $1 };
|
||||
%inline constant_:
|
||||
| INT { Const_int $1 }
|
||||
;
|
||||
|
||||
ident:
|
||||
| LIDENT { $1 }
|
||||
| UIDENT { $1 }
|
||||
;
|
||||
|
||||
expr: with_loc(expr_) { $1 };
|
||||
expr_:
|
||||
| constant { $1 }
|
||||
| "(" expr ")"
|
||||
| ident type_arguments
|
||||
| ident type_arguments "(" comma_list(expr) ")"
|
||||
| "let" ident "=" expr ";" expr
|
||||
| "if" expr "then" expr "else" expr "end"
|
||||
| "match" expr "with" "|"? nonempty_sep_list("|", match_case) "end"
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
match_case:
|
||||
| pattern "=>" expr { $1 }
|
||||
;
|
||||
|
||||
pattern: with_loc(pattern_) { $1 }
|
||||
pattern_:
|
||||
| "_"
|
||||
| LIDENT
|
||||
| UIDENT
|
||||
| UIDENT "(" comma_list(pattern) ")"
|
||||
{ failwith "TODO" }
|
||||
;
|
||||
|
||||
(* Program *)
|
||||
|
||||
definition:
|
||||
| with_loc(type_definitions)
|
||||
{ Def_type $1 }
|
||||
| with_loc(let_definitions)
|
||||
{ Def_let $1 }
|
||||
;
|
||||
|
||||
file:
|
||||
| list(definition) EOF { $1 }
|
||||
;
|
||||
|
||||
%%
|
Loading…
Reference in New Issue