This commit is contained in:
Michael Zhang 2022-03-23 01:12:37 -05:00
parent 4c39223610
commit 4ea1071ca1
Signed by untrusted user who does not match committer: michael
GPG key ID: BDA47A31A3C8EE6B
10 changed files with 83 additions and 88 deletions

0
.ocamlformat Normal file
View file

6
Justfile Normal file
View file

@ -0,0 +1,6 @@
example:
dune build
dune exec e0 < examples/basic.e0
fmt:
fd -e ml | xargs ocamlformat -i

View file

@ -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

View file

@ -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]

View file

@ -1,8 +1,3 @@
type irexpr
= IExpr
type irexpr = IExpr
type global = Global
type program =
{ globals : global list
}
type program = { globals : global list }

View file

@ -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 ()

View file

@ -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))

View file

@ -46,5 +46,3 @@ stmt:
expr:
| i=LIT_NEG_INT { ExprLit (LitNegInt i) }
| i=LIT_INT { ExprLit (LitInt i) }
(* vim: set ft=ocamlyacc *)

View file

@ -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 *)

View file

@ -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.