a

Justfile

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

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

lib/ast.ml

@@ -1,61 +1,28 @@
-type op
+type op = OpAdd | OpSub | OpMul | OpDiv [@@deriving show]
-  = OpAdd
+
-  | OpSub
+type lit = LitInt of int | LitNegInt of int | LitFloat of float
-  | OpMul
-  | OpDiv
 [@@deriving show]
 
-type lit
+type ty =
-  = LitInt of int
+  | TyUnit
-  | LitNegInt of int
+  | TySizedInt
-  | LitFloat of float
-[@@deriving show]
-
-type ty
-  = TySizedInt
   | TyGenericInt
   | TyFunc of ty list * ty
   | TyPointer of ty
   | TyStruct of (string * ty) list
 [@@deriving show]
 
-type expr
+type expr =
-  = ExprUnit
+  | ExprUnit
   | ExprLit of lit
   | ExprBin of expr * op * expr
   | ExprAnnot of expr * ty
 [@@deriving show]
 
-type pat
+type pat = PatName of string [@@deriving show]
-  = PatName of string
+type stmt = StmtLet of pat * expr | StmtReturn of expr [@@deriving show]
-[@@deriving show]
+type block = { stmts : stmt list; ret : expr } [@@deriving show]
-
+type func = { name : string; body : block } [@@deriving show]
-type stmt
+type extern_func = { name : string } [@@deriving show]
-  = StmtLet of pat * expr
+type decl = DeclFunc of func | DeclExternFunc of extern_func [@@deriving show]
-  | StmtReturn of expr
+type program = decl list [@@deriving show]
-[@@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]

lib/ir.ml

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

lib/lowering.ml

@@ -2,10 +2,8 @@ open Ast
 open Ir
 
 (* Processing state for this particular scope *)
-type state =
+type state = { parent : state option }
-  { 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 ()

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 Nil) -> "Invalid syntax"
-  | lazy (Cons (I.Element (state, _, _, _), _)) ->
+  | (lazy (Cons (I.Element (state, _, _, _), _))) -> (
-    try (Parser_messages.message (I.number state)) with
+      try Parser_messages.message (I.number state)
-    | Not_found -> "invalid syntax (no specific message for this eror)"
+      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 token = Lexer.f lexbuf in
-    let startp = lexbuf.lex_start_p
+      let startp = lexbuf.lex_start_p and endp = lexbuf.lex_curr_p in
-    and endp = lexbuf.lex_curr_p in
+      let checkpoint = I.offer checkpoint (token, startp, endp) in
-    let checkpoint = I.offer checkpoint (token, startp, endp) in
+      parse lexbuf checkpoint
-    parse lexbuf checkpoint
+  | I.Shifting _ | I.AboutToReduce _ ->
-  | I.Shifting _
+      let checkpoint = I.resume checkpoint in
-  | I.AboutToReduce _ ->
+      parse lexbuf checkpoint
-    let checkpoint = I.resume checkpoint in
-    parse lexbuf checkpoint
   | I.HandlingError _env ->
-    let line, pos = Util.get_lexing_position lexbuf in
+      let line, pos = Util.get_lexing_position lexbuf in
-    let err = get_parse_error _env in
+      let err = get_parse_error _env in
-    raise (Syntax_error (Some (line, pos), err))
+      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
+  with Util.Syntax_error (pos, err) -> (
-  | Util.Syntax_error (pos, err) ->
+    match pos with
-    begin
+    | Some (line, pos) ->
-      match pos with
+        Error
-      | Some (line, pos) ->
+          (Printf.sprintf "Syntax error on line %d, character %d: %s" line pos
-        Error (Printf.sprintf "Syntax error on line %d, character %d: %s" line pos err)
+             err)
-      | None -> Error (Printf.sprintf "Syntax error: %s" err)
+    | None -> Error (Printf.sprintf "Syntax error: %s" err))
-    end

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

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

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.