balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'rinderknecht-dev' into 'dev'

Browse Source 
Fixing and adding errors in the parser

See merge request ligolang/ligo!316
This commit is contained in:
Christian Rinderknecht 2020-01-08 17:09:48 +00:00
commit d49a72847a
25 changed files with 692 additions and 332 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gitlab-pages/docs/language-basics/maps-records.md
View File

@ -63,7 +63,7 @@ let moves: moveset = Map.literal
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let moves: moveset = let moves : moveset =
Map.literal([ Map.literal([
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, (1, 2)), ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, (1, 2)),
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, (0, 3)), ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, (0, 3)),
@ -82,19 +82,19 @@ If we want to access a move from our moveset above, we can use the `[]` operator
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; const my_balance : option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)];
``` ```
<!--CameLIGO--> <!--CameLIGO-->
```cameligo ```cameligo
let balance: move option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves let my_balance : move option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: option(move) = let my_balance : option(move) =
Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
``` ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
@ -106,19 +106,19 @@ Accessing a value in a map yields an option, however you can also get the value
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); const my_balance : move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves);
``` ```
<!--CameLIGO--> <!--CameLIGO-->
```cameligo ```cameligo
let balance: move = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves let my_balance : move = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: move = let my_balance : move =
Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
``` ```
@ -134,8 +134,8 @@ The values of a PascaLIGO map can be updated using the ordinary assignment synta
```pascaligo ```pascaligo
function set_ (var m: moveset) : moveset is function set_ (var m: moveset) : moveset is
block { block {
m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9); m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m } with m
``` ```
@ -266,7 +266,7 @@ entries, potentially millions or billions. The cost of loading these entries int
the environment each time a user executes the contract would eventually become the environment each time a user executes the contract would eventually become
too expensive were it not for big maps. Big maps are a data structure offered by too expensive were it not for big maps. Big maps are a data structure offered by
Tezos which handles the scaling concerns for us. In LIGO, the interface for big Tezos which handles the scaling concerns for us. In LIGO, the interface for big
maps is analogous to the one used for ordinary maps. maps is analogous to the one used for ordinary maps.
Here's how we define a big map: Here's how we define a big map:
@ -341,19 +341,19 @@ If we want to access a move from our moveset above, we can use the `[]` operator
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; const my_balance : option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)];
``` ```
<!--CameLIGO--> <!--CameLIGO-->
```cameligo ```cameligo
let balance: move option = Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves let my_balance : move option = Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: option(move) = let my_balance : option(move) =
Big_map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); Big_map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
``` ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
@ -365,19 +365,19 @@ Accessing a value in a map yields an option, however you can also get the value
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); const my_balance : move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves);
``` ```
<!--CameLIGO--> <!--CameLIGO-->
```cameligo ```cameligo
let balance: move = Big_map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves let my_balance : move = Big_map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves
``` ```
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let balance: move = Big_map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); let my_balance : move = Big_map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves);
``` ```
<!--END_DOCUSAURUS_CODE_TABS--> <!--END_DOCUSAURUS_CODE_TABS-->
@ -392,8 +392,8 @@ The values of a PascaLIGO big map can be updated using the ordinary assignment s
```pascaligo ```pascaligo
function set_ (var m: moveset) : moveset is function set_ (var m : moveset) : moveset is
block { block {
m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9); m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9);
} with m } with m
``` ```
@ -404,7 +404,7 @@ We can update a big map in CameLIGO using the `Big_map.update` built-in:
```cameligo ```cameligo
let updated_map: moveset = let updated_map : moveset =
Big_map.update ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) (Some (4,9)) moves Big_map.update ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) (Some (4,9)) moves
``` ```
@ -428,7 +428,7 @@ Here's how a custom record type is defined:
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
type user is record type user is record
id: nat; id: nat;
is_admin: bool; is_admin: bool;
name: string; name: string;
@ -479,8 +479,8 @@ let user: user = {
<!--ReasonLIGO--> <!--ReasonLIGO-->
```reasonligo ```reasonligo
let user: user = { let user: user = {
id: 1n, id: 1n,
is_admin: true, is_admin: true,
name: "Alice" name: "Alice"
}; };
``` ```
@ -494,12 +494,12 @@ If we want to obtain a value from a record for a given key, we can do the follow
<!--DOCUSAURUS_CODE_TABS--> <!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo--> <!--Pascaligo-->
```pascaligo ```pascaligo
const is_admin: bool = user.is_admin; const is_admin : bool = user.is_admin;
``` ```
<!--CameLIGO--> <!--CameLIGO-->
```cameligo ```cameligo
let is_admin: bool = user.is_admin let is_admin : bool = user.is_admin
``` ```
<!--ReasonLIGO--> <!--ReasonLIGO-->

2
src/passes/1-parser/cameligo/LexToken.mli
View File

@ -137,12 +137,14 @@ type ident_err = Reserved_name
type nat_err = Invalid_natural type nat_err = Invalid_natural
| Non_canonical_zero_nat | Non_canonical_zero_nat
type sym_err = Invalid_symbol type sym_err = Invalid_symbol
type kwd_err = Invalid_keyword
val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result
val mk_string : lexeme -> Region.t -> token val mk_string : lexeme -> Region.t -> token
val mk_bytes : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token
val mk_constr : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token

20
src/passes/1-parser/cameligo/LexToken.mll
View File

@ -1,4 +1,6 @@
{ {
(* START HEADER *)
type lexeme = string type lexeme = string
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
@ -236,8 +238,7 @@ let to_region token = proj_token token |> fst
(* Injections *) (* Injections *)
type int_err = type int_err = Non_canonical_zero
Non_canonical_zero
(* LEXIS *) (* LEXIS *)
@ -258,8 +259,7 @@ let keywords = [
(fun reg -> Then reg); (fun reg -> Then reg);
(fun reg -> True reg); (fun reg -> True reg);
(fun reg -> Type reg); (fun reg -> Type reg);
(fun reg -> With reg) (fun reg -> With reg)]
]
let reserved = let reserved =
let open SSet in let open SSet in
@ -323,8 +323,20 @@ let lexicon : lexis =
cstr = build constructors; cstr = build constructors;
res = reserved} res = reserved}
(* Keywords *)
type kwd_err = Invalid_keyword
let mk_kwd ident region =
match SMap.find_opt ident lexicon.kwd with
Some mk_kwd -> Ok (mk_kwd region)
| None -> Error Invalid_keyword
(* Identifiers *)
type ident_err = Reserved_name type ident_err = Reserved_name
(* END OF HEADER *)
} }
(* START LEXER DEFINITION *) (* START LEXER DEFINITION *)

12
src/passes/1-parser/cameligo/ParserMain.ml
View File

@ -19,9 +19,9 @@ module ExtParserLog =
include ParserLog include ParserLog
end end
module M = ParserUnit.Make (IO) module MyLexer = Lexer.Make (LexToken)
(Lexer.Make (LexToken))
(AST) module Unit =
(ExtParser) ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog)
(ParErr)
(ExtParserLog) let () = Unit.run ()

113
src/passes/1-parser/pascaligo.ml
View File

