diff --git a/src/ligo/contracts/new-syntax.mligo b/src/ligo/contracts/new-syntax.mligo index 9a326d449..dfd965c11 100644 --- a/src/ligo/contracts/new-syntax.mligo +++ b/src/ligo/contracts/new-syntax.mligo @@ -1,6 +1,3 @@ -(* Smart contract for voting. Winners of vote split the contract - balance at the end of the voting period. *) - (** Type of storage for this contract *) type storage = { challenge : string ; @@ -20,4 +17,4 @@ let%entry attempt (p:param) storage = if Crypto.hash (Bytes.pack p.attempt) <> Bytes.pack storage.challenge then failwith "Failed challenge" ; let transfer : operation = Operation.transfer (sender , 10tz) in let storage : storage = storage.challenge <- p.new_challenge in - ([] , storage) + ((list [] : operation list), storage) diff --git a/src/ligo/parser/camligo/generator.ml b/src/ligo/parser/camligo/generator.ml index c21252744..1cd1b46db 100644 --- a/src/ligo/parser/camligo/generator.ml +++ b/src/ligo/parser/camligo/generator.ml @@ -424,8 +424,8 @@ module Pattern = struct let application = empty_infix "application" `Left - let list : O.n_operator = make_name "list" [ - `Token LIST ; `Token LSQUARE ; `List (Lead SEMICOLON, `Current) ; `Token RSQUARE ; + let data_structure : O.n_operator = make_name "data_structure" [ + `Named variable_name ; `Token LSQUARE ; `List (Lead SEMICOLON, `Current) ; `Token RSQUARE ; ] let record_element : O.rule = make_name "p_record_element" [ @@ -460,10 +460,11 @@ module Pattern = struct ] [] let main = O.name_hierarchy pattern_name "P" [ - [application ; record] ; + [record] ; [type_annotation] ; [pair] ; - [list] ; + [data_structure] ; + [application] ; [variable ; constructor ; module_ident ; unit] ; [paren "paren" pattern_name] ] [] @@ -482,8 +483,8 @@ module Expression = struct `Current ; `Token COLON ; `Named restricted_type_expression_name ] - let list : O.n_operator = make_name "list" [ - `Token LSQUARE ; `List (Trail SEMICOLON, `Current) ; `Token RSQUARE ; + let data_structure : O.n_operator = make_name "data_structure" [ + `Named variable_name ; `Token LSQUARE ; `List (Trail SEMICOLON, `Current) ; `Token RSQUARE ; ] let fun_ : O.n_operator = make_name "fun" [ @@ -584,10 +585,10 @@ module Expression = struct [lt ; le ; gt ; eq ; neq] ; [assignment] ; [cons] ; - [application] ; [addition ; substraction] ; [multiplication ; division] ; - [list] ; + [application] ; + [data_structure] ; [name] ; [arith_variable ; constructor ; module_ident ; accessor ; int ; unit ; string ; tz] ; [paren "bottom" expression_name] ; @@ -627,7 +628,7 @@ module Type_expression = struct `Token RBRACKET ; ] - let application = empty_infix "application" `Left + let application = empty_infix "application" `Right let tuple = make_name "tuple" [ `List (Separated_nene COMMA, `Lower) @@ -636,6 +637,7 @@ module Type_expression = struct let type_variable : O.n_operator = make_name "variable" [ `Named variable_name ] let restricted_type_expression = O.name_hierarchy restricted_type_expression_name "Tr" [ + [application] ; [type_variable] ; [paren "paren" type_expression_name] ; ] [] @@ -671,7 +673,6 @@ module Program = struct ] let type_annotation_name = "type_annotation_" - let type_annotation : O.rule = make_name type_annotation_name [ make_name "" [ `Token COLON ; `Named type_expression_name ] ; ] @@ -687,13 +688,6 @@ module Program = struct ] ; ] - (* let statement : O.rule = make_name statement_name [ - * make_name "variable_declaration" [`Token LET ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ; - * make_name "init_declaration" [`Token LET_INIT ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ; - * make_name "entry_declaration" [`Token LET_ENTRY ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ; - * make_name "type_declaration" [`Token TYPE ; `Named variable_name ; `Token EQUAL ; `Named type_expression_name] ; - * ] *) - let statement : O.rule = make_name statement_name [ make_name "variable_declaration" [`Token LET ; `Named let_content_name] ; make_name "init_declaration" [`Token LET_INIT ; `Named let_content_name] ; diff --git a/src/ligo/parser/camligo/lex/generator.ml b/src/ligo/parser/camligo/lex/generator.ml index f94ad934b..acd64732a 100644 --- a/src/ligo/parser/camligo/lex/generator.ml +++ b/src/ligo/parser/camligo/lex/generator.ml @@ -125,7 +125,6 @@ let tokens = [ keyword "if" ; keyword "then" ; keyword "else" ; - keyword "list" ; (* keyword "block" ; * keyword "for" ; * keyword "const" ; *) diff --git a/src/ligo/simplify/camligo.ml b/src/ligo/simplify/camligo.ml index 024b2d7a1..32b7f49b8 100644 --- a/src/ligo/simplify/camligo.ml +++ b/src/ligo/simplify/camligo.ml @@ -53,6 +53,11 @@ let get_p_typed_variable : I.pattern -> (string Location.wrap * I.restricted_typ let%bind var = get_p_variable (unwrap p') in ok (var , rte) +let get_eh_accessor : _ -> _ result = fun x -> + match x with + | I.Eh_accessor x -> ok x + | _ -> simple_fail "not a simple eh_accessor" + let get_typed_variable_param : I.param -> _ result = fun arg -> let%bind up = let%bind rp = get_param_restricted_pattern arg in @@ -133,14 +138,18 @@ let rec type_expression : I.type_expression -> O.type_expression result = fun te | I.T_variable v -> ( match List.assoc_opt v.wrap_content type_constants with | Some n -> ( + let error expected got = + let title () = "bad arity" in + let content () = Format.asprintf "Expected: %d. Got: %d." expected got in + error title content in match arg'.wrap_content with | T_tuple lst -> ( let%bind () = - trace (simple_error "bad arity") @@ + trace (error n (List.length lst)) @@ Assert.assert_list_size lst n in ok @@ O.T_constant (v.wrap_content , lst) ) - | _ -> simple_fail "bad arity" + | e -> ok @@ O.T_constant ((unwrap v) , [ e ]) ) | None -> ( let error = @@ -153,12 +162,15 @@ let rec type_expression : I.type_expression -> O.type_expression result = fun te ) | _ -> simple_fail "type applying to non-var" -let restricted_type_expression : I.restricted_type_expression -> O.type_expression result = fun rte -> +let rec of_restricted_type_expression : I.restricted_type_expression -> I.type_expression = fun rte -> + let self = of_restricted_type_expression in match rte with - | Tr_variable tv -> - let%bind tv' = bind_map_location type_variable tv in - ok @@ unwrap tv' - | Tr_paren te -> type_expression (unwrap te) + | Tr_variable tv -> T_variable tv + | Tr_application (a , b) -> T_application (Location.map self a , Location.map self b) + | Tr_paren te -> unwrap te + +let restricted_type_expression : I.restricted_type_expression -> O.type_expression result = + Function.compose type_expression of_restricted_type_expression type last_instruction_result = (O.block * O.annotated_expression) type lir = last_instruction_result @@ -197,7 +209,7 @@ and let_in_last_instruction : = fun l -> let (pat , expr , body) = l in let%bind (var , ty) = get_p_typed_variable (unwrap pat) in - let%bind ty' = restricted_type_expression (unwrap ty) in + let%bind ty' = type_expression @@ of_restricted_type_expression (unwrap ty) in let%bind expr' = expression (unwrap expr) in let%bind uexpr' = get_untyped_expression expr' in let%bind (body' , last') = expression_last_instruction (unwrap body) in @@ -328,12 +340,24 @@ and expression_main : I.expression_main Location.wrap -> O.annotated_expression return @@ E_variable (unwrap v) | Eh_constructor _ -> simple_fail "constructor without parameter" - | Eh_list _ -> - simple_fail "list not supported yet" + | Eh_data_structure (kind , content) -> ( + match unwrap kind with + | "list" -> ( + let%bind lst = bind_map_list expression_main content in + ok @@ untyped_expression @@ E_list lst + ) + | kind' -> ( + let error = + let title () = "data-structures not supported yet" in + let content () = Format.asprintf "%s" kind' in + error title content in + fail error + ) + ) | Eh_name _ -> simple_fail "named parameter not supported yet" - | Eh_assign _ -> - simple_fail "assign not supported yet" + | Eh_assign x -> + simple_binop "ASSIGN" x | Eh_accessor (src , path) -> ok @@ O.(untyped_expression @@ e_accessor_props (untyped_expression @@ e_variable (unwrap src)) (List.map unwrap path)) | Eh_bottom e ->