Move the majority of the procedure back to lib
This commit is contained in:
parent
e66b515826
commit
713baccdd1
9 changed files with 99 additions and 62 deletions
46
bin/main.ml
46
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
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
extern fn printf();
|
||||
|
||||
fn main() {
|
||||
return 42;
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
9
lib/dune
9
lib/dune
|
@ -1,7 +1,8 @@
|
|||
(library
|
||||
(name e0)
|
||||
(libraries menhirLib)
|
||||
(preprocess (pps ppx_deriving.show ppx_deriving.ord)))
|
||||
(preprocess
|
||||
(pps ppx_deriving.show ppx_deriving.ord)))
|
||||
|
||||
(ocamllex lexer)
|
||||
|
||||
|
@ -10,7 +11,11 @@
|
|||
(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}))))
|
||||
(action
|
||||
(with-stdout-to
|
||||
%{targets}
|
||||
(run menhir --compile-errors %{deps}))))
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
type expr
|
||||
= Expr
|
||||
type irexpr
|
||||
= IExpr
|
||||
|
||||
type global = Global
|
||||
|
||||
|
|
|
@ -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 }
|
||||
|
|
11
lib/lowering.ml
Normal file
11
lib/lowering.ml
Normal file
|
@ -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 ()
|
43
lib/parse.ml
Normal file
43
lib/parse.ml
Normal file
|
@ -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
|
|
@ -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 *)
|
||||
|
|
Loading…
Reference in a new issue