@ -5,8 +5,9 @@ module AST = Parser_pascaligo.AST
module ParserLog = Parser_pascaligo.ParserLog module ParserLog = Parser_pascaligo.ParserLog
module LexToken = Parser_pascaligo.LexToken module LexToken = Parser_pascaligo.LexToken
module Lexer = Lexer.Make(LexToken) module Lexer = Lexer.Make(LexToken)
module SyntaxError = Parser_pascaligo.SyntaxError
module Errors = struct module Errors = struct
let lexer_error (e: Lexer.error AST.reg) = let lexer_error (e: Lexer.error AST.reg) =
let title () = "lexer error" in let title () = "lexer error" in
@ -18,37 +19,39 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let reserved_name Region.{value; region} =
let title () = "parser error" in let title () = Printf.sprintf "reserved name \"%s\"" value in
let file = if source = "" then let message () = "" in
""
else
Format.sprintf "In file \"%s|%s\"" start.pos_fname source
in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
file
in
let message () = str in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [ let data = [
("parser_loc", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
)
] in ] in
error ~data title message error ~data title message
let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let duplicate_parameter Region.{value; region} =
let title () = "unrecognized error" in let title () = Printf.sprintf "duplicate parameter \"%s\"" value in
let file = if source = "" then let message () = "" in
"" let data = [
else ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
] in
error ~data title message
let duplicate_variant Region.{value; region} =
let title () = Printf.sprintf "duplicate variant \"%s\" in this\
type declaration" value in
let message () = "" in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
] in
error ~data title message
let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf =
let title () = "parser error" in
let file = if source = "" then
""
else
Format.sprintf "In file \"%s|%s\"" start.pos_fname source Format.sprintf "In file \"%s|%s\"" start.pos_fname source
in in
let str = Format.sprintf let str = Format.sprintf
@ -59,14 +62,40 @@ module Errors = struct
file file
in in
let message () = str in let message () = str in
let loc = Region.make let loc = Region.make
~start:(Pos.from_byte start) ~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_) ~stop:(Pos.from_byte end_)
in in
let data = [ let data = [
("unrecognized_loc", ("parser_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
) )
] in
error ~data title message
let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf =
let title () = "unrecognized error" in
let file = if source = "" then
""
else
Format.sprintf "In file \"%s|%s\"" start.pos_fname source
in
let str = Format.sprintf
"Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n"
(Lexing.lexeme lexbuf)
start.pos_lnum (start.pos_cnum - start.pos_bol)
end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
file
in
let message () = str in
let loc = Region.make
~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_)
in
let data = [
("unrecognized_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
)
] in ] in
error ~data title message error ~data title message
@ -76,19 +105,25 @@ open Errors
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
let parse (parser: 'a parser) source lexbuf = let parse (parser: 'a parser) source lexbuf =
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
let result = let result =
try try
ok (parser read lexbuf) ok (parser read lexbuf)
with with
| Parser.Error -> SyntaxError.Error (Duplicate_parameter name) ->
fail @@ (duplicate_parameter name)
| SyntaxError.Error (Duplicate_variant name) ->
fail @@ (duplicate_variant name)
| SyntaxError.Error (Reserved_name name) ->
fail @@ (reserved_name name)
| 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
fail @@ (parser_error source start end_ lexbuf) fail @@ (parser_error source start end_ lexbuf)
| Lexer.Error e -> | Lexer.Error e ->
fail @@ (lexer_error e) fail @@ (lexer_error e)
| _ -> | _ ->
let _ = Printexc.print_backtrace Pervasives.stdout in let _ = Printexc.print_backtrace Pervasives.stdout in
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

47
src/passes/1-parser/pascaligo/AST.ml
View File

@ -760,4 +760,49 @@ let rhs_to_region = expr_to_region
let selection_to_region = function let selection_to_region = function
FieldName {region; _} FieldName {region; _}
| Component {region; _} -> region | Component {region; _} -> region
(* Extracting variables from patterns *)
module Ord =
struct
type t = string Region.reg
let compare v1 v2 =
compare v1.value v2.value
end
module VSet = Set.Make (Ord)
let rec vars_of_pattern env = function
PConstr p -> vars_of_pconstr env p
| PVar v -> VSet.add v env
| PWild _ | PInt _ | PNat _ | PBytes _ | PString _ -> env
| PList l -> vars_of_plist env l
| PTuple t -> vars_of_ptuple env t.value
and vars_of_pconstr env = function
PUnit _ | PFalse _ | PTrue _ | PNone _ -> env
| PSomeApp {value=_, {value={inside; _};_}; _} ->
vars_of_pattern env inside
| PConstrApp {value=_, Some tuple; _} ->
vars_of_ptuple env tuple.value
| PConstrApp {value=_,None; _} -> env
and vars_of_plist env = function
PListComp {value; _} ->
vars_of_pinj env value
| PNil _ ->
env
| PParCons {value={inside; _}; _} ->
let head, _, tail = inside in
vars_of_pattern (vars_of_pattern env head) tail
| PCons {value; _} ->
Utils.nsepseq_foldl vars_of_pattern env value
and vars_of_pinj env inj =
Utils.sepseq_foldl vars_of_pattern env inj.elements
and vars_of_ptuple env {inside; _} =
Utils.nsepseq_foldl vars_of_pattern env inside
let vars_of_pattern = vars_of_pattern VSet.empty

6
src/passes/1-parser/pascaligo/AST.mli
View File

@ -615,3 +615,9 @@ val lhs_to_region : lhs -> Region.t
val rhs_to_region : rhs -> Region.t val rhs_to_region : rhs -> Region.t
val if_clause_to_region : if_clause -> Region.t val if_clause_to_region : if_clause -> Region.t
val selection_to_region : selection -> Region.t val selection_to_region : selection -> Region.t
(* Extracting variables from patterns *)
module VSet : Set.S with type elt = string Region.reg
val vars_of_pattern : pattern -> VSet.t

2
src/passes/1-parser/pascaligo/LexToken.mli
View File

@ -138,12 +138,14 @@ type ident_err = Reserved_name
type nat_err = Invalid_natural type nat_err = Invalid_natural
| Non_canonical_zero_nat | Non_canonical_zero_nat
type sym_err = Invalid_symbol type sym_err = Invalid_symbol
type kwd_err = Invalid_keyword
val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result
val mk_string : lexeme -> Region.t -> token val mk_string : lexeme -> Region.t -> token
val mk_bytes : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token
val mk_constr : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token

9
src/passes/1-parser/pascaligo/LexToken.mll
View File

@ -389,6 +389,15 @@ let lexicon : lexis =
cstr = build constructors; cstr = build constructors;
res = reserved} res = reserved}
(* Keywords *)
type kwd_err = Invalid_keyword
let mk_kwd ident region =
match SMap.find_opt ident lexicon.kwd with
Some mk_kwd -> Ok (mk_kwd region)
| None -> Error Invalid_keyword
(* Identifiers *) (* Identifiers *)
type ident_err = Reserved_name type ident_err = Reserved_name

