From 713baccdd10866e6b3963eeddaa59b41e9916af8 Mon Sep 17 00:00:00 2001 From: Michael Zhang Date: Tue, 8 Mar 2022 03:20:19 -0600 Subject: [PATCH] Move the majority of the procedure back to lib --- bin/main.ml | 46 +--------------------------------------------- examples/basic.e0 | 2 ++ lib/ast.ml | 6 ++++++ lib/dune | 21 +++++++++++++-------- lib/ir.ml | 4 ++-- lib/lexer.mll | 8 ++++++-- lib/lowering.ml | 11 +++++++++++ lib/parse.ml | 43 +++++++++++++++++++++++++++++++++++++++++++ lib/parser.mly | 20 +++++++++++++++----- 9 files changed, 99 insertions(+), 62 deletions(-) create mode 100644 lib/lowering.ml create mode 100644 lib/parse.ml diff --git a/bin/main.ml b/bin/main.ml index f71da4e..b404da4 100644 --- a/bin/main.ml +++ b/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 diff --git a/examples/basic.e0 b/examples/basic.e0 index b52ff19..f39e62b 100644 --- a/examples/basic.e0 +++ b/examples/basic.e0 @@ -1,3 +1,5 @@ +extern fn printf(); + fn main() { return 42; } diff --git a/lib/ast.ml b/lib/ast.ml index 23d4b64..88301c7 100644 --- a/lib/ast.ml +++ b/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 diff --git a/lib/dune b/lib/dune index d1fdba1..eea4cfb 100644 --- a/lib/dune +++ b/lib/dune @@ -1,16 +1,21 @@ (library - (name e0) - (libraries menhirLib) - (preprocess (pps ppx_deriving.show ppx_deriving.ord))) + (name e0) + (libraries menhirLib) + (preprocess + (pps ppx_deriving.show ppx_deriving.ord))) (ocamllex lexer) (menhir - (flags --table) - (modules parser)) + (flags --table) + (modules parser)) ; https://baturin.org/blog/declarative-parse-error-reporting-with-menhir/ + (rule - (targets parser_messages.ml) - (deps parser.messages parser.mly) - (action (with-stdout-to %{targets} (run menhir --compile-errors %{deps})))) + (targets parser_messages.ml) + (deps parser.messages parser.mly) + (action + (with-stdout-to + %{targets} + (run menhir --compile-errors %{deps})))) diff --git a/lib/ir.ml b/lib/ir.ml index 2c5cdb8..279d134 100644 --- a/lib/ir.ml +++ b/lib/ir.ml @@ -1,5 +1,5 @@ -type expr - = Expr +type irexpr + = IExpr type global = Global diff --git a/lib/lexer.mll b/lib/lexer.mll index 060bd85..4429e2c 100644 --- a/lib/lexer.mll +++ b/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 } diff --git a/lib/lowering.ml b/lib/lowering.ml new file mode 100644 index 0000000..cf741d9 --- /dev/null +++ b/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 () diff --git a/lib/parse.ml b/lib/parse.ml new file mode 100644 index 0000000..e9a10c9 --- /dev/null +++ b/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 diff --git a/lib/parser.mly b/lib/parser.mly index 1d2b98d..e83d3f5 100644 --- a/lib/parser.mly +++ b/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 LIT_NEG_INT %token LIT_INT %token 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 *)