Commit 7575df98 authored by Gabriel Scherer's avatar Gabriel Scherer
Browse files

WIP: print syntax error locations

parent e6953c62
Pipeline #259254 passed with stage
in 8 minutes and 7 seconds
......@@ -36,3 +36,7 @@ and pattern =
| PAnnot of pattern * type_annotation
| PVariant of Datatype.label_id * pattern option
| PTuple of pattern list
type datatype_decl = (tyvar, typ option) Datatype.decl
type term_decl = tevar * term
type program = datatype_decl list * term_decl list
......@@ -33,7 +33,8 @@ let newline = '\r' | '\n' | "\r\n"
rule read =
parse
| white
| newline { read lexbuf }
| newline { MenhirLib.LexerUtil.newline lexbuf;
read lexbuf }
| lident as id { try Hashtbl.find keyword_table id
with Not_found -> LIDENT id }
| uident as id { UIDENT id }
......
module LexUtil = MenhirLib.LexerUtil
let wrap parser lexbuf =
let lexbuf = LexUtil.init "test" lexbuf in
try parser MLLexer.read lexbuf
with exn ->
let range = Lexing.(lexbuf.lex_start_p, lexbuf.lex_curr_p) in
Printf.eprintf "%!%sSyntax error.\n%!"
(LexUtil.range range);
raise exn
let term lexbuf = wrap MLParser.self_contained_term lexbuf
let program lexbuf = wrap MLParser.prog lexbuf
val term : Lexing.lexbuf -> ML.term
val program : Lexing.lexbuf -> ML.program
......@@ -35,7 +35,7 @@
%token EOF
%type<(ML.datatype_env * (string * ML.term) list)> prog
%type<ML.program> prog
%type<ML.term> self_contained_term
%start prog self_contained_term
......@@ -163,8 +163,7 @@ let tyconstr_decl :=
{ (Datatype.Label l, arg_type) }
let type_decls :=
| decls = list (type_decl) ;
{ List.fold_left Datatype.Env.add_decl Datatype.Env.empty decls }
| ~ = list (type_decl) ; <>
let type_decl :=
| TYPE ; ~ = tyname ; type_params = list (tyvar) ; "=" ;
......
......@@ -7,6 +7,6 @@
(library
(name client)
(libraries pprint inferno)
(libraries pprint inferno menhirLib)
(flags "-w" "@1..66-4-44")
)
......@@ -37,7 +37,7 @@ let test_with_log ~log (env : ML.datatype_env) (t : ML.term) : bool =
(* We print the term, parse it and compare with the given term *)
let s = MLPrinter.to_string t in
let lexbuf = Lexing.from_string s in
let t' = MLParser.self_contained_term MLLexer.read lexbuf in
let t' = MLParse.term lexbuf in
assert (t = t');
let outcome_env =
ML2F.translate_env env in
......@@ -61,7 +61,7 @@ let test ~(success:int ref) ~(total:int ref) (env : ML.datatype_env) (t : ML.ter
(* We print the term, parse it and compare with the given term *)
let s = MLPrinter.to_string t in
let lexbuf = Lexing.from_string s in
let t' = MLParser.self_contained_term MLLexer.read lexbuf in
let t' = MLParse.term lexbuf in
assert (t = t');
let outcome_env =
ML2F.translate_env env in
......
......@@ -214,13 +214,9 @@ let () =
(*************************************************************************)
(* Main parsing function *)
let parse = MLParser.prog MLLexer.read
(* Currently unused *)
let ast_from_string s =
let lexbuf = Lexing.from_string s in
parse lexbuf
MLParse.program lexbuf
exception ParsingError
......@@ -243,9 +239,12 @@ let test_from_string typedecl s expected on_same on_different on_error =
with e -> print_endline s; raise e (*Error ()*)
in
match t with
| Ok (datatype_env, t) ->
| Ok (type_decls, t) ->
if t = expected then
begin
let datatype_env =
List.fold_left Datatype.Env.add_decl Datatype.Env.empty type_decls
in
assert (test datatype_env t);
on_same ();
end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment