Move the majority of the procedure back to lib

bin/main.ml

@@ -1,51 +1,7 @@
 open E0
-open E0.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 (E0.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
-  | 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))
-  | I.Accepted v -> v
-  | I.Rejected ->
-       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
-
 
 let () =
-  let p = Lexing.from_channel stdin |> try_parse in
+  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

examples/basic.e0

@@ -1,3 +1,5 @@
+extern fn printf();
+
 fn main() {
   return 42;
 }

lib/ast.ml

@@ -47,8 +47,14 @@ type func =
   }
 [@@deriving show]
 
+type extern_func =
+  { name : string
+  }
+[@@deriving show]
+
 type decl
   = DeclFunc of func
+  | DeclExternFunc of extern_func
 [@@deriving show]
 
 type program = decl list

lib/dune

@@ -1,16 +1,21 @@
 (library
-  (name e0)
+ (name e0)
-  (libraries menhirLib)
+ (libraries menhirLib)
-  (preprocess (pps ppx_deriving.show ppx_deriving.ord)))
+ (preprocess
+  (pps ppx_deriving.show ppx_deriving.ord)))
 
 (ocamllex lexer)
 
 (menhir
-  (flags --table)
+ (flags --table)
-  (modules parser))
+ (modules parser))
 
 ; https://baturin.org/blog/declarative-parse-error-reporting-with-menhir/
+
 (rule
-  (targets parser_messages.ml)
+ (targets parser_messages.ml)
-  (deps parser.messages parser.mly)
+ (deps parser.messages parser.mly)
-  (action (with-stdout-to %{targets} (run menhir --compile-errors %{deps}))))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run menhir --compile-errors %{deps}))))

lib/ir.ml

@@ -1,5 +1,5 @@
-type expr
+type irexpr
-  = Expr
+  = IExpr
 
 type global = Global
 

lib/lexer.mll

@@ -3,15 +3,19 @@
 rule f = parse
 | '\n' { Lexing.new_line lexbuf; f lexbuf }
 | [' ' '\t'] { f lexbuf }
+
+| "extern" { KWD_EXTERN }
 | "fn" { KWD_FN }
 | "return" { KWD_RETURN }
+
 | "(" { PUNCT_LPAREN }
 | ")" { PUNCT_RPAREN }
 | "->" { PUNCT_RARROW }
-| "{" { PUNCT_LBRACE }
-| "}" { PUNCT_RBRACE }
 | ":" { PUNCT_COLON }
 | ";" { PUNCT_SEMI }
+| "{" { PUNCT_LBRACE }
+| "}" { PUNCT_RBRACE }
+
 | "-" ['0'-'9']+ as i { LIT_NEG_INT (- (int_of_string i)) }
 | ['0'-'9']+ as i { LIT_INT (int_of_string i) }
 | ['a'-'z' 'A'-'Z']* as i { IDENT i }

lib/lowering.ml

@@ -0,0 +1,11 @@
+open Ast
+open Ir
+
+(* Processing state for this particular scope *)
+type state =
+  { parent : state option
+  }
+
+let lower (func:func) : (irexpr list, unit) result =
+  let { name = _; body = _ } = func in
+  Error ()

lib/parse.ml

@@ -0,0 +1,43 @@
+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)"
+
+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
+  | 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))
+  | I.Accepted v -> v
+  | I.Rejected ->
+    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

lib/parser.mly

@@ -3,15 +3,19 @@
 %}
 
 %token EOF
+
+%token KWD_EXTERN
 %token KWD_FN
 %token KWD_RETURN
-%token PUNCT_LPAREN
+
-%token PUNCT_RPAREN
-%token PUNCT_RARROW
-%token PUNCT_LBRACE
-%token PUNCT_RBRACE
 %token PUNCT_COLON
+%token PUNCT_LBRACE
+%token PUNCT_LPAREN
+%token PUNCT_RARROW
+%token PUNCT_RBRACE
+%token PUNCT_RPAREN
 %token PUNCT_SEMI
+
 %token <int> LIT_NEG_INT
 %token <int> LIT_INT
 %token <string> IDENT
@@ -25,10 +29,14 @@ program:
 
 decl:
 | func=func { DeclFunc func }
+| extern=extern_func { DeclExternFunc extern }
 
 func:
 | KWD_FN name=IDENT PUNCT_LPAREN PUNCT_RPAREN body=body { { name; body } }
 
+extern_func:
+| KWD_EXTERN KWD_FN name=IDENT PUNCT_LPAREN PUNCT_RPAREN PUNCT_SEMI { { name } }
+
 body:
 | PUNCT_LBRACE stmts=stmt* PUNCT_RBRACE { { stmts; ret=ExprUnit } }
 
@@ -38,3 +46,5 @@ stmt:
 expr:
 | i=LIT_NEG_INT { ExprLit (LitNegInt i) }
 | i=LIT_INT { ExprLit (LitInt i) }
+
+(* vim: set ft=ocamlyacc *)