From 4ea1071ca1beaa024602fb59890eb9e317c8135b Mon Sep 17 00:00:00 2001 From: Michael Zhang Date: Wed, 23 Mar 2022 01:12:37 -0500 Subject: [PATCH] a --- .ocamlformat | 0 Justfile | 6 +++++ bin/main.ml | 7 +++++- lib/ast.ml | 63 ++++++++++++------------------------------------- lib/ir.ml | 9 ++----- lib/lowering.ml | 6 ++--- lib/parse.ml | 48 +++++++++++++++++-------------------- lib/parser.mly | 2 -- lib/typeck.ml | 24 +++++++++++++++++++ spec.md | 6 +++++ 10 files changed, 83 insertions(+), 88 deletions(-) create mode 100644 .ocamlformat create mode 100644 Justfile diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..e69de29 diff --git a/Justfile b/Justfile new file mode 100644 index 0000000..dbe3309 --- /dev/null +++ b/Justfile @@ -0,0 +1,6 @@ +example: + dune build + dune exec e0 < examples/basic.e0 + +fmt: + fd -e ml | xargs ocamlformat -i diff --git a/bin/main.ml b/bin/main.ml index b404da4..b130177 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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 diff --git a/lib/ast.ml b/lib/ast.ml index 88301c7..88461bd 100644 --- a/lib/ast.ml +++ b/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] diff --git a/lib/ir.ml b/lib/ir.ml index 279d134..5f73fb6 100644 --- a/lib/ir.ml +++ b/lib/ir.ml @@ -1,8 +1,3 @@ -type irexpr - = IExpr - +type irexpr = IExpr type global = Global - -type program = - { globals : global list - } +type program = { globals : global list } diff --git a/lib/lowering.ml b/lib/lowering.ml index cf741d9..be3f4aa 100644 --- a/lib/lowering.ml +++ b/lib/lowering.ml @@ -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 () diff --git a/lib/parse.ml b/lib/parse.ml index e9a10c9..bf4a64c 100644 --- a/lib/parse.ml +++ b/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)) diff --git a/lib/parser.mly b/lib/parser.mly index e83d3f5..1aff965 100644 --- a/lib/parser.mly +++ b/lib/parser.mly @@ -46,5 +46,3 @@ stmt: expr: | i=LIT_NEG_INT { ExprLit (LitNegInt i) } | i=LIT_INT { ExprLit (LitInt i) } - -(* vim: set ft=ocamlyacc *) diff --git a/lib/typeck.ml b/lib/typeck.ml index aca0c72..bc8152e 100644 --- a/lib/typeck.ml +++ b/lib/typeck.ml @@ -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 *) diff --git a/spec.md b/spec.md index 2e128ca..887202d 100644 --- a/spec.md +++ b/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.