From 2b5b23f266acd74c7b9bb960816a62bdb31e869e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Sun, 29 Sep 2019 18:25:02 -0400 Subject: [PATCH] WIP: fixing the build errors + missing non-merged code --- scripts/install_build_environment.sh | 2 +- scripts/setup_repos.sh | 2 +- src/passes/4-typer/solver.ml | 8 ++++---- src/passes/4-typer/typer.ml | 8 ++++---- vendors/ligo-utils/simple-utils/trace.ml | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/scripts/install_build_environment.sh b/scripts/install_build_environment.sh index 958f855b1..2c26191e1 100755 --- a/scripts/install_build_environment.sh +++ b/scripts/install_build_environment.sh @@ -64,4 +64,4 @@ else fi fi -opam init -a --bare +opam init -a --bare --disable-sandboxing diff --git a/scripts/setup_repos.sh b/scripts/setup_repos.sh index e14c81707..411f4bc8d 100755 --- a/scripts/setup_repos.sh +++ b/scripts/setup_repos.sh @@ -5,7 +5,7 @@ set -x eval $(opam config env) # Remove the nomadic-labs tezos repo (from ligo switch only) -opam repository remove tezos-opam-repository +opam repository remove tezos-opam-repository || true # Add ligolang tezos repo opam repository add ligolang-tezos-opam-repository https://gitlab.com/ligolang/tezos-opam-repository.git diff --git a/src/passes/4-typer/solver.ml b/src/passes/4-typer/solver.ml index 32138b726..941104001 100644 --- a/src/passes/4-typer/solver.ml +++ b/src/passes/4-typer/solver.ml @@ -504,7 +504,7 @@ let check_applied ((reduced, _new_constraints) as x) = let rec normalizer_simpl : (type_constraint , type_constraint_simpl) normalizer = fun dbs new_constraint -> - let insert_fresh a b = + let insert_fresh a b = let fresh = Core.fresh_type_variable () in let (dbs , cs1) = normalizer_simpl dbs (C_equation (P_variable fresh, a)) in let (dbs , cs2) = normalizer_simpl dbs (C_equation (P_variable fresh, b)) in @@ -512,19 +512,19 @@ let rec normalizer_simpl : (type_constraint , type_constraint_simpl) normalizer let split_constant a c_tag args = let fresh_vars = List.map (fun _ -> Core.fresh_type_variable ()) args in let fresh_eqns = List.map (fun (v,t) -> C_equation (P_variable v, t)) (List.combine fresh_vars args) in - let (dbs , recur) = List.fold_map normalizer_simpl dbs fresh_eqns in + let (dbs , recur) = List.fold_map_acc normalizer_simpl dbs fresh_eqns in (dbs , [SC_Constructor {tv=a;c_tag;tv_list=fresh_vars}] @ List.flatten recur) in let gather_forall a forall = (dbs , [SC_Poly { tv=a; forall }]) in let gather_alias a b = (dbs , [SC_Alias (a, b)]) in let reduce_type_app a b = let (reduced, new_constraints) = check_applied @@ type_level_eval b in - let (dbs , recur) = List.fold_map normalizer_simpl dbs new_constraints in + let (dbs , recur) = List.fold_map_acc normalizer_simpl dbs new_constraints in let (dbs , resimpl) = normalizer_simpl dbs (C_equation (a , reduced)) in (* Note: this calls recursively but cant't fall in the same case. *) (dbs , resimpl @ List.flatten recur) in let split_typeclass args tc = let fresh_vars = List.map (fun _ -> Core.fresh_type_variable ()) args in let fresh_eqns = List.map (fun (v,t) -> C_equation (P_variable v, t)) (List.combine fresh_vars args) in - let (dbs , recur) = List.fold_map normalizer_simpl dbs fresh_eqns in + let (dbs , recur) = List.fold_map_acc normalizer_simpl dbs fresh_eqns in (dbs, [SC_Typeclass { tc ; args = fresh_vars }] @ List.flatten recur) in match new_constraint with diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 8b2e710d3..3020d17b6 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -239,7 +239,7 @@ let rec type_program (p:I.program) : O.program result = (* Extract pairs of (name,type) in the declaration and add it to the environment *) -let rec type_declaration env state : I.declaration -> (environment * Solver.state * O.declaration option) result = function +and type_declaration env state : I.declaration -> (environment * Solver.state * O.declaration option) result = function | Declaration_type (type_name , type_expression) -> let%bind tv = evaluate_type env type_expression in let env' = Environment.add_type type_name tv env in @@ -256,7 +256,7 @@ let rec type_declaration env state : I.declaration -> (environment * Solver.stat ok (env', state' , Some (O.Declaration_constant ((make_n_e name ae') , (env , env')))) ) -and type_match : environment -> Solver.state -> O.type_expression -> 'i I.matching -> I.expression -> Location.t -> (O.value O.matching * Solver.state) result = +and type_match : environment -> Solver.state -> O.type_value -> 'i I.matching -> I.expression -> Location.t -> (O.value O.matching * Solver.state) result = fun e state t i ae loc -> match i with | Match_bool {match_true ; match_false} -> let%bind _ = @@ -284,7 +284,7 @@ and type_match : environment -> Solver.state -> O.type_expression -> 'i I.matchi let e' = Environment.add_ez_binder hd t_list e in let e' = Environment.add_ez_binder tl t e' in let%bind (b' , state'') = type_expression e' state' b in - ok (O.Match_list {match_nil ; match_cons = (hd, tl, b')} , state'') + ok (O.Match_list {match_nil ; match_cons = ((hd, t_list), (tl, t)), b'} , state'') | Match_tuple (lst, b) -> let%bind t_tuple = trace_strong (match_error ~expected:i ~actual:t loc) @@ -456,7 +456,7 @@ and type_expression : environment -> Solver.state -> I.expression -> (O.annotate | E_literal (Literal_timestamp t) -> ( return_wrapped (e_timestamp t) state @@ Wrap.literal (t_timestamp ()) ) -< | E_literal (Literal_operation o) -> ( + | E_literal (Literal_operation o) -> ( return_wrapped (e_operation o) state @@ Wrap.literal (t_operation ()) ) | E_literal (Literal_unit) -> ( diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 1ae5360dd..75cc3bf85 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -599,8 +599,8 @@ let bind_fold_map_list = fun f acc lst -> f acc hd >>? fun (acc' , hd') -> aux (acc' , hd' :: prev) f tl in - aux (acc , []) f lst >>? fun (_acc' , lst') -> - ok @@ List.rev lst' + aux (acc , []) f lst >>? fun (acc' , lst') -> + ok @@ (acc' , List.rev lst') let bind_fold_map_right_list = fun f acc lst -> let rec aux (acc , prev) f = function