Merge branch 'reasonligo-improvemtns' into 'dev'

ReasonLIGO improvements

See merge request ligolang/ligo!266
This commit is contained in:
Christian Rinderknecht 2019-12-18 10:50:15 +00:00
commit f497ba4aba
6 changed files with 33 additions and 29 deletions

View File

@ -12,5 +12,5 @@
(preprocess (preprocess
(pps ppx_let) (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))
) )

View File

@ -22,7 +22,18 @@ let parse_file (source: string) : AST.t result =
let lexbuf = Lexing.from_channel channel in let lexbuf = Lexing.from_channel channel in
let Lexer.{read ; close ; _} = let Lexer.{read ; close ; _} =
Lexer.open_token_stream None in 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 -> ( | Parser.Error -> (
let start = Lexing.lexeme_start_p lexbuf in let start = Lexing.lexeme_start_p lexbuf in
let end_ = Lexing.lexeme_end_p lexbuf in let end_ = Lexing.lexeme_end_p lexbuf in

View File

@ -388,30 +388,14 @@ type_expr_simple_args:
par(nsepseq(type_expr_simple, ",")) { $1 } par(nsepseq(type_expr_simple, ",")) { $1 }
type_expr_simple: type_expr_simple:
core_expr_2 type_expr_simple_args? { type_name type_expr_simple_args? {
let args = $2 in let args = $2 in
let constr = match args with
match $1 with Some {value; _} ->
EVar i -> i let region = cover $1.region value.rpar in
| EProj {value={struct_name; field_path; _}; region} -> let value = $1, {region; value}
let app a = function in TApp {region; value}
FieldName v -> a ^ "." ^ v.value | None -> TVar $1
| 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
} }
| "(" nsepseq(type_expr_simple, ",") ")" { | "(" nsepseq(type_expr_simple, ",") ")" {
TProd {region = cover $1 $3; value=$2} TProd {region = cover $1 $3; value=$2}
@ -440,8 +424,8 @@ fun_expr:
{p.value with inside = arg_to_pattern p.value.inside} {p.value with inside = arg_to_pattern p.value.inside}
in PPar {p with value} in PPar {p with value}
| EUnit u -> PUnit u | EUnit u -> PUnit u
| _ -> failwith "Not supported" in (* TODO: raise a proper exception *) | _ -> raise (SyntaxError.Error WrongFunctionArguments)
in
let fun_args_to_pattern = function let fun_args_to_pattern = function
EAnnot { EAnnot {
value = { value = {
@ -469,8 +453,8 @@ fun_expr:
in arg_to_pattern (fst fun_args), bindings in arg_to_pattern (fst fun_args), bindings
| EUnit e -> | EUnit e ->
arg_to_pattern (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 binders = fun_args_to_pattern $1 in
let f = {kwd_fun; let f = {kwd_fun;
binders; binders;

View File

@ -0,0 +1,4 @@
type error =
| WrongFunctionArguments
exception Error of error

View File

@ -0,0 +1,4 @@
type error =
| WrongFunctionArguments
exception Error of error

View File

@ -18,6 +18,7 @@
FQueue FQueue
EvalOpt EvalOpt
Version Version
SyntaxError
) )
(modules_without_implementation Error) (modules_without_implementation Error)
) )