144
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -6,7 +6,60 @@
open Region open Region
open AST open AST
(* END HEADER *) module SSet = Utils.String.Set
let reserved =
let open SSet in
empty
|> add "get_force"
|> add "get_chain_id"
|> add "transaction"
|> add "get_contract"
|> add "get_entrypoint"
|> add "size"
|> add "int"
|> add "abs"
|> add "is_nat"
|> add "amount"
|> add "balance"
|> add "now"
|> add "unit"
|> add "source"
|> add "sender"
|> add "failwith"
|> add "bitwise_or"
|> add "bitwise_and"
|> add "bitwise_xor"
|> add "string_concat"
|> add "string_slice"
|> add "crypto_check"
|> add "crypto_hash_key"
|> add "bytes_concat"
|> add "bytes_slice"
|> add "bytes_pack"
|> add "bytes_unpack"
|> add "set_empty"
|> add "set_mem"
|> add "set_add"
|> add "set_remove"
|> add "set_iter"
|> add "set_fold"
|> add "list_iter"
|> add "list_fold"
|> add "list_map"
|> add "map_iter"
|> add "map_map"
|> add "map_fold"
|> add "map_remove"
|> add "map_update"
|> add "map_get"
|> add "map_mem"
|> add "sha_256"
|> add "sha_512"
|> add "blake2b"
|> add "cons"
(* END HEADER *)
%} %}
(* See [ParToken.mly] for the definition of tokens. *) (* See [ParToken.mly] for the definition of tokens. *)
@ -118,6 +171,10 @@ declaration:
type_decl: type_decl:
"type" type_name "is" type_expr ";"? { "type" type_name "is" type_expr ";"? {
let () =
if SSet.mem $2.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $2)) in
let stop = let stop =
match $5 with match $5 with
Some region -> region Some region -> region
@ -185,6 +242,14 @@ type_tuple:
sum_type: sum_type:
"|"? nsepseq(variant,"|") { "|"? nsepseq(variant,"|") {
let add acc {value; _} =
if VSet.mem value.constr acc then
let open! SyntaxError in
raise (Error (Duplicate_variant value.constr))
else VSet.add value.constr acc in
let variants =
Utils.nsepseq_foldl add VSet.empty $2 in
let () = ignore variants in
let region = nsepseq_to_region (fun x -> x.region) $2 let region = nsepseq_to_region (fun x -> x.region) $2
in TSum {region; value=$2} } in TSum {region; value=$2} }
@ -225,6 +290,13 @@ fun_expr:
"function" fun_name? parameters ":" type_expr "is" "function" fun_name? parameters ":" type_expr "is"
block block
"with" expr { "with" expr {
let () =
match $2 with
Some name ->
if SSet.mem name.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name name))
| None -> () in
let stop = expr_to_region $9 in let stop = expr_to_region $9 in
let region = cover $1 stop let region = cover $1 stop
and value = {kwd_function = $1; and value = {kwd_function = $1;
@ -237,6 +309,13 @@ fun_expr:
return = $9} return = $9}
in {region; value} } in {region; value} }
| "function" fun_name? parameters ":" type_expr "is" expr { | "function" fun_name? parameters ":" type_expr "is" expr {
let () =
match $2 with
Some name ->
if SSet.mem name.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name name))
| None -> () in
let stop = expr_to_region $7 in let stop = expr_to_region $7 in
let region = cover $1 stop let region = cover $1 stop
and value = {kwd_function = $1; and value = {kwd_function = $1;
@ -256,7 +335,7 @@ fun_decl:
open_fun_decl { $1 } open_fun_decl { $1 }
| fun_expr ";" { | fun_expr ";" {
let region = cover $1.region $2 let region = cover $1.region $2
and value = {fun_expr=$1; terminator= Some $2} and value = {fun_expr=$1; terminator = Some $2}
in {region; value} } in {region; value} }
open_fun_decl: open_fun_decl:
@ -266,10 +345,31 @@ open_fun_decl:
in {region; value} } in {region; value} }
parameters: parameters:
par(nsepseq(param_decl,";")) { $1 } par(nsepseq(param_decl,";")) {
let open! AST in
let contents : (param_decl, semi) Utils.nsepseq par reg = $1 in
let add acc = function
ParamConst {value; _} ->
if VSet.mem value.var acc then
let open! SyntaxError in
raise (Error (Duplicate_parameter value.var))
else VSet.add value.var acc
| ParamVar {value; _} ->
if VSet.mem value.var acc then
let open! SyntaxError in
raise (Error (Duplicate_parameter value.var))
else VSet.add value.var acc in
let params =
Utils.nsepseq_foldl add VSet.empty contents.value.inside in
let () = ignore params
in $1 }
param_decl: param_decl:
"var" var ":" param_type { "var" var ":" param_type {
let () =
if SSet.mem $2.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $2)) in
let stop = type_expr_to_region $4 in let stop = type_expr_to_region $4 in
let region = cover $1 stop let region = cover $1 stop
and value = {kwd_var = $1; and value = {kwd_var = $1;
@ -279,6 +379,10 @@ param_decl:
in ParamVar {region; value} in ParamVar {region; value}
} }
| "const" var ":" param_type { | "const" var ":" param_type {
let () =
if SSet.mem $2.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $2)) in
let stop = type_expr_to_region $4 in let stop = type_expr_to_region $4 in
let region = cover $1 stop let region = cover $1 stop
and value = {kwd_const = $1; and value = {kwd_const = $1;
@ -346,13 +450,16 @@ open_var_decl:
unqualified_decl(OP): unqualified_decl(OP):
var ":" type_expr OP expr { var ":" type_expr OP expr {
let () =
if SSet.mem $1.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $1)) in
let region = expr_to_region $5 let region = expr_to_region $5
in $1, $2, $3, $4, $5, region } in $1, $2, $3, $4, $5, region }
const_decl: const_decl:
open_const_decl { $1 } open_const_decl ";"? {
| open_const_decl ";" { {$1 with value = {$1.value with terminator=$2}} }
{$1 with value = {$1.value with terminator = Some $2}} }
instruction: instruction:
conditional { Cond $1 } conditional { Cond $1 }
@ -555,6 +662,14 @@ cases(rhs):
case_clause(rhs): case_clause(rhs):
pattern "->" rhs { pattern "->" rhs {
let vars = AST.vars_of_pattern $1 in
let is_reserved elt = SSet.mem elt.value reserved in
let inter = VSet.filter is_reserved vars in
let () =
if not (VSet.is_empty inter) then
let clash = VSet.choose inter in
let open! SyntaxError in
raise (Error (Reserved_name clash)) in
fun rhs_to_region -> fun rhs_to_region ->
let start = pattern_to_region $1 in let start = pattern_to_region $1 in
let region = cover start (rhs_to_region $3) let region = cover start (rhs_to_region $3)
@ -596,6 +711,10 @@ for_loop:
in For (ForInt {region; value}) in For (ForInt {region; value})
} }
| "for" var arrow_clause? "in" collection expr block { | "for" var arrow_clause? "in" collection expr block {
let () =
if SSet.mem $2.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $2)) in
let region = cover $1 $7.region in let region = cover $1 $7.region in
let value = {kwd_for = $1; let value = {kwd_for = $1;
var = $2; var = $2;
@ -613,12 +732,21 @@ collection:
var_assign: var_assign:
var ":=" expr { var ":=" expr {
let () =
if SSet.mem $1.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $1)) in
let region = cover $1.region (expr_to_region $3) let region = cover $1.region (expr_to_region $3)
and value = {name=$1; assign=$2; expr=$3} and value = {name=$1; assign=$2; expr=$3}
in {region; value} } in {region; value} }
arrow_clause: arrow_clause:
"->" var { $1,$2 } "->" var {
let () =
if SSet.mem $2.value reserved then
let open! SyntaxError in
raise (Error (Reserved_name $2))
in $1,$2 }
(* Expressions *) (* Expressions *)
@ -646,7 +774,7 @@ cond_expr:
disj_expr: disj_expr:
conj_expr { $1 } conj_expr { $1 }
| disj_expr "or" conj_expr { | disj_expr "or" conj_expr {
let start = expr_to_region $1 let start = expr_to_region $1
and stop = expr_to_region $3 in and stop = expr_to_region $3 in
let region = cover start stop let region = cover start stop

58
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -19,9 +19,55 @@ module ExtParserLog =
include ParserLog include ParserLog
end end
module M = ParserUnit.Make (IO) module MyLexer = Lexer.Make (LexToken)
(Lexer.Make (LexToken))
(AST) module Unit =
(ExtParser) ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog)
(ParErr)
(ExtParserLog) open! SyntaxError
let () =
try Unit.run () with
(* Ad hoc errors from the parser *)
Error (Reserved_name name) ->
let () = Unit.close_all () in
let token =
MyLexer.Token.mk_ident name.Region.value name.Region.region in
(match token with
Stdlib.Error _ ->
assert false (* Should not fail if [name] is valid. *)
| Ok invalid ->
let point = "Reserved name.\nHint: Change the name.\n",
None, invalid in
let error =
Unit.format_error ~offsets:IO.options#offsets
IO.options#mode point
in Printf.eprintf "\027[31m%s\027[0m%!" error)
| Error (Duplicate_parameter name) ->
let () = Unit.close_all () in
let token =
MyLexer.Token.mk_ident name.Region.value name.Region.region in
(match token with
Stdlib.Error _ ->
assert false (* Should not fail if [name] is valid. *)
| Ok invalid ->
let point = "Duplicate parameter.\nHint: Change the name.\n",
None, invalid in
let error =
Unit.format_error ~offsets:IO.options#offsets
IO.options#mode point
in Printf.eprintf "\027[31m%s\027[0m%!" error)
| Error (Duplicate_variant name) ->
let () = Unit.close_all () in
let token =
MyLexer.Token.mk_constr name.Region.value name.Region.region in
let point = "Duplicate variant in this type declaration.\n\
Hint: Change the name.\n",
None, token in
let error =
Unit.format_error ~offsets:IO.options#offsets
IO.options#mode point
in Printf.eprintf "\027[31m%s\027[0m%!" error

8
src/passes/1-parser/pascaligo/SyntaxError.ml Normal file
View File

@ -0,0 +1,8 @@
type t =
Reserved_name of string Region.reg
| Duplicate_parameter of string Region.reg
| Duplicate_variant of string Region.reg
type error = t
exception Error of t

8
src/passes/1-parser/pascaligo/SyntaxError.mli Normal file
View File

@ -0,0 +1,8 @@
type t =
Reserved_name of string Region.reg
| Duplicate_parameter of string Region.reg
| Duplicate_variant of string Region.reg
type error = t
exception Error of t

3
src/passes/1-parser/pascaligo/dune
View File

@ -8,7 +8,8 @@
(library (library
(name parser_pascaligo) (name parser_pascaligo)
(public_name ligo.parser.pascaligo) (public_name ligo.parser.pascaligo)
(modules AST pascaligo Parser ParserLog LexToken) (modules
SyntaxError AST pascaligo Parser ParserLog LexToken)
(libraries (libraries
menhirLib menhirLib
parser_shared parser_shared

46
src/passes/1-parser/reasonligo.ml
View File

@ -29,11 +29,11 @@ module Errors = struct
] in ] in
error ~data title message error ~data title message
let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf =
let title () = "parser error" in let title () = "parser error" in
let file = if source = "" then let file = if source = "" then
"" ""
else else
Format.sprintf "In file \"%s|%s\"" start.pos_fname source Format.sprintf "In file \"%s|%s\"" start.pos_fname source
in in
let str = Format.sprintf let str = Format.sprintf
@ -44,22 +44,22 @@ module Errors = struct
file file
in in
let message () = str in let message () = str in
let loc = Region.make let loc = Region.make
~start:(Pos.from_byte start) ~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_) ~stop:(Pos.from_byte end_)
in in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
) )
] in ] in
error ~data title message error ~data title message
let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf =
let title () = "unrecognized error" in let title () = "unrecognized error" in
let file = if source = "" then let file = if source = "" then
"" ""
else else
Format.sprintf "In file \"%s|%s\"" start.pos_fname source Format.sprintf "In file \"%s|%s\"" start.pos_fname source
in in
let str = Format.sprintf let str = Format.sprintf
@ -70,14 +70,14 @@ module Errors = struct
file file
in in
let message () = str in let message () = str in
let loc = Region.make let loc = Region.make
~start:(Pos.from_byte start) ~start:(Pos.from_byte start)
~stop:(Pos.from_byte end_) ~stop:(Pos.from_byte end_)
in in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc fun () -> Format.asprintf "%a" Location.pp_lift @@ loc
) )
] in ] in
error ~data title message error ~data title message
@ -87,13 +87,13 @@ open Errors
type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a
let parse (parser: 'a parser) source lexbuf = let parse (parser: 'a parser) source lexbuf =
let Lexer.{read ; close ; _} = Lexer.open_token_stream None in let Lexer.{read ; close ; _} = Lexer.open_token_stream None in
let result = let result =
try try
ok (parser read lexbuf) ok (parser read lexbuf)
with with
| SyntaxError.Error (WrongFunctionArguments e) -> | SyntaxError.Error (WrongFunctionArguments e) ->
fail @@ (wrong_function_arguments e) fail @@ (wrong_function_arguments e)
| Parser.Error -> | Parser.Error ->
let start = Lexing.lexeme_start_p lexbuf in let start = Lexing.lexeme_start_p lexbuf in
@ -110,7 +110,7 @@ let parse (parser: 'a parser) source lexbuf =
close (); close ();
result result
let parse_file (source: string) : AST.t result = let parse_file (source: string) : AST.t result =
let pp_input = let pp_input =
let prefix = Filename.(source |> basename |> remove_extension) let prefix = Filename.(source |> basename |> remove_extension)
and suffix = ".pp.religo" and suffix = ".pp.religo"
@ -131,5 +131,5 @@ let parse_string (s:string) : AST.t result =
parse (Parser.contract) "" lexbuf parse (Parser.contract) "" lexbuf
let parse_expression (s:string) : AST.expr result = let parse_expression (s:string) : AST.expr result =
let lexbuf = Lexing.from_string s in let lexbuf = Lexing.from_string s in
parse (Parser.interactive_expr) "" lexbuf parse (Parser.interactive_expr) "" lexbuf

8
src/passes/1-parser/reasonligo/LexToken.mli
View File

@ -135,15 +135,17 @@ type ident_err = Reserved_name
type nat_err = Invalid_natural type nat_err = Invalid_natural
| Non_canonical_zero_nat | Non_canonical_zero_nat
type sym_err = Invalid_symbol type sym_err = Invalid_symbol
type kwd_err = Invalid_keyword
val mk_string : lexeme -> Region.t -> token
val mk_bytes : lexeme -> Region.t -> token
val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_int : lexeme -> Region.t -> (token, int_err) result
val mk_nat : lexeme -> Region.t -> (token, nat_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result
val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_mutez : lexeme -> Region.t -> (token, int_err) result
val mk_ident : lexeme -> Region.t -> (token, ident_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result
val mk_constr : lexeme -> Region.t -> token
val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result
val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result
val mk_string : lexeme -> Region.t -> token
val mk_bytes : lexeme -> Region.t -> token
val mk_constr : lexeme -> Region.t -> token
val eof : Region.t -> token val eof : Region.t -> token
(* Predicates *) (* Predicates *)

316
src/passes/1-parser/reasonligo/LexToken.mll
View File

@ -1,4 +1,6 @@
{ {
(* START OF HEADER *)
type lexeme = string type lexeme = string
let sprintf = Printf.sprintf let sprintf = Printf.sprintf
@ -91,116 +93,117 @@ type t =
| EOF of Region.t (* End of file *) | EOF of Region.t (* End of file *)
type token = t type token = t
let proj_token = function let proj_token = function
| CAT region -> region, "CAT" CAT region -> region, "CAT"
| MINUS region -> region, "MINUS" | MINUS region -> region, "MINUS"
| PLUS region -> region, "PLUS" | PLUS region -> region, "PLUS"
| SLASH region -> region, "SLASH" | SLASH region -> region, "SLASH"
| TIMES region -> region, "TIMES" | TIMES region -> region, "TIMES"
| LPAR region -> region, "LPAR" | LPAR region -> region, "LPAR"
| RPAR region -> region, "RPAR" | RPAR region -> region, "RPAR"
| LBRACKET region -> region, "LBRACKET" | LBRACKET region -> region, "LBRACKET"
| RBRACKET region -> region, "RBRACKET" | RBRACKET region -> region, "RBRACKET"
| LBRACE region -> region, "LBRACE" | LBRACE region -> region, "LBRACE"
| RBRACE region -> region, "RBRACE" | RBRACE region -> region, "RBRACE"
| COMMA region -> region, "COMMA" | COMMA region -> region, "COMMA"
| SEMI region -> region, "SEMI" | SEMI region -> region, "SEMI"
| VBAR region -> region, "VBAR" | VBAR region -> region, "VBAR"
| COLON region -> region, "COLON" | COLON region -> region, "COLON"
| DOT region -> region, "DOT" | DOT region -> region, "DOT"
| ELLIPSIS region -> region, "ELLIPSIS" | ELLIPSIS region -> region, "ELLIPSIS"
| WILD region -> region, "WILD" | WILD region -> region, "WILD"
| EQ region -> region, "EQ" | EQ region -> region, "EQ"
| EQEQ region -> region, "EQEQ" | EQEQ region -> region, "EQEQ"
| NE region -> region, "NE" | NE region -> region, "NE"
| LT region -> region, "LT" | LT region -> region, "LT"
| GT region -> region, "GT" | GT region -> region, "GT"
| LE region -> region, "LE" | LE region -> region, "LE"
| GE region -> region, "GE" | GE region -> region, "GE"
| ARROW region -> region, "ARROW" | ARROW region -> region, "ARROW"
| BOOL_OR region -> region, "BOOL_OR" | BOOL_OR region -> region, "BOOL_OR"
| BOOL_AND region -> region, "BOOL_AND" | BOOL_AND region -> region, "BOOL_AND"
| Ident Region.{region; value} -> | Ident Region.{region; value} ->
region, sprintf "Ident %s" value region, sprintf "Ident %s" value
| Constr Region.{region; value} -> | Constr Region.{region; value} ->
region, sprintf "Constr %s" value region, sprintf "Constr %s" value
| Int Region.{region; value = s,n} -> | Int Region.{region; value = s,n} ->
region, sprintf "Int (\"%s\", %s)" s (Z.to_string n) region, sprintf "Int (\"%s\", %s)" s (Z.to_string n)
| Nat Region.{region; value = s,n} -> | Nat Region.{region; value = s,n} ->
region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n)
| Mutez Region.{region; value = s,n} -> | Mutez Region.{region; value = s,n} ->
region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n)
| String Region.{region; value} -> | String Region.{region; value} ->
region, sprintf "String %s" value region, sprintf "String %s" value
| Bytes Region.{region; value = s,b} -> | Bytes Region.{region; value = s,b} ->
region, region,
sprintf "Bytes (\"%s\", \"0x%s\")" sprintf "Bytes (\"%s\", \"0x%s\")"
s (Hex.to_string b) s (Hex.to_string b)
| Else region -> region, "Else" | Else region -> region, "Else"
| False region -> region, "False" | False region -> region, "False"
| If region -> region, "If" | If region -> region, "If"
| Let region -> region, "Let" | Let region -> region, "Let"
| Switch region -> region, "Switch" | Switch region -> region, "Switch"
| Mod region -> region, "Mod" | Mod region -> region, "Mod"
| NOT region -> region, "!" | NOT region -> region, "!"
| Or region -> region, "Or" | Or region -> region, "Or"
| True region -> region, "True" | True region -> region, "True"
| Type region -> region, "Type" | Type region -> region, "Type"
| C_None region -> region, "C_None" | C_None region -> region, "C_None"
| C_Some region -> region, "C_Some" | C_Some region -> region, "C_Some"
| EOF region -> region, "EOF" | EOF region -> region, "EOF"
let to_lexeme = function let to_lexeme = function
| CAT _ -> "++" CAT _ -> "++"
| MINUS _ -> "-" | MINUS _ -> "-"
| PLUS _ -> "+" | PLUS _ -> "+"
| SLASH _ -> "/" | SLASH _ -> "/"
| TIMES _ -> "*" | TIMES _ -> "*"
| LPAR _ -> "(" | LPAR _ -> "("
| RPAR _ -> ")" | RPAR _ -> ")"
| LBRACKET _ -> "[" | LBRACKET _ -> "["
| RBRACKET _ -> "]" | RBRACKET _ -> "]"
| LBRACE _ -> "{" | LBRACE _ -> "{"
| RBRACE _ -> "}" | RBRACE _ -> "}"
| COMMA _ -> "," | COMMA _ -> ","
| SEMI _ -> ";" | SEMI _ -> ";"
| VBAR _ -> "|" | VBAR _ -> "|"
| COLON _ -> ":" | COLON _ -> ":"
| DOT _ -> "." | DOT _ -> "."
| ELLIPSIS _ -> "..." | ELLIPSIS _ -> "..."
| WILD _ -> "_" | WILD _ -> "_"
| EQ _ -> "=" | EQ _ -> "="
| EQEQ _ -> "==" | EQEQ _ -> "=="
| NE _ -> "!=" | NE _ -> "!="
| LT _ -> "<" | LT _ -> "<"
| GT _ -> ">" | GT _ -> ">"
| LE _ -> "<=" | LE _ -> "<="
| GE _ -> ">=" | GE _ -> ">="
| ARROW _ -> "=>" | ARROW _ -> "=>"
| BOOL_OR _ -> "||" | BOOL_OR _ -> "||"
| BOOL_AND _ -> "&&" | BOOL_AND _ -> "&&"
| Ident id -> id.Region.value | Ident id -> id.Region.value
| Constr id -> id.Region.value | Constr id -> id.Region.value
| Int i | Int i
| Nat i | Nat i
| Mutez i -> fst i.Region.value | Mutez i -> fst i.Region.value
| String s -> s.Region.value | String s -> s.Region.value
| Bytes b -> fst b.Region.value | Bytes b -> fst b.Region.value
| Else _ -> "else" | Else _ -> "else"
| False _ -> "false" | False _ -> "false"
| If _ -> "if" | If _ -> "if"
| Let _ -> "let" | Let _ -> "let"
| Mod _ -> "mod" | Mod _ -> "mod"
| NOT _ -> "!" | NOT _ -> "!"
| Or _ -> "or" | Or _ -> "or"
| Switch _ -> "switch" | Switch _ -> "switch"
| True _ -> "true" | True _ -> "true"
| Type _ -> "type" | Type _ -> "type"
| C_None _ -> "None" | C_None _ -> "None"
| C_Some _ -> "Some" | C_Some _ -> "Some"
| EOF _ -> "" | EOF _ -> ""
let to_string token ?(offsets=true) mode = let to_string token ?(offsets=true) mode =
let region, val_str = proj_token token in let region, val_str = proj_token token in
@ -216,20 +219,20 @@ type ident_err = Reserved_name
type nat_err = Invalid_natural type nat_err = Invalid_natural
| Non_canonical_zero_nat | Non_canonical_zero_nat
type sym_err = Invalid_symbol type sym_err = Invalid_symbol
type kwd_err = Invalid_keyword
(* LEXIS *) (* LEXIS *)
let keywords = [ let keywords = [
(fun reg -> Else reg); (fun reg -> Else reg);
(fun reg -> False reg); (fun reg -> False reg);
(fun reg -> If reg); (fun reg -> If reg);
(fun reg -> Let reg); (fun reg -> Let reg);
(fun reg -> Switch reg); (fun reg -> Switch reg);
(fun reg -> Mod reg); (fun reg -> Mod reg);
(fun reg -> Or reg); (fun reg -> Or reg);
(fun reg -> True reg); (fun reg -> True reg);
(fun reg -> Type reg); (fun reg -> Type reg)]
]
(* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and (* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and
https://github.com/facebook/reason/blob/master/src/reason-parser/reason_parser.mly *) https://github.com/facebook/reason/blob/master/src/reason-parser/reason_parser.mly *)
@ -305,6 +308,14 @@ let lexicon : lexis =
cstr = build constructors; cstr = build constructors;
res = reserved} res = reserved}
(* Keywords *)
let mk_kwd ident region =
match SMap.find_opt ident lexicon.kwd with
Some mk_kwd -> Ok (mk_kwd region)
| None -> Error Invalid_keyword
(* END OF HEADER *)
} }
(* START LEXER DEFINITION *) (* START LEXER DEFINITION *)
@ -380,40 +391,47 @@ let mk_mutez lexeme region =
let eof region = EOF region let eof region = EOF region
(* Making symbols *)
let mk_sym lexeme region = let mk_sym lexeme region =
match lexeme with match lexeme with
"-" -> Ok (MINUS region) "-" -> Ok (MINUS region)
| "+" -> Ok (PLUS region) | "+" -> Ok (PLUS region)
| "/" -> Ok (SLASH region) | "/" -> Ok (SLASH region)
| "*" -> Ok (TIMES region) | "*" -> Ok (TIMES region)
| "[" -> Ok (LBRACKET region) | "[" -> Ok (LBRACKET region)
| "]" -> Ok (RBRACKET region) | "]" -> Ok (RBRACKET region)
| "{" -> Ok (LBRACE region) | "{" -> Ok (LBRACE region)
| "}" -> Ok (RBRACE region) | "}" -> Ok (RBRACE region)
| "," -> Ok (COMMA region) | "," -> Ok (COMMA region)
| ";" -> Ok (SEMI region) | ";" -> Ok (SEMI region)
| "|" -> Ok (VBAR region) | "|" -> Ok (VBAR region)
| ":" -> Ok (COLON region) | ":" -> Ok (COLON region)
| "." -> Ok (DOT region) | "." -> Ok (DOT region)
| "_" -> Ok (WILD region) | "_" -> Ok (WILD region)
| "=" -> Ok (EQ region) | "=" -> Ok (EQ region)
| "!=" -> Ok (NE region) | "!=" -> Ok (NE region)
| "<" -> Ok (LT region) | "<" -> Ok (LT region)
| ">" -> Ok (GT region) | ">" -> Ok (GT region)
| "<=" -> Ok (LE region) | "<=" -> Ok (LE region)
| ">=" -> Ok (GE region) | ">=" -> Ok (GE region)
| "||" -> Ok (BOOL_OR region) | "||" -> Ok (BOOL_OR region)
| "&&" -> Ok (BOOL_AND region) | "&&" -> Ok (BOOL_AND region)
| "(" -> Ok (LPAR region) | "(" -> Ok (LPAR region)
| ")" -> Ok (RPAR region) | ")" -> Ok (RPAR region)
(* Symbols specific to ReasonLIGO *) (* Symbols specific to ReasonLIGO *)
| "..."-> Ok (ELLIPSIS region)
| "=>" -> Ok (ARROW region) | "..." -> Ok (ELLIPSIS region)
| "==" -> Ok (EQEQ region) | "=>" -> Ok (ARROW region)
| "!" -> Ok (NOT region) | "==" -> Ok (EQEQ region)
| "++" -> Ok (CAT region) | "!" -> Ok (NOT region)
| _ -> Error Invalid_symbol | "++" -> Ok (CAT region)
(* Invalid symbols *)
| _ -> Error Invalid_symbol
(* Identifiers *) (* Identifiers *)
@ -448,26 +466,26 @@ let is_ident = function
| _ -> false | _ -> false
let is_kwd = function let is_kwd = function
| Else _ Else _
| False _ | False _
| If _ | If _
| Let _ | Let _
| Switch _ | Switch _
| Mod _ | Mod _
| Or _ | Or _
| True _ | True _
| Type _ | Type _ -> true
| _ -> false | _ -> false
let is_constr = function let is_constr = function
| Constr _ Constr _
| Ident _ | Ident _
| False _ | False _
| True _ -> true | True _ -> true
| _ -> false | _ -> false
let is_sym = function let is_sym = function
| CAT _ CAT _
| MINUS _ | MINUS _
| PLUS _ | PLUS _
| SLASH _ | SLASH _

4
src/passes/1-parser/reasonligo/Parser.mly
View File

@ -370,7 +370,7 @@ ptuple:
in PTuple {value=$1; region} } in PTuple {value=$1; region} }
unit: unit:
"(" ")" { {region = cover $1 $2; value = ghost, ghost} } "(" ")" { {region = cover $1 $2; value = $1, $2} }
(* Expressions *) (* Expressions *)
@ -790,7 +790,7 @@ sequence_or_record_in:
sequence_or_record: sequence_or_record:
"{" sequence_or_record_in "}" { "{" sequence_or_record_in "}" {
let compound = Braces($1, $3) in let compound = Braces ($1,$3) in
let region = cover $1 $3 in let region = cover $1 $3 in
match $2 with match $2 with
PaSequence s -> PaSequence s ->

29
src/passes/1-parser/reasonligo/ParserMain.ml
View File

@ -19,9 +19,26 @@ module ExtParserLog =
include ParserLog include ParserLog
end end
module M = ParserUnit.Make (IO) module MyLexer = Lexer.Make (LexToken)
(Lexer.Make (LexToken))
(AST) module Unit =
(ExtParser) ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog)
(ParErr)
(ExtParserLog) (* Main *)
let () =
try Unit.run () with
(* Ad hoc errors from the parsers *)
SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) ->
let () = Unit.close_all () in
let msg = "It looks like you are defining a function, \
however we do not\n\
understand the parameters declaration.\n\
Examples of valid functions:\n\
let x = (a: string, b: int) : int => 3;\n\
let x = (a: string) : string => \"Hello, \" ++ a;\n"
and reg = AST.expr_to_region expr in
let error = Unit.short_error ~offsets:IO.options#offsets
IO.options#mode msg reg
in Printf.eprintf "\027[31m%s\027[0m%!" error

