a
This commit is contained in:
parent
4c39223610
commit
4ea1071ca1
10 changed files with 83 additions and 88 deletions
0
.ocamlformat
Normal file
0
.ocamlformat
Normal file
6
Justfile
Normal file
6
Justfile
Normal file
|
@ -0,0 +1,6 @@
|
|||
example:
|
||||
dune build
|
||||
dune exec e0 < examples/basic.e0
|
||||
|
||||
fmt:
|
||||
fd -e ml | xargs ocamlformat -i
|
|
@ -4,4 +4,9 @@ let () =
|
|||
let p = Lexing.from_channel stdin |> Parse.try_parse in
|
||||
match p with
|
||||
| Error msg -> Printf.eprintf "Could not load program: %s" msg
|
||||
| Ok p -> Ast.show_program p |> print_endline
|
||||
| Ok p ->
|
||||
let decl_map = Typeck.get_decl_map p in
|
||||
Hashtbl.iter
|
||||
(fun name ty -> Printf.eprintf " %s : %s\n" name (Ast.show_ty ty))
|
||||
decl_map;
|
||||
Ast.show_program p |> print_endline
|
||||
|
|
63
lib/ast.ml
63
lib/ast.ml
|
@ -1,61 +1,28 @@
|
|||
type op
|
||||
= OpAdd
|
||||
| OpSub
|
||||
| OpMul
|
||||
| OpDiv
|
||||
type op = OpAdd | OpSub | OpMul | OpDiv [@@deriving show]
|
||||
|
||||
type lit = LitInt of int | LitNegInt of int | LitFloat of float
|
||||
[@@deriving show]
|
||||
|
||||
type lit
|
||||
= LitInt of int
|
||||
| LitNegInt of int
|
||||
| LitFloat of float
|
||||
[@@deriving show]
|
||||
|
||||
type ty
|
||||
= TySizedInt
|
||||
type ty =
|
||||
| TyUnit
|
||||
| TySizedInt
|
||||
| TyGenericInt
|
||||
| TyFunc of ty list * ty
|
||||
| TyPointer of ty
|
||||
| TyStruct of (string * ty) list
|
||||
[@@deriving show]
|
||||
|
||||
type expr
|
||||
= ExprUnit
|
||||
type expr =
|
||||
| ExprUnit
|
||||
| ExprLit of lit
|
||||
| ExprBin of expr * op * expr
|
||||
| ExprAnnot of expr * ty
|
||||
[@@deriving show]
|
||||
|
||||
type pat
|
||||
= PatName of string
|
||||
[@@deriving show]
|
||||
|
||||
type stmt
|
||||
= StmtLet of pat * expr
|
||||
| StmtReturn of expr
|
||||
[@@deriving show]
|
||||
|
||||
type block =
|
||||
{ stmts : stmt list
|
||||
; ret : expr
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type func =
|
||||
{ name : string
|
||||
; body : block
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type extern_func =
|
||||
{ name : string
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type decl
|
||||
= DeclFunc of func
|
||||
| DeclExternFunc of extern_func
|
||||
[@@deriving show]
|
||||
|
||||
type program = decl list
|
||||
[@@deriving show]
|
||||
type pat = PatName of string [@@deriving show]
|
||||
type stmt = StmtLet of pat * expr | StmtReturn of expr [@@deriving show]
|
||||
type block = { stmts : stmt list; ret : expr } [@@deriving show]
|
||||
type func = { name : string; body : block } [@@deriving show]
|
||||
type extern_func = { name : string } [@@deriving show]
|
||||
type decl = DeclFunc of func | DeclExternFunc of extern_func [@@deriving show]
|
||||
type program = decl list [@@deriving show]
|
||||
|
|
|
@ -1,8 +1,3 @@
|
|||
type irexpr
|
||||
= IExpr
|
||||
|
||||
type irexpr = IExpr
|
||||
type global = Global
|
||||
|
||||
type program =
|
||||
{ globals : global list
|
||||
}
|
||||
type program = { globals : global list }
|
||||
|
|
|
@ -2,10 +2,8 @@ open Ast
|
|||
open Ir
|
||||
|
||||
(* Processing state for this particular scope *)
|
||||
type state =
|
||||
{ parent : state option
|
||||
}
|
||||
type state = { parent : state option }
|
||||
|
||||
let lower (func:func) : (irexpr list, unit) result =
|
||||
let lower (func : func) : (irexpr list, unit) result =
|
||||
let { name = _; body = _ } = func in
|
||||
Error ()
|
||||
|
|
48
lib/parse.ml
48
lib/parse.ml
|
@ -1,43 +1,39 @@
|
|||
open Util
|
||||
|
||||
module I = Parser.MenhirInterpreter
|
||||
|
||||
let get_parse_error env =
|
||||
match I.stack env with
|
||||
| lazy Nil -> "Invalid syntax"
|
||||
| lazy (Cons (I.Element (state, _, _, _), _)) ->
|
||||
try (Parser_messages.message (I.number state)) with
|
||||
| Not_found -> "invalid syntax (no specific message for this eror)"
|
||||
| (lazy Nil) -> "Invalid syntax"
|
||||
| (lazy (Cons (I.Element (state, _, _, _), _))) -> (
|
||||
try Parser_messages.message (I.number state)
|
||||
with Not_found -> "invalid syntax (no specific message for this eror)")
|
||||
|
||||
let rec parse lexbuf (checkpoint : Ast.program I.checkpoint) =
|
||||
match checkpoint with
|
||||
| I.InputNeeded _env ->
|
||||
let token = Lexer.f lexbuf in
|
||||
let startp = lexbuf.lex_start_p
|
||||
and endp = lexbuf.lex_curr_p in
|
||||
let checkpoint = I.offer checkpoint (token, startp, endp) in
|
||||
parse lexbuf checkpoint
|
||||
| I.Shifting _
|
||||
| I.AboutToReduce _ ->
|
||||
let checkpoint = I.resume checkpoint in
|
||||
parse lexbuf checkpoint
|
||||
let token = Lexer.f lexbuf in
|
||||
let startp = lexbuf.lex_start_p and endp = lexbuf.lex_curr_p in
|
||||
let checkpoint = I.offer checkpoint (token, startp, endp) in
|
||||
parse lexbuf checkpoint
|
||||
| I.Shifting _ | I.AboutToReduce _ ->
|
||||
let checkpoint = I.resume checkpoint in
|
||||
parse lexbuf checkpoint
|
||||
| I.HandlingError _env ->
|
||||
let line, pos = Util.get_lexing_position lexbuf in
|
||||
let err = get_parse_error _env in
|
||||
raise (Syntax_error (Some (line, pos), err))
|
||||
let line, pos = Util.get_lexing_position lexbuf in
|
||||
let err = get_parse_error _env in
|
||||
raise (Syntax_error (Some (line, pos), err))
|
||||
| I.Accepted v -> v
|
||||
| I.Rejected ->
|
||||
raise (Syntax_error (None, "invalid syntax (parser rejected the input)"))
|
||||
raise (Syntax_error (None, "invalid syntax (parser rejected the input)"))
|
||||
|
||||
let try_parse lexbuf =
|
||||
try
|
||||
let program = parse lexbuf (Parser.Incremental.program lexbuf.lex_curr_p) in
|
||||
Ok program
|
||||
with
|
||||
| Util.Syntax_error (pos, err) ->
|
||||
begin
|
||||
match pos with
|
||||
| Some (line, pos) ->
|
||||
Error (Printf.sprintf "Syntax error on line %d, character %d: %s" line pos err)
|
||||
| None -> Error (Printf.sprintf "Syntax error: %s" err)
|
||||
end
|
||||
with Util.Syntax_error (pos, err) -> (
|
||||
match pos with
|
||||
| Some (line, pos) ->
|
||||
Error
|
||||
(Printf.sprintf "Syntax error on line %d, character %d: %s" line pos
|
||||
err)
|
||||
| None -> Error (Printf.sprintf "Syntax error: %s" err))
|
||||
|
|
|
@ -46,5 +46,3 @@ stmt:
|
|||
expr:
|
||||
| i=LIT_NEG_INT { ExprLit (LitNegInt i) }
|
||||
| i=LIT_INT { ExprLit (LitInt i) }
|
||||
|
||||
(* vim: set ft=ocamlyacc *)
|
||||
|
|
|
@ -1,3 +1,27 @@
|
|||
(* Hindley milner type checking *)
|
||||
|
||||
open Ast
|
||||
|
||||
(* Get a list of name -> type mappings of all the declarations to be used as a
|
||||
base type map for type checking *)
|
||||
let rec get_decl_map (program:program) : (string, ty) Hashtbl.t =
|
||||
let get_decl_sig (decl:decl) : string * ty =
|
||||
match decl with
|
||||
| DeclFunc func -> (func.name, TyFunc ([], TyUnit))
|
||||
| DeclExternFunc extern -> (extern.name, TyUnit)
|
||||
in
|
||||
match program with
|
||||
| [] -> Hashtbl.create 100
|
||||
| hd :: tl ->
|
||||
let (name, ty) = get_decl_sig hd in
|
||||
let next = get_decl_map tl in
|
||||
Hashtbl.add next name ty; next
|
||||
|
||||
type state =
|
||||
{ decls : (string, ty) Hashtbl.t
|
||||
; func_sig : string
|
||||
; stmts : stmt list
|
||||
}
|
||||
|
||||
(* let rec typeck (state:state) : state =
|
||||
let typeck_stmt *)
|
||||
|
|
6
spec.md
6
spec.md
|
@ -8,4 +8,10 @@ Types
|
|||
IR
|
||||
--
|
||||
|
||||
Calling Convention
|
||||
------------------
|
||||
|
||||
This language targets x86_64 linux architecture.
|
||||
|
||||
- Arguments are passed via RDI, RSI, RDX, RCX, R8, R9.
|
||||
- Integer return values in RAX.
|
||||
|
|
Loading…
Reference in a new issue