diff --git a/src/passes/1-parser/dune b/src/passes/1-parser/dune index 9a4f86a94..8e478b392 100644 --- a/src/passes/1-parser/dune +++ b/src/passes/1-parser/dune @@ -12,5 +12,5 @@ (preprocess (pps ppx_let) ) - (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared )) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared)) ) diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index 8fafc5c95..a3b52b110 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -22,7 +22,18 @@ let parse_file (source: string) : AST.t result = let lexbuf = Lexing.from_channel channel in let Lexer.{read ; close ; _} = Lexer.open_token_stream None in - specific_try (function + specific_try (function + | SyntaxError.Error WrongFunctionArguments -> + let start = Lexing.lexeme_start_p lexbuf in + let end_ = Lexing.lexeme_end_p lexbuf in + let str = Format.sprintf + "Incorrect function arguments at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + start.pos_fname source + in + simple_error str | Parser.Error -> ( let start = Lexing.lexeme_start_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index c91cd352e..444d12212 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -388,30 +388,14 @@ type_expr_simple_args: par(nsepseq(type_expr_simple, ",")) { $1 } type_expr_simple: - core_expr_2 type_expr_simple_args? { + type_name type_expr_simple_args? { let args = $2 in - let constr = - match $1 with - EVar i -> i - | EProj {value={struct_name; field_path; _}; region} -> - let app a = function - FieldName v -> a ^ "." ^ v.value - | Component {value = c, _; _} -> a ^ "." ^ c in - let value = - Utils.nsepseq_foldl app struct_name.value field_path - in {region; value} - | EArith Mutez r | EArith Int r | EArith Nat r -> - {r with value = fst r.value} - | EString String s -> s - | ELogic BoolExpr (True t) -> {region=t; value="true"} - | ELogic BoolExpr (False f) -> {region=f; value="false"} - | _ -> failwith "Not supported" (* TODO: raise a proper exception *) - in match args with - Some {value; _} -> - let region = cover (expr_to_region $1) value.rpar in - let value = constr, {region; value} - in TApp {region; value} - | None -> TVar constr + match args with + Some {value; _} -> + let region = cover $1.region value.rpar in + let value = $1, {region; value} + in TApp {region; value} + | None -> TVar $1 } | "(" nsepseq(type_expr_simple, ",") ")" { TProd {region = cover $1 $3; value=$2} @@ -440,8 +424,8 @@ fun_expr: {p.value with inside = arg_to_pattern p.value.inside} in PPar {p with value} | EUnit u -> PUnit u - | _ -> failwith "Not supported" in (* TODO: raise a proper exception *) - + | _ -> raise (SyntaxError.Error WrongFunctionArguments) + in let fun_args_to_pattern = function EAnnot { value = { @@ -469,8 +453,8 @@ fun_expr: in arg_to_pattern (fst fun_args), bindings | EUnit e -> arg_to_pattern (EUnit e), [] - | _ -> failwith "Not supported" in (* TODO: raise a proper exception *) - + | _ -> raise (SyntaxError.Error WrongFunctionArguments) + in let binders = fun_args_to_pattern $1 in let f = {kwd_fun; binders; diff --git a/src/passes/1-parser/shared/SyntaxError.ml b/src/passes/1-parser/shared/SyntaxError.ml new file mode 100644 index 000000000..a0faa0bbb --- /dev/null +++ b/src/passes/1-parser/shared/SyntaxError.ml @@ -0,0 +1,4 @@ +type error = + | WrongFunctionArguments + +exception Error of error \ No newline at end of file diff --git a/src/passes/1-parser/shared/SyntaxError.mli b/src/passes/1-parser/shared/SyntaxError.mli new file mode 100644 index 000000000..a0faa0bbb --- /dev/null +++ b/src/passes/1-parser/shared/SyntaxError.mli @@ -0,0 +1,4 @@ +type error = + | WrongFunctionArguments + +exception Error of error \ No newline at end of file diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index 3d763b1df..0da93bc70 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -18,6 +18,7 @@ FQueue EvalOpt Version + SyntaxError ) (modules_without_implementation Error) )