From a39c900b72f9753bc770e127621c79734c72fb87 Mon Sep 17 00:00:00 2001 From: Pierre-Emmanuel Wulfman Date: Mon, 16 Mar 2020 18:34:43 +0100 Subject: [PATCH] remove set and list --- src/bin/expect_tests/contract_tests.ml | 124 ++++++++++-------- src/bin/expect_tests/typer_error_tests.ml | 2 +- src/passes/10-interpreter/interpreter.ml | 13 +- src/passes/10-transpiler/transpiler.ml | 20 --- src/passes/10-transpiler/untranspiler.ml | 11 +- src/passes/11-self_mini_c/helpers.ml | 8 +- src/passes/11-self_mini_c/self_mini_c.ml | 2 - src/passes/11-self_mini_c/subst.ml | 6 +- src/passes/12-compiler/compiler_program.ml | 13 +- src/passes/6-sugar_to_core/sugar_to_core.ml | 27 ++-- src/passes/8-typer-new/typer.ml | 17 --- src/passes/8-typer-old/typer.ml | 63 +++------ src/passes/9-self_ast_typed/helpers.ml | 18 +-- src/passes/9-self_ast_typed/tail_recursion.ml | 3 - src/passes/operators/operators.ml | 8 +- src/stages/1-ast_imperative/combinators.ml | 5 +- src/stages/1-ast_imperative/combinators.mli | 1 + src/stages/3-ast_core/PP.ml | 4 - src/stages/3-ast_core/combinators.ml | 25 ++-- src/stages/3-ast_core/combinators.mli | 8 -- src/stages/3-ast_core/misc.ml | 35 ++--- src/stages/3-ast_core/types.ml | 2 - src/stages/4-ast_typed/PP.ml | 4 - src/stages/4-ast_typed/combinators.ml | 2 - src/stages/4-ast_typed/combinators.mli | 2 - .../4-ast_typed/combinators_environment.ml | 1 - .../4-ast_typed/combinators_environment.mli | 1 - src/stages/4-ast_typed/misc.ml | 20 --- src/stages/4-ast_typed/misc_smart.ml | 6 - src/stages/4-ast_typed/types.ml | 2 - src/stages/5-mini_c/PP.ml | 4 +- src/stages/5-mini_c/misc.ml | 2 - src/stages/5-mini_c/types.ml | 2 - src/stages/common/PP.ml | 2 + src/stages/common/types.ml | 2 + src/stages/typesystem/misc.ml | 6 - 36 files changed, 157 insertions(+), 314 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 311d96b41..913a89352 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -7,13 +7,13 @@ let bad_contract basename = let%expect_test _ = run_ligo_good [ "measure-contract" ; contract "coase.ligo" ; "main" ] ; - [%expect {| 1870 bytes |}] ; + [%expect {| 1872 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; [%expect {| 1294 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; - [%expect {| 2935 bytes |}] ; + [%expect {| 3268 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ; [%expect {| 589 bytes |}] ; @@ -227,16 +227,17 @@ let%expect_test _ = NIL operation ; SWAP ; CONS ; - DIP { DIP 4 { DUP } ; - DIG 4 ; - DIP 4 { DUP } ; - DIG 4 ; + DUP ; + DIP { DIP 5 { DUP } ; + DIG 5 ; + DIP 5 { DUP } ; + DIG 5 ; DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ; SWAP ; PAIR ; PAIR } ; PAIR ; - DIP { DROP 13 } } ; + DIP { DROP 14 } } ; DIP { DROP } } { DUP ; DIP { DIP { DUP } ; SWAP } ; @@ -513,19 +514,19 @@ let%expect_test _ = GT ; IF { PUSH string "Message size exceed maximum limit" ; FAILWITH } { PUSH unit Unit } ; - DIP 4 { DUP } ; - DIG 4 ; EMPTY_SET address ; + DUP ; + DIP { DIP 5 { DUP } ; DIG 5 } ; PAIR ; - DIP 2 { DUP } ; - DIG 2 ; - DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR } ; + DIP 3 { DUP } ; + DIG 3 ; + DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } ; GET ; IF_NONE - { DIP 5 { DUP } ; - DIG 5 ; - DIP 6 { DUP } ; + { DIP 6 { DUP } ; DIG 6 ; + DIP 7 { DUP } ; + DIG 7 ; CDR ; CAR ; CAR ; @@ -535,7 +536,7 @@ let%expect_test _ = PUSH nat 1 ; ADD ; SOME ; - DIP { DIP 6 { DUP } ; DIG 6 ; CDR ; CAR ; CAR } ; + DIP { DIP 7 { DUP } ; DIG 7 ; CDR ; CAR ; CAR } ; SENDER ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; @@ -543,31 +544,33 @@ let%expect_test _ = PAIR ; SWAP ; PAIR ; - DIP { DUP } ; - SWAP ; - CAR ; - DIP { DUP } ; - PAIR ; EMPTY_SET address ; PUSH bool True ; SENDER ; UPDATE ; + DIP 2 { DUP } ; + DIG 2 ; + DIP 2 { DUP } ; + DIG 2 ; SWAP ; + CAR ; + PAIR ; CDR ; + DIP { DUP } ; SWAP ; PAIR ; - DIP { DROP } } - { DIP 6 { DUP } ; - DIG 6 ; + DIP { DROP 2 } } + { DIP 7 { DUP } ; + DIG 7 ; DIP { DUP } ; SWAP ; SENDER ; MEM ; IF { DUP } - { DIP 7 { DUP } ; - DIG 7 ; - DIP 8 { DUP } ; + { DIP 8 { DUP } ; DIG 8 ; + DIP 9 { DUP } ; + DIG 9 ; CDR ; CAR ; CAR ; @@ -577,7 +580,7 @@ let%expect_test _ = PUSH nat 1 ; ADD ; SOME ; - DIP { DIP 8 { DUP } ; DIG 8 ; CDR ; CAR ; CAR } ; + DIP { DIP 9 { DUP } ; DIG 9 ; CDR ; CAR ; CAR } ; SENDER ; UPDATE ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CDR } ; @@ -623,21 +626,26 @@ let%expect_test _ = GT ; IF { PUSH string "Maximum number of proposal reached" ; FAILWITH } { PUSH unit Unit } ; - DIP 2 { DUP } ; - DIG 2 ; NIL operation ; + DIP 10 { DUP } ; + DIG 10 ; + DIP { DIP 4 { DUP } ; DIG 4 } ; PAIR ; - DIP 4 { DUP } ; - DIG 4 ; + DIP { DIP 9 { DUP } ; DIG 9 ; DIP { DUP } ; PAIR } ; + PAIR ; + DIP { DIP 3 { DUP } ; DIG 3 } ; + PAIR ; + DIP 5 { DUP } ; + DIG 5 ; SIZE ; - DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CDR } ; + DIP { DIP 4 { DUP } ; DIG 4 ; CDR ; CDR } ; COMPARE ; GE ; - IF { DIP 3 { DUP } ; - DIG 3 ; - DIP 9 { DUP } ; - DIG 9 ; - DIP { DIP 4 { DUP } ; DIG 4 ; CAR ; CDR ; CDR ; NONE (set address) } ; + IF { DIP 4 { DUP } ; + DIG 4 ; + DIP 11 { DUP } ; + DIG 11 ; + DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR ; NONE (set address) } ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -649,7 +657,7 @@ let%expect_test _ = CDR ; CAR ; CDR ; - DIP { DIP 10 { DUP } ; DIG 10 } ; + DIP { DIP 12 { DUP } ; DIG 12 } ; EXEC ; DIP { DUP } ; SWAP ; @@ -658,7 +666,7 @@ let%expect_test _ = CDR ; CAR ; CDR ; - DIP { DIP 11 { DUP } ; DIG 11 } ; + DIP { DIP 13 { DUP } ; DIG 13 } ; CONCAT ; SHA256 ; DIP { DUP ; CAR ; SWAP ; CDR ; DUP ; CDR ; SWAP ; CAR ; CAR } ; @@ -683,8 +691,12 @@ let%expect_test _ = DIP { DUP } ; SWAP ; DIP { DUP } ; - SWAP ; - DIP { DIP 11 { DUP } ; DIG 11 } ; + PAIR ; + DIP { DIP 2 { DUP } ; DIG 2 } ; + PAIR ; + DIP 2 { DUP } ; + DIG 2 ; + DIP { DIP 13 { DUP } ; DIG 13 } ; MEM ; IF { DIP 2 { DUP } ; DIG 2 ; @@ -746,14 +758,14 @@ let%expect_test _ = PAIR ; DIP { DROP 4 } } { DUP ; - DIP 4 { DUP } ; - DIG 4 ; - DIP 10 { DUP } ; - DIG 10 ; - DIP { DIP 6 { DUP } ; - DIG 6 ; + DIP 5 { DUP } ; + DIG 5 ; + DIP 12 { DUP } ; + DIG 12 ; + DIP { DIP 7 { DUP } ; + DIG 7 ; SOME ; - DIP { DIP 5 { DUP } ; DIG 5 ; CAR ; CDR ; CDR } } ; + DIP { DIP 6 { DUP } ; DIG 6 ; CAR ; CDR ; CDR } } ; UPDATE ; DIP { DUP ; CDR ; SWAP ; CAR ; DUP ; CAR ; SWAP ; CDR ; CAR } ; SWAP ; @@ -768,7 +780,7 @@ let%expect_test _ = CAR ; DIP { DUP ; CDR } ; PAIR ; - DIP { DROP 15 } } ; + DIP { DROP 17 } } ; DIP { DROP } } { DUP ; DIP { DIP { DUP } ; SWAP } ; @@ -1033,11 +1045,11 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "dry-run" ; contract "redeclaration.ligo" ; "main" ; "unit" ; "0" ] ; - [%expect {|( list[] , 0 ) |}] + [%expect {|( LIST_EMPTY() , 0 ) |}] let%expect_test _ = run_ligo_good [ "dry-run" ; contract "double_main.ligo" ; "main" ; "unit" ; "0" ] ; - [%expect {|( list[] , 2 ) |}] + [%expect {|( LIST_EMPTY() , 2 ) |}] let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "subtle_nontail_fail.mligo" ; "main" ] ; @@ -1095,7 +1107,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "dry-run" ; contract "super-counter.mligo" ; "main" ; "test_param" ; "test_storage" ] ; [%expect {| - ( list[] , 3 ) |}] + ( LIST_EMPTY() , 3 ) |}] let%expect_test _ = run_ligo_bad [ "compile-contract" ; bad_contract "redundant_constructors.mligo" ; "main" ] ; @@ -1114,7 +1126,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#702 = #P in let p = rhs#702.0 in let s = rhs#702.1 in ( list[] : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} +ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return let rhs#654 = #P in let p = rhs#654.0 in let s = rhs#654.1 in ( LIST_EMPTY() : (TO_list(operation)) , store ) , NONE() : (TO_option(key_hash)) , 300000000mutez , \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} If you're not sure how to fix this error, you can @@ -1127,7 +1139,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#705 = #P in let p = rhs#705.0 in let s = rhs#705.1 in ( list[] : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} +ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return let rhs#657 = #P in let p = rhs#657.0 in let s = rhs#657.1 in ( LIST_EMPTY() : (TO_list(operation)) , a ) , NONE() : (TO_option(key_hash)) , 300000000mutez , 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} If you're not sure how to fix this error, you can @@ -1336,4 +1348,4 @@ let%expect_test _ = * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/ * Ask a question on our Discord: https://discord.gg/9rhYaEt * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new - * Check the changelog by running 'ligo changelog' |}] \ No newline at end of file + * Check the changelog by running 'ligo changelog' |}] diff --git a/src/bin/expect_tests/typer_error_tests.ml b/src/bin/expect_tests/typer_error_tests.ml index ecf5ce7e3..facf1e75c 100644 --- a/src/bin/expect_tests/typer_error_tests.ml +++ b/src/bin/expect_tests/typer_error_tests.ml @@ -175,7 +175,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_good [ "interpret" ; "Set.literal [ (1,(2,3)) ; (2,(3,4)) ]" ; "--syntax=cameligo" ] ; [%expect {| - set[( 2 , ( 3 , 4 ) ) , ( 1 , ( 2 , 3 ) )] |}]; + SET_ADD(( 2 , ( 3 , 4 ) ) , SET_ADD(( 1 , ( 2 , 3 ) ) , SET_EMPTY())) |}]; run_ligo_bad [ "interpret" ; "Set.literal [ (1,2,3) ; (2,3,4) ]" ; "--syntax=cameligo" ] ; [%expect {| diff --git a/src/passes/10-interpreter/interpreter.ml b/src/passes/10-interpreter/interpreter.ml index 77d30cb71..6925a0243 100644 --- a/src/passes/10-interpreter/interpreter.ml +++ b/src/passes/10-interpreter/interpreter.ml @@ -119,6 +119,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result = | ( C_OR , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool (a' || b') | ( C_AND , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool (a' && b') | ( C_XOR , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool ( (a' || b') && (not (a' && b')) ) + | ( C_LIST_EMPTY, []) -> ok @@ V_List ([]) | ( C_LIST_MAP , [ V_Func_val (arg_name, body, env) ; V_List (elts) ] ) -> let%bind elts' = bind_map_list (fun elt -> @@ -188,6 +189,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result = | "None" -> ok @@ V_Map (List.remove_assoc k kvs) | _ -> simple_fail "update without an option" ) + | ( C_SET_EMPTY, []) -> ok @@ V_Set ([]) | ( C_SET_ADD , [ v ; V_Set l ] ) -> ok @@ V_Set (List.sort_uniq compare (v::l)) | ( C_SET_FOLD , [ V_Func_val (arg_name, body, env) ; V_Set elts ; init ] ) -> bind_fold_list @@ -294,17 +296,6 @@ and eval : Ast_typed.expression -> env -> value result (fun kv -> bind_map_pair (fun (el:Ast_typed.expression) -> eval el env) kv) kvlist in ok @@ V_Map kvlist' - | E_list expl -> - let%bind expl' = bind_map_list - (fun (exp:Ast_typed.expression) -> eval exp env) - expl in - ok @@ V_List expl' - | E_set expl -> - let%bind expl' = bind_map_list - (fun (exp:Ast_typed.expression) -> eval exp env) - (List.sort_uniq compare expl) - in - ok @@ V_Set expl' | E_literal l -> eval_literal l | E_variable var -> diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml index b7935bbe4..82f048614 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -390,26 +390,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result = transpile_lambda l io | E_recursive r -> transpile_recursive r - | E_list lst -> ( - let%bind t = - trace_strong (corner_case ~loc:__LOC__ "not a list") @@ - get_t_list tv in - let%bind lst' = bind_map_list (transpile_annotated_expression) lst in - let aux : expression -> expression -> expression result = fun prev cur -> - return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in - let%bind (init : expression) = return @@ E_make_empty_list t in - bind_fold_right_list aux init lst' - ) - | E_set lst -> ( - let%bind t = - trace_strong (corner_case ~loc:__LOC__ "not a set") @@ - get_t_set tv in - let%bind lst' = bind_map_list (transpile_annotated_expression) lst in - let aux : expression -> expression -> expression result = fun prev cur -> - return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in - let%bind (init : expression) = return @@ E_make_empty_set t in - bind_fold_list aux init lst' - ) | E_map m -> ( let%bind (src, dst) = trace_strong (corner_case ~loc:__LOC__ "not a map") @@ diff --git a/src/passes/10-transpiler/untranspiler.ml b/src/passes/10-transpiler/untranspiler.ml index 49f9cde37..e9a924c53 100644 --- a/src/passes/10-transpiler/untranspiler.ml +++ b/src/passes/10-transpiler/untranspiler.ml @@ -181,7 +181,10 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul let%bind lst' = let aux = fun e -> untranspile e ty in bind_map_list aux lst in - return (E_list lst') + let aux = fun prev cur -> + return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in + let%bind init = return @@ E_constant {cons_name=C_LIST_EMPTY;arguments=[]} in + bind_fold_right_list aux init lst' ) | TC_arrow _ -> ( let%bind n = @@ -196,7 +199,11 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul let%bind lst' = let aux = fun e -> untranspile e ty in bind_map_list aux lst in - return (E_set lst') + let lst' = List.sort_uniq compare lst' in + let aux = fun prev cur -> + return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in + let%bind init = return @@ E_constant {cons_name=C_SET_EMPTY;arguments=[]} in + bind_fold_list aux init lst' ) | TC_contract _ -> fail @@ bad_untranspile "contract" v diff --git a/src/passes/11-self_mini_c/helpers.ml b/src/passes/11-self_mini_c/helpers.ml index 6b77cf2ee..ea6d1355c 100644 --- a/src/passes/11-self_mini_c/helpers.ml +++ b/src/passes/11-self_mini_c/helpers.ml @@ -27,10 +27,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini | E_variable _ | E_skip | E_make_none _ | E_make_empty_map _ | E_make_empty_big_map _ - | E_make_empty_list _ - | E_make_empty_set _ -> ( - ok init' - ) | E_literal _ -> ok init' | E_constant (c) -> ( let%bind res = bind_fold_list self init' c.arguments in @@ -95,9 +91,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> match e'.content with | E_variable _ | E_literal _ | E_skip | E_make_none _ | E_make_empty_map _ - | E_make_empty_big_map _ - | E_make_empty_list _ - | E_make_empty_set _ as em -> return em + | E_make_empty_big_map _ as em -> return em | E_constant (c) -> ( let%bind lst = bind_map_list self c.arguments in return @@ E_constant {cons_name = c.cons_name; arguments = lst} diff --git a/src/passes/11-self_mini_c/self_mini_c.ml b/src/passes/11-self_mini_c/self_mini_c.ml index 66a0a06b8..56ee521df 100644 --- a/src/passes/11-self_mini_c/self_mini_c.ml +++ b/src/passes/11-self_mini_c/self_mini_c.ml @@ -49,8 +49,6 @@ let rec is_pure : expression -> bool = fun e -> | E_variable _ | E_make_empty_map _ | E_make_empty_big_map _ - | E_make_empty_list _ - | E_make_empty_set _ | E_make_none _ -> true diff --git a/src/passes/11-self_mini_c/subst.ml b/src/passes/11-self_mini_c/subst.ml index c2103c9f5..1914cbe2c 100644 --- a/src/passes/11-self_mini_c/subst.ml +++ b/src/passes/11-self_mini_c/subst.ml @@ -42,8 +42,6 @@ let rec replace : expression -> var_name -> var_name -> expression = return @@ E_variable z | E_make_empty_map _ -> e | E_make_empty_big_map _ -> e - | E_make_empty_list _ -> e - | E_make_empty_set _ -> e | E_make_none _ -> e | E_iterator (name, ((v, tv), body), expr) -> let body = replace body in @@ -176,9 +174,7 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e (* All that follows is boilerplate *) | E_literal _ | E_skip | E_make_none _ | E_make_empty_map (_,_) - | E_make_empty_big_map _ - | E_make_empty_list _ - | E_make_empty_set _ as em -> return em + | E_make_empty_big_map _ as em -> return em | E_constant (c) -> ( let lst = List.map self c.arguments in return @@ E_constant {cons_name = c.cons_name; arguments = lst } diff --git a/src/passes/12-compiler/compiler_program.ml b/src/passes/12-compiler/compiler_program.ml index 9a2001298..2ebfcbc34 100644 --- a/src/passes/12-compiler/compiler_program.ml +++ b/src/passes/12-compiler/compiler_program.ml @@ -66,10 +66,15 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r let%bind m_ty = Compiler_type.type_ ty in ok @@ simple_unary @@ prim ~children:[m_ty] I_RIGHT ) + | C_LIST_EMPTY -> ( + let%bind ty' = Mini_c.get_t_list ty in + let%bind m_ty = Compiler_type.type_ ty' in + ok @@ simple_constant @@ i_nil m_ty + ) | C_SET_EMPTY -> ( let%bind ty' = Mini_c.get_t_set ty in let%bind m_ty = Compiler_type.type_ ty' in - ok @@ simple_constant @@ prim ~children:[m_ty] I_EMPTY_SET + ok @@ simple_constant @@ i_empty_set m_ty ) | C_BYTES_UNPACK -> ( let%bind ty' = Mini_c.get_t_option ty in @@ -303,12 +308,6 @@ and translate_expression (expr:expression) (env:environment) : michelson result | E_make_empty_big_map sd -> let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in return @@ i_empty_big_map src dst - | E_make_empty_list t -> - let%bind t' = Compiler_type.type_ t in - return @@ i_nil t' - | E_make_empty_set t -> - let%bind t' = Compiler_type.type_ t in - return @@ i_empty_set t' | E_make_none o -> let%bind o' = Compiler_type.type_ o in return @@ i_none o' diff --git a/src/passes/6-sugar_to_core/sugar_to_core.ml b/src/passes/6-sugar_to_core/sugar_to_core.ml index e7a3f20fc..6c664a45b 100644 --- a/src/passes/6-sugar_to_core/sugar_to_core.ml +++ b/src/passes/6-sugar_to_core/sugar_to_core.ml @@ -121,11 +121,19 @@ let rec compile_expression : I.expression -> O.expression result = in return @@ O.E_big_map big_map | I.E_list lst -> - let%bind lst = bind_map_list compile_expression lst in - return @@ O.E_list lst - | I.E_set set -> - let%bind set = bind_map_list compile_expression set in - return @@ O.E_set set + let%bind lst' = bind_map_list (compile_expression) lst in + let aux = fun prev cur -> + return @@ E_constant {cons_name=C_CONS;arguments=[cur ; prev]} in + let%bind init = return @@ E_constant {cons_name=C_LIST_EMPTY;arguments=[]} in + bind_fold_right_list aux init lst' + | I.E_set set -> ( + let%bind lst' = bind_map_list (compile_expression) set in + let lst' = List.sort_uniq compare lst' in + let aux = fun prev cur -> + return @@ E_constant {cons_name=C_SET_ADD;arguments=[cur ; prev]} in + let%bind init = return @@ E_constant {cons_name=C_SET_EMPTY;arguments=[]} in + bind_fold_list aux init lst' + ) | I.E_look_up look_up -> let%bind (path, index) = bind_map_pair compile_expression look_up in return @@ O.E_constant {cons_name=C_MAP_FIND_OPT;arguments=[index;path]} @@ -313,15 +321,6 @@ let rec uncompile_expression : O.expression -> I.expression result = ) big_map in return @@ I.E_big_map big_map - | O.E_list lst -> - let%bind lst = bind_map_list uncompile_expression lst in - return @@ I.E_list lst - | O.E_set set -> - let%bind set = bind_map_list uncompile_expression set in - return @@ I.E_set set - | O.E_look_up look_up -> - let%bind look_up = bind_map_pair uncompile_expression look_up in - return @@ I.E_look_up look_up | O.E_ascription {anno_expr; type_annotation} -> let%bind anno_expr = uncompile_expression anno_expr in let%bind type_annotation = uncompile_type_expression type_annotation in diff --git a/src/passes/8-typer-new/typer.ml b/src/passes/8-typer-new/typer.ml index 94a1682bd..754659597 100644 --- a/src/passes/8-typer-new/typer.ml +++ b/src/passes/8-typer-new/typer.ml @@ -578,17 +578,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression - return (E_map lst') tv *) - | E_list lst -> - let%bind (state', lst') = - bind_fold_map_list (fun state' elt -> type_expression e state' elt >>? swap) state lst in - let wrapped = Wrap.list (List.map (fun x -> O.(x.type_expression)) lst') in - return_wrapped (E_list lst') state' wrapped - | E_set set -> - let aux = fun state' elt -> type_expression e state' elt >>? swap in - let%bind (state', set') = - bind_fold_map_list aux state set in - let wrapped = Wrap.set (List.map (fun x -> O.(x.type_expression)) set') in - return_wrapped (E_set set') state' wrapped | E_map map -> let aux' state' elt = type_expression e state' elt >>? swap in let aux = fun state' elt -> bind_fold_map_pair aux' state' elt in @@ -1059,12 +1048,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result = | E_big_map m -> let%bind m' = bind_map_list (bind_map_pair untype_expression) m in return (e_big_map m') - | E_list lst -> - let%bind lst' = bind_map_list untype_expression lst in - return (e_list lst') - | E_set lst -> - let%bind lst' = bind_map_list untype_expression lst in - return (e_set lst') | E_matching {matchee;cases} -> let%bind ae' = untype_expression matchee in let%bind m' = untype_matching untype_expression cases in diff --git a/src/passes/8-typer-old/typer.ml b/src/passes/8-typer-old/typer.ml index 2b6764dea..879c44b19 100644 --- a/src/passes/8-typer-old/typer.ml +++ b/src/passes/8-typer-old/typer.ml @@ -511,48 +511,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression let%bind () = O.assert_type_expression_eq (tv, get_type_expression update) in return (E_record_update {record; path; update}) wrapped (* Data-structure *) - | E_list lst -> - let%bind lst' = bind_map_list (type_expression' e) lst in - let%bind tv = - let aux opt c = - match opt with - | None -> ok (Some c) - | Some c' -> - let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in - ok (Some c') in - let%bind init = match tv_opt with - | None -> ok None - | Some ty -> - let%bind ty' = get_t_list ty in - ok (Some ty') in - let%bind ty = - let%bind opt = bind_fold_list aux init - @@ List.map get_type_expression lst' in - trace_option (needs_annotation ae "empty list") opt in - ok (t_list ty ()) - in - return (E_list lst') tv - | E_set lst -> - let%bind lst' = bind_map_list (type_expression' e) lst in - let%bind tv = - let aux opt c = - match opt with - | None -> ok (Some c) - | Some c' -> - let%bind _eq = Ast_typed.assert_type_expression_eq (c, c') in - ok (Some c') in - let%bind init = match tv_opt with - | None -> ok None - | Some ty -> - let%bind ty' = get_t_set ty in - ok (Some ty') in - let%bind ty = - let%bind opt = bind_fold_list aux init - @@ List.map get_type_expression lst' in - trace_option (needs_annotation ae "empty set") opt in - ok (t_set ty ()) - in - return (E_set lst') tv | E_map lst -> let%bind lst' = bind_map_list (bind_map_pair (type_expression' e)) lst in let%bind tv = @@ -682,6 +640,21 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression let%bind (name', tv) = type_constant cons_name tv_lst tv_opt in return (E_constant {cons_name=name';arguments=lst'}) tv + | E_constant {cons_name=C_SET_ADD|C_CONS as cst;arguments=[key;set]} -> + let%bind key' = type_expression' e key in + let tv_key = get_type_expression key' in + let tv = match tv_opt with + Some (tv) -> tv + | None -> match cst with + C_SET_ADD -> t_set tv_key () + | C_CONS -> t_list tv_key () + | _ -> failwith "impossible" + in + let%bind set' = type_expression' e ~tv_opt:tv set in + let tv_set = get_type_expression set' in + let tv_lst = [tv_key;tv_set] in + let%bind (name', tv) = type_constant cst tv_lst tv_opt in + return (E_constant {cons_name=name';arguments=[key';set']}) tv | E_constant {cons_name;arguments} -> let%bind lst' = bind_list @@ List.map (type_expression' e) arguments in let tv_lst = List.map get_type_expression lst' in @@ -871,12 +844,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result = | E_big_map m -> let%bind m' = bind_map_list (bind_map_pair untype_expression) m in return (e_big_map m') - | E_list lst -> - let%bind lst' = bind_map_list untype_expression lst in - return (e_list lst') - | E_set lst -> - let%bind lst' = bind_map_list untype_expression lst in - return (e_set lst') | E_matching {matchee;cases} -> let%bind ae' = untype_expression matchee in let%bind m' = untype_matching untype_expression cases in diff --git a/src/passes/9-self_ast_typed/helpers.ml b/src/passes/9-self_ast_typed/helpers.ml index 658a05f31..76d6c0f21 100644 --- a/src/passes/9-self_ast_typed/helpers.ml +++ b/src/passes/9-self_ast_typed/helpers.ml @@ -8,7 +8,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini let%bind init' = f init e in match e.expression_content with | E_literal _ | E_variable _ -> ok init' - | E_list lst | E_set lst | E_constant {arguments=lst} -> ( + | E_constant {arguments=lst} -> ( let%bind res = bind_fold_list self init' lst in ok res ) @@ -90,14 +90,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> let%bind e' = f e in let return expression_content = ok { e' with expression_content } in match e'.expression_content with - | E_list lst -> ( - let%bind lst' = bind_map_list self lst in - return @@ E_list lst' - ) - | E_set lst -> ( - let%bind lst' = bind_map_list self lst in - return @@ E_set lst' - ) | E_map lst -> ( let%bind lst' = bind_map_list (bind_map_pair self) lst in return @@ E_map lst' @@ -201,14 +193,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres else let return expression_content = { e' with expression_content } in match e'.expression_content with - | E_list lst -> ( - let%bind (res, lst') = bind_fold_map_list self init' lst in - ok (res, return @@ E_list lst') - ) - | E_set lst -> ( - let%bind (res, lst') = bind_fold_map_list self init' lst in - ok (res, return @@ E_set lst') - ) | E_map lst -> ( let%bind (res, lst') = bind_fold_map_list (bind_fold_map_pair self) init' lst in ok (res, return @@ E_map lst') diff --git a/src/passes/9-self_ast_typed/tail_recursion.ml b/src/passes/9-self_ast_typed/tail_recursion.ml index c95f10c06..f5f30e923 100644 --- a/src/passes/9-self_ast_typed/tail_recursion.ml +++ b/src/passes/9-self_ast_typed/tail_recursion.ml @@ -64,9 +64,6 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit in let%bind _ = bind_map_list aux eel in ok () - | E_list el | E_set el -> - let%bind _ = bind_map_list (check_recursive_call n false) el in - ok () and check_recursive_call_in_matching = fun n final_path c -> match c with diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 472b67506..8e011b316 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -949,6 +949,11 @@ module Typer = struct then ok (t_unit ()) else fail @@ Operator_errors.type_error "bad set iter" key arg () + let list_empty = typer_0 "LIST_EMPTY" @@ fun tv_opt -> + match tv_opt with + | None -> simple_fail "untyped LIST_EMPTY" + | Some t -> ok t + let list_iter = typer_2 "LIST_ITER" @@ fun body lst -> let%bind (arg , res) = get_t_function body in let%bind () = Assert.assert_true (eq_1 res (t_unit ())) in @@ -1145,7 +1150,6 @@ module Typer = struct | C_SLICE -> ok @@ slice ; | C_BYTES_PACK -> ok @@ bytes_pack ; | C_BYTES_UNPACK -> ok @@ bytes_unpack ; - | C_CONS -> ok @@ cons ; (* SET *) | C_SET_EMPTY -> ok @@ set_empty ; | C_SET_ADD -> ok @@ set_add ; @@ -1155,6 +1159,8 @@ module Typer = struct | C_SET_MEM -> ok @@ set_mem ; (* LIST *) + | C_CONS -> ok @@ cons ; + | C_LIST_EMPTY -> ok @@ list_empty ; | C_LIST_ITER -> ok @@ list_iter ; | C_LIST_MAP -> ok @@ list_map ; | C_LIST_FOLD -> ok @@ list_fold ; diff --git a/src/stages/1-ast_imperative/combinators.ml b/src/stages/1-ast_imperative/combinators.ml index bc66d4ac0..e49f811b3 100644 --- a/src/stages/1-ast_imperative/combinators.ml +++ b/src/stages/1-ast_imperative/combinators.ml @@ -168,8 +168,9 @@ let e_typed_none ?loc t_opt = let type_annotation = t_option t_opt in e_annotation ?loc (e_none ?loc ()) type_annotation -let e_typed_list ?loc lst t = - e_annotation ?loc (e_list lst) (t_list t) +let e_typed_list ?loc lst t = e_annotation ?loc (e_list lst) (t_list t) +let e_typed_list_literal ?loc lst t = + e_annotation ?loc (e_constant C_LIST_LITERAL lst) (t_list t) let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v) diff --git a/src/stages/1-ast_imperative/combinators.mli b/src/stages/1-ast_imperative/combinators.mli index 1cf5986c9..3d0ae94b9 100644 --- a/src/stages/1-ast_imperative/combinators.mli +++ b/src/stages/1-ast_imperative/combinators.mli @@ -100,6 +100,7 @@ val make_option_typed : ?loc:Location.t -> expression -> type_expression option val e_typed_none : ?loc:Location.t -> type_expression -> expression val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression +val e_typed_list_literal : ?loc:Location.t -> expression list -> type_expression -> expression val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression diff --git a/src/stages/3-ast_core/PP.ml b/src/stages/3-ast_core/PP.ml index 9673beef7..149a92631 100644 --- a/src/stages/3-ast_core/PP.ml +++ b/src/stages/3-ast_core/PP.ml @@ -35,10 +35,6 @@ and expression_content ppf (ec : expression_content) = fprintf ppf "map[%a]" (list_sep_d assoc_expression) m | E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m - | E_list lst -> - fprintf ppf "list[%a]" (list_sep_d expression) lst - | E_set lst -> - fprintf ppf "set[%a]" (list_sep_d expression) lst | E_lambda {binder; input_type; output_type; result} -> fprintf ppf "lambda (%a:%a) : %a return %a" expression_variable binder diff --git a/src/stages/3-ast_core/combinators.ml b/src/stages/3-ast_core/combinators.ml index 91a77d217..a1fdd1242 100644 --- a/src/stages/3-ast_core/combinators.ml +++ b/src/stages/3-ast_core/combinators.ml @@ -113,8 +113,6 @@ let e_none ?loc () : expression = make_expr ?loc @@ E_constant {cons_name = C_NO let e_string_cat ?loc sl sr : expression = make_expr ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]} let e_map_add ?loc k v old : expression = make_expr ?loc @@ E_constant {cons_name = C_MAP_ADD; arguments = [k ; v ; old]} let e_map ?loc lst : expression = make_expr ?loc @@ E_map lst -let e_set ?loc lst : expression = make_expr ?loc @@ E_set lst -let e_list ?loc lst : expression = make_expr ?loc @@ E_list lst let e_constructor ?loc s a : expression = make_expr ?loc @@ E_constructor { constructor = Constructor s; element = a} let e_matching ?loc a b : expression = make_expr ?loc @@ E_matching {matchee=a;cases=b} let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c}) @@ -160,14 +158,9 @@ let e_typed_none ?loc t_opt = let type_annotation = t_option t_opt in e_annotation ?loc (e_none ?loc ()) type_annotation -let e_typed_list ?loc lst t = - e_annotation ?loc (e_list lst) (t_list t) - let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) let e_typed_big_map ?loc lst k v = e_annotation ?loc (e_big_map lst) (t_big_map k v) -let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) - let e_lambda ?loc (binder : expression_variable) (input_type : type_expression option) @@ -220,9 +213,16 @@ let get_e_pair = fun t -> | _ -> simple_fail "not a pair" let get_e_list = fun t -> - match t with - | E_list lst -> ok lst - | _ -> simple_fail "not a list" + let rec aux t = + match t with + E_constant {cons_name=C_CONS;arguments=[key;lst]} -> + let%bind lst = aux lst.expression_content in + ok @@ key::(lst) + | E_constant {cons_name=C_LIST_EMPTY;arguments=[]} -> + ok @@ [] + | _ -> simple_fail "not a list" + in + aux t let tuple_of_record (m: _ LMap.t) = let aux i = @@ -249,11 +249,6 @@ let extract_pair : expression -> (expression * expression) result = fun e -> ) | _ -> fail @@ bad_kind "pair" e.location -let extract_list : expression -> (expression list) result = fun e -> - match e.expression_content with - | E_list lst -> ok lst - | _ -> fail @@ bad_kind "list" e.location - let extract_record : expression -> (label * expression) list result = fun e -> match e.expression_content with | E_record lst -> ok @@ LMap.to_kv_list lst diff --git a/src/stages/3-ast_core/combinators.mli b/src/stages/3-ast_core/combinators.mli index a16a36600..dfb78bf43 100644 --- a/src/stages/3-ast_core/combinators.mli +++ b/src/stages/3-ast_core/combinators.mli @@ -74,8 +74,6 @@ val e_none : ?loc:Location.t -> unit -> expression val e_string_cat : ?loc:Location.t -> expression -> expression -> expression val e_map_add : ?loc:Location.t -> expression -> expression -> expression -> expression val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression -val e_set : ?loc:Location.t -> expression list -> expression -val e_list : ?loc:Location.t -> expression list -> expression val e_pair : ?loc:Location.t -> expression -> expression -> expression val e_constructor : ?loc:Location.t -> string -> expression -> expression val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression @@ -96,13 +94,9 @@ val make_option_typed : ?loc:Location.t -> expression -> type_expression option val e_typed_none : ?loc:Location.t -> type_expression -> expression -val e_typed_list : ?loc:Location.t -> expression list -> type_expression -> expression - val e_typed_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression val e_typed_big_map : ?loc:Location.t -> ( expression * expression ) list -> type_expression -> type_expression -> expression -val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expression - val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression val e_record : ?loc:Location.t -> expr Map.String.t -> expression @@ -125,8 +119,6 @@ val is_e_failwith : expression -> bool *) val extract_pair : expression -> ( expression * expression ) result -val extract_list : expression -> (expression list) result - val extract_record : expression -> (label * expression) list result val extract_map : expression -> (expression * expression) list result diff --git a/src/stages/3-ast_core/misc.ml b/src/stages/3-ast_core/misc.ml index 96a9f3750..fc5319eed 100644 --- a/src/stages/3-ast_core/misc.ml +++ b/src/stages/3-ast_core/misc.ml @@ -88,6 +88,19 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = assert_literal_eq (a, b) | E_literal _ , _ -> simple_fail "comparing a literal with not a literal" + | E_constant {cons_name=C_SET_LITERAL;arguments=lsta}, + E_constant {cons_name=C_SET_LITERAL;arguments=lstb} -> ( + let lsta' = List.sort (compare) lsta in + let lstb' = List.sort (compare) lstb in + let%bind lst = + generic_try (simple_error "set of different lengths") + (fun () -> List.combine lsta' lstb') in + let%bind _all = bind_map_list assert_value_eq lst in + ok () + ) + | E_constant {cons_name=C_SET_LITERAL;_}, _ -> + simple_fail "comparing set with other expression" + | E_constant (ca) , E_constant (cb) when ca.cons_name = cb.cons_name -> ( let%bind lst = generic_try (simple_error "constants with different number of elements") @@ -156,28 +169,6 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result = | (E_map _ | E_big_map _), _ -> simple_fail "comparing map with other expression" - | E_list lsta, E_list lstb -> ( - let%bind lst = - generic_try (simple_error "list of different lengths") - (fun () -> List.combine lsta lstb) in - let%bind _all = bind_map_list assert_value_eq lst in - ok () - ) - | E_list _, _ -> - simple_fail "comparing list with other expression" - - | E_set lsta, E_set lstb -> ( - let lsta' = List.sort (compare) lsta in - let lstb' = List.sort (compare) lstb in - let%bind lst = - generic_try (simple_error "set of different lengths") - (fun () -> List.combine lsta' lstb') in - let%bind _all = bind_map_list assert_value_eq lst in - ok () - ) - | E_set _, _ -> - simple_fail "comparing set with other expression" - | (E_ascription a , _b') -> assert_value_eq (a.anno_expr , b) | (_a' , E_ascription b) -> assert_value_eq (a , b.anno_expr) | (E_variable _, _) | (E_lambda _, _) diff --git a/src/stages/3-ast_core/types.ml b/src/stages/3-ast_core/types.ml index 4ad14d148..ae3bb2283 100644 --- a/src/stages/3-ast_core/types.ml +++ b/src/stages/3-ast_core/types.ml @@ -47,8 +47,6 @@ and expression_content = (* TODO : move to constant*) | E_map of (expression * expression) list (*move to operator *) | E_big_map of (expression * expression) list (*move to operator *) - | E_list of expression list - | E_set of expression list (* Advanced *) | E_ascription of ascription diff --git a/src/stages/4-ast_typed/PP.ml b/src/stages/4-ast_typed/PP.ml index 3fe4f02c8..62e085c51 100644 --- a/src/stages/4-ast_typed/PP.ml +++ b/src/stages/4-ast_typed/PP.ml @@ -36,10 +36,6 @@ and expression_content ppf (ec: expression_content) = fprintf ppf "map[%a]" (list_sep_d assoc_expression) m | E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m - | E_list lst -> - fprintf ppf "list[%a]" (list_sep_d expression) lst - | E_set lst -> - fprintf ppf "set[%a]" (list_sep_d expression) lst | E_lambda {binder; result} -> fprintf ppf "lambda (%a) return %a" expression_variable binder expression result diff --git a/src/stages/4-ast_typed/combinators.ml b/src/stages/4-ast_typed/combinators.ml index 5abb2a2bc..9a8bf2af5 100644 --- a/src/stages/4-ast_typed/combinators.ml +++ b/src/stages/4-ast_typed/combinators.ml @@ -296,7 +296,6 @@ let e_lambda l : expression_content = E_lambda l let e_pair a b : expression_content = ez_e_record [(Label "0",a);(Label "1", b)] let e_application lamb args : expression_content = E_application {lamb;args} let e_variable v : expression_content = E_variable v -let e_list lst : expression_content = E_list lst let e_let_in let_binder inline rhs let_result = E_let_in { let_binder ; rhs ; let_result; inline } let e_a_unit = make_a_e (e_unit ()) (t_unit ()) @@ -315,7 +314,6 @@ let e_a_application a b = make_a_e (e_application a b) (get_type_expression b) let e_a_variable v ty = make_a_e (e_variable v) ty let ez_e_a_record r = make_a_e (ez_e_record r) (ez_t_record (List.map (fun (x, y) -> x, y.type_expression) r) ()) let e_a_map lst k v = make_a_e (e_map lst) (t_map k v ()) -let e_a_list lst t = make_a_e (e_list lst) (t_list t ()) let e_a_let_in binder expr body attributes = make_a_e (e_let_in binder expr body attributes) (get_type_expression body) diff --git a/src/stages/4-ast_typed/combinators.mli b/src/stages/4-ast_typed/combinators.mli index a42abd3cc..9bbd75504 100644 --- a/src/stages/4-ast_typed/combinators.mli +++ b/src/stages/4-ast_typed/combinators.mli @@ -128,7 +128,6 @@ val e_lambda : lambda -> expression_content val e_pair : expression -> expression -> expression_content val e_application : expression -> expr -> expression_content val e_variable : expression_variable -> expression_content -val e_list : expression list -> expression_content val e_let_in : expression_variable -> inline -> expression -> expression -> expression_content val e_a_unit : full_environment -> expression @@ -147,7 +146,6 @@ val e_a_application : expression -> expression -> full_environment -> expression val e_a_variable : expression_variable -> type_expression -> full_environment -> expression val ez_e_a_record : ( label * expression ) list -> full_environment -> expression val e_a_map : ( expression * expression ) list -> type_expression -> type_expression -> full_environment -> expression -val e_a_list : expression list -> type_expression -> full_environment -> expression val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression val get_a_int : expression -> int result diff --git a/src/stages/4-ast_typed/combinators_environment.ml b/src/stages/4-ast_typed/combinators_environment.ml index f92ef3aea..e296ae914 100644 --- a/src/stages/4-ast_typed/combinators_environment.ml +++ b/src/stages/4-ast_typed/combinators_environment.ml @@ -15,7 +15,6 @@ let e_a_empty_some s = e_a_some s Environment.full_empty let e_a_empty_none t = e_a_none t Environment.full_empty let e_a_empty_record r = e_a_record r Environment.full_empty let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty -let e_a_empty_list lst t = e_a_list lst t Environment.full_empty let ez_e_a_empty_record r = ez_e_a_record r Environment.full_empty let e_a_empty_lambda l i o = e_a_lambda l i o Environment.full_empty diff --git a/src/stages/4-ast_typed/combinators_environment.mli b/src/stages/4-ast_typed/combinators_environment.mli index da4b2cfb9..ceb438afe 100644 --- a/src/stages/4-ast_typed/combinators_environment.mli +++ b/src/stages/4-ast_typed/combinators_environment.mli @@ -14,7 +14,6 @@ val e_a_empty_some : expression -> expression val e_a_empty_none : type_expression -> expression val e_a_empty_record : expression label_map -> expression val e_a_empty_map : (expression * expression ) list -> type_expression -> type_expression -> expression -val e_a_empty_list : expression list -> type_expression -> expression val ez_e_a_empty_record : ( label * expression ) list -> expression val e_a_empty_lambda : lambda -> type_expression -> type_expression -> expression diff --git a/src/stages/4-ast_typed/misc.ml b/src/stages/4-ast_typed/misc.ml index 5def088a8..6966fe414 100644 --- a/src/stages/4-ast_typed/misc.ml +++ b/src/stages/4-ast_typed/misc.ml @@ -211,8 +211,6 @@ module Free_variables = struct | E_record m -> unions @@ List.map self @@ LMap.to_list m | E_record_accessor {record;_} -> self record | E_record_update {record; update;_} -> union (self record) @@ self update - | E_list lst -> unions @@ List.map self lst - | E_set lst -> unions @@ List.map self lst | (E_map m | E_big_map m) -> unions @@ List.map self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m | E_matching {matchee; cases;_} -> union (self matchee) (matching_expression b cases) | E_let_in { let_binder; rhs; let_result; _} -> @@ -512,24 +510,6 @@ let rec assert_value_eq (a, b: (expression*expression)) : unit result = | (E_map _ | E_big_map _), _ -> fail @@ different_values_because_different_types "map vs. non-map" a b - | E_list lsta, E_list lstb -> ( - let%bind lst = - generic_try (different_size_values "lists of different lengths" a b) - (fun () -> List.combine lsta lstb) in - let%bind _all = bind_map_list assert_value_eq lst in - ok () - ) - | E_list _, _ -> - fail @@ different_values_because_different_types "list vs. non-list" a b - | E_set lsta, E_set lstb -> ( - let%bind lst = - generic_try (different_size_values "sets of different lengths" a b) - (fun () -> List.combine lsta lstb) in - let%bind _all = bind_map_list assert_value_eq lst in - ok () - ) - | E_set _, _ -> - fail @@ different_values_because_different_types "set vs. non-set" a b | (E_literal _, _) | (E_variable _, _) | (E_application _, _) | (E_lambda _, _) | (E_let_in _, _) | (E_recursive _, _) | (E_record_accessor _, _) | (E_record_update _,_) diff --git a/src/stages/4-ast_typed/misc_smart.ml b/src/stages/4-ast_typed/misc_smart.ml index 763bfa399..fa34a5014 100644 --- a/src/stages/4-ast_typed/misc_smart.ml +++ b/src/stages/4-ast_typed/misc_smart.ml @@ -75,12 +75,6 @@ module Captured_variables = struct let%bind r = self record in let%bind e = self update in ok @@ union r e - | E_list lst -> - let%bind lst' = bind_map_list self lst in - ok @@ unions lst' - | E_set lst -> - let%bind lst' = bind_map_list self lst in - ok @@ unions lst' | (E_map m | E_big_map m) -> let%bind lst' = bind_map_list self @@ List.concat @@ List.map (fun (a, b) -> [ a ; b ]) m in ok @@ unions lst' diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/4-ast_typed/types.ml index fa303e21c..b892d499f 100644 --- a/src/stages/4-ast_typed/types.ml +++ b/src/stages/4-ast_typed/types.ml @@ -53,8 +53,6 @@ and expression_content = (* TODO : move to constant*) | E_map of (expression * expression) list (*move to operator *) | E_big_map of (expression * expression) list (*move to operator *) - | E_list of expression list - | E_set of expression list and constant = { cons_name: constant' diff --git a/src/stages/5-mini_c/PP.ml b/src/stages/5-mini_c/PP.ml index dfbbfdd64..8f0316253 100644 --- a/src/stages/5-mini_c/PP.ml +++ b/src/stages/5-mini_c/PP.ml @@ -88,8 +88,6 @@ and expression' ppf (e:expression') = match e with | E_literal v -> fprintf ppf "L(%a)" value v | E_make_empty_map _ -> fprintf ppf "map[]" | E_make_empty_big_map _ -> fprintf ppf "big_map[]" - | E_make_empty_list _ -> fprintf ppf "list[]" - | E_make_empty_set _ -> fprintf ppf "set[]" | E_make_none _ -> fprintf ppf "none" | E_if_bool (c, a, b) -> fprintf ppf "%a ? %a : %a" expression c expression a expression b | E_if_none (c, n, ((name, _) , s)) -> fprintf ppf "%a ?? %a : %a -> %a" expression c expression n Var.pp name expression s @@ -199,6 +197,8 @@ and constant ppf : constant' -> unit = function | C_SET_FOLD -> fprintf ppf "SET_FOLD" | C_SET_MEM -> fprintf ppf "SET_MEM" (* List *) + | C_LIST_EMPTY -> fprintf ppf "LIST_EMPTY" + | C_LIST_LITERAL -> fprintf ppf "LIST_LITERAL" | C_LIST_ITER -> fprintf ppf "LIST_ITER" | C_LIST_MAP -> fprintf ppf "LIST_MAP" | C_LIST_FOLD -> fprintf ppf "LIST_FOLD" diff --git a/src/stages/5-mini_c/misc.ml b/src/stages/5-mini_c/misc.ml index 31c816178..bbcee5ed1 100644 --- a/src/stages/5-mini_c/misc.ml +++ b/src/stages/5-mini_c/misc.ml @@ -46,8 +46,6 @@ module Free_variables = struct | E_variable n -> var_name b n | E_make_empty_map _ -> empty | E_make_empty_big_map _ -> empty - | E_make_empty_list _ -> empty - | E_make_empty_set _ -> empty | E_make_none _ -> empty | E_iterator (_, ((v, _), body), expr) -> unions [ expression (union (singleton v) b) body ; diff --git a/src/stages/5-mini_c/types.ml b/src/stages/5-mini_c/types.ml index b1e419b8b..f16054a25 100644 --- a/src/stages/5-mini_c/types.ml +++ b/src/stages/5-mini_c/types.ml @@ -61,8 +61,6 @@ and expression' = | E_variable of var_name | E_make_empty_map of (type_value * type_value) | E_make_empty_big_map of (type_value * type_value) - | E_make_empty_list of type_value - | E_make_empty_set of type_value | E_make_none of type_value | E_iterator of constant' * ((var_name * type_value) * expression) * expression | E_fold of (((var_name * type_value) * expression) * expression * expression) diff --git a/src/stages/common/PP.ml b/src/stages/common/PP.ml index c3557f3d5..f8d594a89 100644 --- a/src/stages/common/PP.ml +++ b/src/stages/common/PP.ml @@ -105,6 +105,8 @@ let constant ppf : constant' -> unit = function | C_SET_FOLD -> fprintf ppf "SET_FOLD" | C_SET_MEM -> fprintf ppf "SET_MEM" (* List *) + | C_LIST_EMPTY -> fprintf ppf "LIST_EMPTY" + | C_LIST_LITERAL -> fprintf ppf "LIST_LITERAL" | C_LIST_ITER -> fprintf ppf "LIST_ITER" | C_LIST_MAP -> fprintf ppf "LIST_MAP" | C_LIST_FOLD -> fprintf ppf "LIST_FOLD" diff --git a/src/stages/common/types.ml b/src/stages/common/types.ml index 20964d3b6..6ffdb5485 100644 --- a/src/stages/common/types.ml +++ b/src/stages/common/types.ml @@ -247,6 +247,8 @@ and constant' = | C_SET_FOLD | C_SET_MEM (* List *) + | C_LIST_EMPTY + | C_LIST_LITERAL | C_LIST_ITER | C_LIST_MAP | C_LIST_FOLD diff --git a/src/stages/typesystem/misc.ml b/src/stages/typesystem/misc.ml index c74e9e8f1..ce7937c7e 100644 --- a/src/stages/typesystem/misc.ml +++ b/src/stages/typesystem/misc.ml @@ -204,12 +204,6 @@ module Substitution = struct ok @@ (val1 , val2) ) val_val_list in ok @@ T.E_big_map val_val_list - | T.E_list vals -> - let%bind vals = bind_map_list (s_expression ~substs) vals in - ok @@ T.E_list vals - | T.E_set vals -> - let%bind vals = bind_map_list (s_expression ~substs) vals in - ok @@ T.E_set vals | T.E_matching {matchee;cases} -> let%bind matchee = s_expression ~substs matchee in let%bind cases = s_matching_expr ~substs cases in