4
src/passes/1-parser/reasonligo/SyntaxError.mli
View File

@ -1,4 +1,4 @@
type error = type error =
| WrongFunctionArguments of AST.expr | WrongFunctionArguments of AST.expr
exception Error of error exception Error of error

25
src/passes/1-parser/shared/ParserAPI.ml
View File

@ -1,5 +1,7 @@
(* Generic parser for LIGO *) (* Generic parser for LIGO *)
module Region = Simple_utils.Region
module type PARSER = module type PARSER =
sig sig
(* The type of tokens, abstract syntax trees and expressions *) (* The type of tokens, abstract syntax trees and expressions *)
@ -104,17 +106,22 @@ module Make (Lexer: Lexer.S)
let trailer = let trailer =
match valid_opt with match valid_opt with
None -> None ->
if Lexer.Token.is_eof invalid then "" if Lexer.Token.is_eof invalid then ""
else let invalid_lexeme = Lexer.Token.to_lexeme invalid in else let invalid_lexeme = Lexer.Token.to_lexeme invalid in
Printf.sprintf ", before \"%s\"" invalid_lexeme Printf.sprintf ", before \"%s\"" invalid_lexeme
| Some valid -> | Some valid ->
let valid_lexeme = Lexer.Token.to_lexeme valid in let valid_lexeme = Lexer.Token.to_lexeme valid in
let s = Printf.sprintf ", after \"%s\"" valid_lexeme in let s = Printf.sprintf ", after \"%s\"" valid_lexeme in
if Lexer.Token.is_eof invalid then s if Lexer.Token.is_eof invalid then s
else else
let invalid_lexeme = Lexer.Token.to_lexeme invalid in let invalid_lexeme = Lexer.Token.to_lexeme invalid in
Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in
let header = header ^ trailer in let header = header ^ trailer in
header ^ (if msg = "" then ".\n" else ":\n" ^ msg) header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
let short_error ?(offsets=true) mode msg (invalid_region: Region.t) =
let () = assert (not (invalid_region#is_ghost)) in
let header =
"Parse error " ^ invalid_region#to_string ~offsets mode in
header ^ (if msg = "" then ".\n" else ":\n" ^ msg)
end end

8
src/passes/1-parser/shared/ParserAPI.mli
View File

@ -1,5 +1,7 @@
(* Generic parser API for LIGO *) (* Generic parser API for LIGO *)
module Region = Simple_utils.Region
module type PARSER = module type PARSER =
sig sig
(* The type of tokens. *) (* The type of tokens. *)
@ -56,5 +58,9 @@ module Make (Lexer: Lexer.S)
exception Point of error exception Point of error
val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string val format_error :
?offsets:bool -> [`Byte | `Point] -> error -> string
val short_error :
?offsets:bool -> [`Byte | `Point] -> message -> Region.t -> string
end end

44
src/passes/1-parser/shared/ParserUnit.ml
View File

@ -14,7 +14,8 @@ module type Pretty =
state -> ast -> unit state -> ast -> unit
val mk_state : val mk_state :
offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
val print_tokens : state -> ast -> unit val print_tokens :
state -> ast -> unit
end end
module Make (IO: S) module Make (IO: S)
@ -85,6 +86,9 @@ module Make (IO: S)
module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr)
let format_error = ParserFront.format_error
let short_error = ParserFront.short_error
let lexer_inst = Lexer.open_token_stream (Some pp_input) let lexer_inst = Lexer.open_token_stream (Some pp_input)
let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst
@ -103,7 +107,7 @@ module Make (IO: S)
(* Main *) (* Main *)
let () = let run () =
try try
let ast = let ast =
if IO.options#mono if IO.options#mono
@ -131,37 +135,41 @@ module Make (IO: S)
end end
with with
(* Lexing errors *) (* Lexing errors *)
Lexer.Error err -> Lexer.Error err ->
close_all (); close_all ();
let msg = let msg =
Lexer.format_error ~offsets:IO.options#offsets Lexer.format_error ~offsets:IO.options#offsets
IO.options#mode err ~file IO.options#mode err ~file
in prerr_string msg in prerr_string msg
(* Incremental API of Menhir *) (* Incremental API of Menhir *)
| ParserFront.Point point -> | ParserFront.Point point ->
let () = close_all () in let () = close_all () in
let error = let error =
ParserFront.format_error ~offsets:IO.options#offsets ParserFront.format_error ~offsets:IO.options#offsets
IO.options#mode point IO.options#mode point
in eprintf "\027[31m%s\027[0m%!" error in eprintf "\027[31m%s\027[0m%!" error
(* Monolithic API of Menhir *) (* Monolithic API of Menhir *)
| Parser.Error -> | Parser.Error ->
let () = close_all () in let () = close_all () in
let invalid, valid_opt = let invalid, valid_opt =
match get_win () with match get_win () with
Lexer.Nil -> Lexer.Nil ->
assert false (* Safe: There is always at least EOF. *) assert false (* Safe: There is always at least EOF. *)
| Lexer.One invalid -> invalid, None | Lexer.One invalid -> invalid, None
| Lexer.Two (invalid, valid) -> invalid, Some valid in | Lexer.Two (invalid, valid) -> invalid, Some valid in
let point = "", valid_opt, invalid in let point = "", valid_opt, invalid in
let error = let error =
ParserFront.format_error ~offsets:IO.options#offsets ParserFront.format_error ~offsets:IO.options#offsets
IO.options#mode point IO.options#mode point
in eprintf "\027[31m%s\027[0m%!" error in eprintf "\027[31m%s\027[0m%!" error
(* I/O errors *) (* I/O errors *)
| Sys_error msg -> Utils.highlight msg | Sys_error msg -> Utils.highlight msg
end end

2
src/test/contracts/chain_id.ligo
View File

@ -1,5 +1,5 @@
function get_chain_id (const tt : chain_id) : chain_id is function chain_id (const tt : chain_id) : chain_id is
block { block {
var toto : chain_id := get_chain_id ; var toto : chain_id := get_chain_id ;
} with ( toto ) } with ( toto )

58
src/test/integration_tests.ml
View File

@ -870,7 +870,7 @@ let map_ type_f path : unit result =
let make_expected = fun _ -> e_some @@ e_int 4 in let make_expected = fun _ -> e_some @@ e_int 4 in
expect_eq_n program "get_" make_input make_expected expect_eq_n program "get_" make_input make_expected
in in
let%bind () = let%bind () =
let input_map = ez [(23, 10) ; (42, 4)] in let input_map = ez [(23, 10) ; (42, 4)] in
expect_eq program "mem" (e_tuple [(e_int 23) ; input_map]) (e_bool true) expect_eq program "mem" (e_tuple [(e_int 23) ; input_map]) (e_bool true)
in in
@ -1057,27 +1057,27 @@ let loop () : unit result =
let make_input = e_nat in let make_input = e_nat in
let make_expected = fun n -> e_nat (n * (n + 1) / 2) in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "while_sum" make_input make_expected in expect_eq_n_pos_mid program "while_sum" make_input make_expected in
let%bind () = let%bind () =
let make_input = e_nat in let make_input = e_nat in
let make_expected = fun n -> e_int (n * (n + 1) / 2) in let make_expected = fun n -> e_int (n * (n + 1) / 2) in
expect_eq_n_pos_mid program "for_sum" make_input make_expected in expect_eq_n_pos_mid program "for_sum" make_input make_expected in
let input = e_unit () in let input = e_unit () in
let%bind () = let%bind () =
let expected = e_pair (e_int 3) (e_string "totototo") in let expected = e_pair (e_int 3) (e_string "totototo") in
expect_eq program "for_collection_list" input expected in expect_eq program "for_collection_list" input expected in
let%bind () = let%bind () =
let expected = e_pair (e_int 6) (e_string "totototo") in let expected = e_pair (e_int 6) (e_string "totototo") in
expect_eq program "for_collection_set" input expected in expect_eq program "for_collection_set" input expected in
let%bind () = let%bind () =
let expected = e_pair (e_int 6) (e_string "123") in let expected = e_pair (e_int 6) (e_string "123") in
expect_eq program "for_collection_map_kv" input expected in expect_eq program "for_collection_map_kv" input expected in
let%bind () = let%bind () =
let expected = (e_string "123") in let expected = (e_string "123") in
expect_eq program "for_collection_map_k" input expected in expect_eq program "for_collection_map_k" input expected in
let%bind () = let%bind () =
let expected = (e_int 0) in let expected = (e_int 0) in
expect_eq program "for_collection_empty" input expected in expect_eq program "for_collection_empty" input expected in
let%bind () = let%bind () =
let expected = (e_int 13) in let expected = (e_int 13) in
expect_eq program "for_collection_if_and_local_var" input expected in expect_eq program "for_collection_if_and_local_var" input expected in
let%bind () = let%bind () =
@ -1680,12 +1680,12 @@ let implicit_account_religo () : unit result =
ok () ok ()
let tuples_sequences_functions_religo () : unit result = let tuples_sequences_functions_religo () : unit result =
let%bind _ = retype_file "./contracts/tuples_sequences_functions.religo" in let%bind _ = retype_file "./contracts/tuples_sequences_functions.religo" in
ok () ok ()
let is_nat () : unit result = let is_nat () : unit result =
let%bind program = type_file "./contracts/isnat.ligo" in let%bind program = type_file "./contracts/isnat.ligo" in
let%bind () = let%bind () =
let input = e_int 10 in let input = e_int 10 in
let expected = e_some (e_nat 10) in let expected = e_some (e_nat 10) in
expect_eq program "main" input expected expect_eq program "main" input expected
@ -1698,7 +1698,7 @@ let is_nat () : unit result =
let is_nat_mligo () : unit result = let is_nat_mligo () : unit result =
let%bind program = mtype_file "./contracts/isnat.mligo" in let%bind program = mtype_file "./contracts/isnat.mligo" in
let%bind () = let%bind () =
let input = e_int 10 in let input = e_int 10 in
let expected = e_some (e_nat 10) in let expected = e_some (e_nat 10) in
expect_eq program "main" input expected expect_eq program "main" input expected
@ -1711,7 +1711,7 @@ let is_nat_mligo () : unit result =
let is_nat_religo () : unit result = let is_nat_religo () : unit result =
let%bind program = retype_file "./contracts/isnat.religo" in let%bind program = retype_file "./contracts/isnat.religo" in
let%bind () = let%bind () =
let input = e_int 10 in let input = e_int 10 in
let expected = e_some (e_nat 10) in let expected = e_some (e_nat 10) in
expect_eq program "main" input expected expect_eq program "main" input expected
@ -1745,7 +1745,7 @@ let deep_access_ligo () : unit result =
let make_expected = e_string "one" in let make_expected = e_string "one" in
expect_eq program "nested_record" make_input make_expected in expect_eq program "nested_record" make_input make_expected in
ok () ok ()
let entrypoints_ligo () : unit result = let entrypoints_ligo () : unit result =
let%bind _program = type_file "./contracts/entrypoints.ligo" in let%bind _program = type_file "./contracts/entrypoints.ligo" in
@ -1759,7 +1759,7 @@ let chain_id () : unit result =
Tezos_base__TzPervasives.Chain_id.zero in Tezos_base__TzPervasives.Chain_id.zero in
let make_input = e_chain_id pouet in let make_input = e_chain_id pouet in
let make_expected = e_chain_id pouet in let make_expected = e_chain_id pouet in
let%bind () = expect_eq program "get_chain_id" make_input make_expected in let%bind () = expect_eq program "chain_id" make_input make_expected in
ok () ok ()
let key_hash () : unit result = let key_hash () : unit result =
@ -1830,46 +1830,46 @@ let bytes_unpack () : unit result =
let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in
ok () ok ()
let empty_case () : unit result = let empty_case () : unit result =
let%bind program = type_file "./contracts/empty_case.ligo" in let%bind program = type_file "./contracts/empty_case.ligo" in
let%bind () = let%bind () =
let input _ = e_constructor "Bar" (e_int 1) in let input _ = e_constructor "Bar" (e_int 1) in
let expected _ = e_int 1 in let expected _ = e_int 1 in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
let%bind () = let%bind () =
let input _ = e_constructor "Baz" (e_unit ()) in let input _ = e_constructor "Baz" (e_unit ()) in
let expected _ = e_int (-1) in let expected _ = e_int (-1) in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
ok () ok ()
let empty_case_mligo () : unit result = let empty_case_mligo () : unit result =
let%bind program = mtype_file "./contracts/empty_case.mligo" in let%bind program = mtype_file "./contracts/empty_case.mligo" in
let%bind () = let%bind () =
let input _ = e_constructor "Bar" (e_int 1) in let input _ = e_constructor "Bar" (e_int 1) in
let expected _ = e_int 1 in let expected _ = e_int 1 in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
let%bind () = let%bind () =
let input _ = e_constructor "Baz" (e_unit ()) in let input _ = e_constructor "Baz" (e_unit ()) in
let expected _ = e_int (-1) in let expected _ = e_int (-1) in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
ok () ok ()
let empty_case_religo () : unit result = let empty_case_religo () : unit result =
let%bind program = retype_file "./contracts/empty_case.religo" in let%bind program = retype_file "./contracts/empty_case.religo" in
let%bind () = let%bind () =
let input _ = e_constructor "Bar" (e_int 1) in let input _ = e_constructor "Bar" (e_int 1) in
let expected _ = e_int 1 in let expected _ = e_int 1 in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
let%bind () = let%bind () =
let input _ = e_constructor "Baz" (e_unit ()) in let input _ = e_constructor "Baz" (e_unit ()) in
let expected _ = e_int (-1) in let expected _ = e_int (-1) in
expect_eq_n program "main" input expected expect_eq_n program "main" input expected
in in
ok () ok ()
let main = test_suite "Integration (End to End)" [ let main = test_suite "Integration (End to End)" [