From 8edada0f6c629a18d279648d2fb3f1e8a6c6e27a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Tue, 2 Apr 2019 18:36:11 +0200 Subject: [PATCH] Refactoring: remove make_ combinators in ast_typed and use optional argument instead --- src/ligo/README_INSTALL | 4 +- src/ligo/ast_typed.ml | 65 +++++++++++------------------- src/ligo/test/integration_tests.ml | 6 +-- src/ligo/test/typer_tests.ml | 20 ++++----- src/ligo/transpiler.ml | 4 +- src/ligo/typer.ml | 34 ++++++++-------- 6 files changed, 58 insertions(+), 75 deletions(-) diff --git a/src/ligo/README_INSTALL b/src/ligo/README_INSTALL index 3511d1e17..e5dbde280 100644 --- a/src/ligo/README_INSTALL +++ b/src/ligo/README_INSTALL @@ -8,7 +8,7 @@ eval $(opam env --switch=$switch --set-switch) opam repository add new-tezos https://gitlab.com/gabriel.alfour/new-tezos-opam-repository.git # si une build a déjà été tentée, il vaut mieux git add tout ce qui est utile et git clean -dfx pour supprimer tout le reste (dune 1.7 crée des fichiers non compatibles avec dune 1.6) -opam install -y ocplib-endian +opam install -y ocplib-endian alcotest (cd ligo-parser && opam install -y .) eval $(opam env) @@ -16,5 +16,5 @@ eval $(opam env) eval $(opam env) (opam install -y .) eval $(opam env) -opam install merlin ocp-indent +opam install merlin ocp-indent ledit opam user-setup install diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml index 52116c687..60ba361ff 100644 --- a/src/ligo/ast_typed.ml +++ b/src/ligo/ast_typed.ml @@ -410,50 +410,33 @@ let merge_annotation (a:type_value option) (b:type_value option) : type_value re | _, Some _ -> ok b module Combinators = struct - let t_bool s : type_value = type_value (T_constant ("bool", [])) s - let make_t_bool = t_bool None + let t_bool ?s () : type_value = type_value (T_constant ("bool", [])) s + let t_string ?s () : type_value = type_value (T_constant ("string", [])) s + let t_bytes ?s () : type_value = type_value (T_constant ("bytes", [])) s + let t_int ?s () : type_value = type_value (T_constant ("int", [])) s + let t_unit ?s () : type_value = type_value (T_constant ("unit", [])) s + let t_option o ?s () : type_value = type_value (T_constant ("option", [o])) s + let t_tuple lst ?s () : type_value = type_value (T_tuple lst) s + let t_pair a b ?s () = t_tuple [a ; b] ?s () - let t_string s : type_value = type_value (T_constant ("string", [])) s - let make_t_string = t_string None - - let t_bytes s : type_value = type_value (T_constant ("bytes", [])) s - let make_t_bytes = t_bytes None - - let t_int s : type_value = type_value (T_constant ("int", [])) s - let make_t_int = t_int None - - let t_unit s : type_value = type_value (T_constant ("unit", [])) s - let make_t_unit = t_unit None - - let t_option o s : type_value = type_value (T_constant ("option", [o])) s - let make_t_option o = t_option o None - - let t_tuple lst s : type_value = type_value (T_tuple lst) s - let make_t_tuple lst = t_tuple lst None - let make_t_pair a b = make_t_tuple [a ; b] - - let t_record m s : type_value = type_value (T_record m) s + let t_record m ?s () : type_value = type_value (T_record m) s let make_t_ez_record (lst:(string * type_value) list) : type_value = let aux prev (k, v) = SMap.add k v prev in let map = List.fold_left aux SMap.empty lst in type_value (T_record map) None - let make_t_record m = t_record m None - let make_t_record_ez lst = + let ez_t_record lst ?s () : type_value = let m = SMap.of_list lst in - make_t_record m + t_record m ?s () - let t_map key value s = type_value (T_constant ("map", [key ; value])) s - let make_t_map key value = t_map key value None + let t_map key value ?s () = type_value (T_constant ("map", [key ; value])) s - let t_sum m s : type_value = type_value (T_sum m) s - let make_t_sum m = t_sum m None + let t_sum m ?s () : type_value = type_value (T_sum m) s let make_t_ez_sum (lst:(string * type_value) list) : type_value = let aux prev (k, v) = SMap.add k v prev in let map = List.fold_left aux SMap.empty lst in type_value (T_sum map) None - let t_function param result s : type_value = type_value (T_function (param, result)) s - let make_t_function param result = t_function param result None + let t_function param result ?s () : type_value = type_value (T_function (param, result)) s let get_annotation (x:annotated_expression) = x.type_annotation @@ -501,16 +484,16 @@ module Combinators = struct let e_bool b : expression = E_literal (Literal_bool b) let e_pair a b : expression = E_constant ("PAIR", [a; b]) - let e_a_unit = annotated_expression e_unit make_t_unit - let e_a_int n = annotated_expression (e_int n) make_t_int - let e_a_bool b = annotated_expression (e_bool b) make_t_bool - let e_a_pair a b = annotated_expression (e_pair a b) (make_t_pair a.type_annotation b.type_annotation) - let e_a_some s = annotated_expression (e_some s) (make_t_option s.type_annotation) - let e_a_none t = annotated_expression e_none (make_t_option t) - let e_a_tuple lst = annotated_expression (E_tuple lst) (make_t_tuple (List.map get_type_annotation lst)) - let e_a_record r = annotated_expression (e_record r) (make_t_record (SMap.map get_type_annotation r)) - let ez_e_a_record r = annotated_expression (ez_e_record r) (make_t_record_ez (List.map (fun (x, y) -> x, y.type_annotation) r)) - let e_a_map lst k v = annotated_expression (e_map lst) (make_t_map k v) + let e_a_unit = annotated_expression e_unit (t_unit ()) + let e_a_int n = annotated_expression (e_int n) (t_int ()) + let e_a_bool b = annotated_expression (e_bool b) (t_bool ()) + let e_a_pair a b = annotated_expression (e_pair a b) (t_pair a.type_annotation b.type_annotation ()) + let e_a_some s = annotated_expression (e_some s) (t_option s.type_annotation ()) + let e_a_none t = annotated_expression e_none (t_option t ()) + let e_a_tuple lst = annotated_expression (E_tuple lst) (t_tuple (List.map get_type_annotation lst) ()) + let e_a_record r = annotated_expression (e_record r) (t_record (SMap.map get_type_annotation r) ()) + let ez_e_a_record r = annotated_expression (ez_e_record r) (ez_t_record (List.map (fun (x, y) -> x, y.type_annotation) r) ()) + let e_a_map lst k v = annotated_expression (e_map lst) (t_map k v ()) let get_a_int (t:annotated_expression) = match t.expression with diff --git a/src/ligo/test/integration_tests.ml b/src/ligo/test/integration_tests.ml index 8be8f3af1..05c102f2c 100644 --- a/src/ligo/test/integration_tests.ml +++ b/src/ligo/test/integration_tests.ml @@ -172,7 +172,7 @@ let option () : unit result = in let%bind _none = trace (simple_error "none") @@ let%bind result = easy_evaluate_typed "n" program in - let expect = e_a_none make_t_int in + let expect = e_a_none (t_int ()) in AST_Typed.assert_value_eq (expect, result) in ok () @@ -182,7 +182,7 @@ let map () : unit result = let ez lst = let open AST_Typed.Combinators in let lst' = List.map (fun (x, y) -> e_a_int x, e_a_int y) lst in - e_a_map lst' make_t_int make_t_int + e_a_map lst' (t_int ()) (t_int ()) in let%bind _get_force = trace (simple_error "get_force") @@ let aux n = @@ -267,7 +267,7 @@ let matching () : unit result = let open AST_Typed.Combinators in let input = match n with | Some s -> e_a_some (e_a_int s) - | None -> e_a_none (make_t_int) in + | None -> e_a_none (t_int ()) in let%bind result = easy_run_typed "match_option" program input in let%bind result' = trace (simple_error "bad result") @@ diff --git a/src/ligo/test/typer_tests.ml b/src/ligo/test/typer_tests.ml index cd3175b62..f9ba998fb 100644 --- a/src/ligo/test/typer_tests.ml +++ b/src/ligo/test/typer_tests.ml @@ -14,7 +14,7 @@ let int () : unit result = let%bind post = type_annotated_expression e pre in let open Typed in let open Combinators in - let%bind () = assert_type_value_eq (post.type_annotation, make_t_int) in + let%bind () = assert_type_value_eq (post.type_annotation, t_int ()) in ok () module TestExpressions = struct @@ -32,25 +32,25 @@ module TestExpressions = struct module O = Typed.Combinators module E = Typer.Environment.Combinators - let unit () : unit result = test_expression I.(e_unit ()) O.make_t_unit - let int () : unit result = test_expression I.(e_number 32) O.make_t_int - let bool () : unit result = test_expression I.(e_bool true) O.make_t_bool - let string () : unit result = test_expression I.(e_string "s") O.make_t_string - let bytes () : unit result = test_expression I.(e_bytes "b") O.make_t_bytes + let unit () : unit result = test_expression I.(e_unit ()) O.(t_unit ()) + let int () : unit result = test_expression I.(e_number 32) O.(t_int ()) + let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ()) + let string () : unit result = test_expression I.(e_string "s") O.(t_string ()) + let bytes () : unit result = test_expression I.(e_bytes "b") O.(t_bytes ()) let lambda () : unit result = test_expression I.(e_lambda "x" t_int t_int (e_var "x") []) - O.(make_t_function make_t_int make_t_int) + O.(t_function (t_int ()) (t_int ()) ()) let tuple () : unit result = test_expression I.(ez_e_tuple [e_number 32; e_string "foo"]) - O.(make_t_tuple [make_t_int; make_t_string]) + O.(t_tuple [t_int (); t_string ()] ()) let constructor () : unit result = let variant_foo_bar = - O.[("foo", make_t_int); ("bar", make_t_string)] + O.[("foo", t_int ()); ("bar", t_string ())] in test_expression ~env:(E.env_sum_type variant_foo_bar) I.(e_constructor "foo" (ae @@ e_number 32)) @@ -59,7 +59,7 @@ module TestExpressions = struct let record () : unit result = test_expression I.(ez_e_record [("foo", e_number 32); ("bar", e_string "foo")]) - O.(make_t_ez_record [("foo", make_t_int); ("bar", make_t_string)]) + O.(make_t_ez_record [("foo", t_int ()); ("bar", t_string ())]) end (* TODO: deep types (e.g. record of record) diff --git a/src/ligo/transpiler.ml b/src/ligo/transpiler.ml index 74894d55e..1985b776a 100644 --- a/src/ligo/transpiler.ml +++ b/src/ligo/transpiler.ml @@ -308,11 +308,11 @@ let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value = let open! AST in { binder = "_" ; - input_type = Combinators.make_t_unit ; + input_type = Combinators.t_unit () ; output_type = t ; result = e ; body = [I_skip] - }, Combinators.(make_t_function make_t_unit t) + }, Combinators.(t_function (t_unit ()) t ()) let translate_entry (lst:AST.program) (name:string) : anon_function result = let rec aux acc (lst:AST.program) = diff --git a/src/ligo/typer.ml b/src/ligo/typer.ml index 7f2d9d751..7fe650f3a 100644 --- a/src/ligo/typer.ml +++ b/src/ligo/typer.ml @@ -139,7 +139,7 @@ and type_instruction (e:environment) : I.instruction -> (environment * O.instruc | I_loop (cond, body) -> let%bind cond = type_annotated_expression e cond in let%bind _ = - O.assert_type_value_eq (cond.type_annotation, make_t_bool) in + O.assert_type_value_eq (cond.type_annotation, t_bool ()) in let%bind body = type_block e body in ok (e, O.I_loop (cond, body)) | I_assignment {name;annotated_expression} -> ( @@ -258,25 +258,25 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an let%bind type_annotation = check tv' in ok O.{expression = E_variable name ; type_annotation} | E_literal (Literal_bool b) -> - let%bind type_annotation = check make_t_bool in + let%bind type_annotation = check (t_bool ()) in ok O.{expression = E_literal (Literal_bool b) ; type_annotation } | E_literal Literal_unit -> - let%bind type_annotation = check make_t_unit in + let%bind type_annotation = check (t_unit ()) in ok O.{expression = E_literal (Literal_unit) ; type_annotation } | E_literal (Literal_string s) -> - let%bind type_annotation = check make_t_string in + let%bind type_annotation = check (t_string ()) in ok O.{expression = E_literal (Literal_string s) ; type_annotation } | E_literal (Literal_bytes s) -> - let%bind type_annotation = check make_t_bytes in + let%bind type_annotation = check (t_bytes ()) in ok O.{expression = E_literal (Literal_bytes s) ; type_annotation } | E_literal (Literal_number n) -> - let%bind type_annotation = check make_t_int in + let%bind type_annotation = check (t_int ()) in ok O.{expression = E_literal (Literal_int n) ; type_annotation } (* Tuple *) | E_tuple lst -> let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in let tv_lst = List.map get_annotation lst' in - let%bind type_annotation = check (make_t_tuple tv_lst) in + let%bind type_annotation = check (t_tuple tv_lst ()) in ok O.{expression = E_tuple lst' ; type_annotation } | E_accessor (ae, path) -> let%bind e' = type_annotated_expression e ae in @@ -318,7 +318,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an ok (SMap.add k expr' prev) in let%bind m' = bind_fold_smap aux (ok SMap.empty) m in - let%bind type_annotation = check @@ make_t_record (SMap.map get_annotation m') in + let%bind type_annotation = check @@ t_record (SMap.map get_annotation m') () in ok O.{expression = O.E_record m' ; type_annotation } (* Data-structure *) | E_map lst -> @@ -344,7 +344,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an @@ List.map snd lst' in trace_option (simple_error "empty map expression") opt in - check (make_t_map key_type value_type) + check (t_map key_type value_type ()) in ok O.{expression = O.E_map lst' ; type_annotation} | E_lambda { @@ -359,7 +359,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an let e' = Environment.add e binder input_type in let%bind (body, e'') = type_block_full e' body in let%bind result = type_annotated_expression e'' result in - let%bind type_annotation = check @@ make_t_function input_type output_type in + let%bind type_annotation = check @@ (t_function input_type output_type ()) in ok O.{expression = E_lambda {binder;input_type;output_type;result;body} ; type_annotation} | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in @@ -381,7 +381,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an let%bind (ds, ind) = bind_map_pair (type_annotated_expression e) dsi in let%bind (src, dst) = get_t_map ds.type_annotation in let%bind _ = O.assert_type_value_eq (ind.type_annotation, src) in - let dst_opt = make_t_option dst in + let dst_opt = (t_option dst ()) in let%bind type_annotation = check dst_opt in ok O.{expression = E_look_up (ds, ind) ; type_annotation} (* Advanced *) @@ -400,15 +400,15 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt (* Constant poorman's polymorphism *) let open O in match (name, lst) with - | "ADD", [a ; b] when type_value_eq (a, make_t_int) && type_value_eq (b, make_t_int) -> ok ("ADD_INT", make_t_int) - | "ADD", [a ; b] when type_value_eq (a, make_t_string) && type_value_eq (b, make_t_string) -> ok ("CONCAT", make_t_string) + | "ADD", [a ; b] when type_value_eq (a, t_int ()) && type_value_eq (b, t_int ()) -> ok ("ADD_INT", t_int ()) + | "ADD", [a ; b] when type_value_eq (a, t_string ()) && type_value_eq (b, t_string ()) -> ok ("CONCAT", t_string ()) | "ADD", [_ ; _] -> simple_fail "bad types to add" | "ADD", _ -> simple_fail "bad number of params to add" - | "EQ", [a ; b] when type_value_eq (a, make_t_int) && type_value_eq (b, make_t_int) -> ok ("EQ", make_t_bool) + | "EQ", [a ; b] when type_value_eq (a, t_int ()) && type_value_eq (b, t_int ()) -> ok ("EQ", t_bool ()) | "EQ", _ -> simple_fail "EQ only defined over int" - | "OR", [a ; b] when type_value_eq (a, make_t_bool) && type_value_eq (b, make_t_bool) -> ok ("OR", make_t_bool) + | "OR", [a ; b] when type_value_eq (a, t_bool ()) && type_value_eq (b, t_bool ()) -> ok ("OR", t_bool ()) | "OR", _ -> simple_fail "OR only defined over bool" - | "AND", [a ; b] when type_value_eq (a, make_t_bool) && type_value_eq (b, make_t_bool) -> ok ("AND", make_t_bool) + | "AND", [a ; b] when type_value_eq (a, t_bool ()) && type_value_eq (b, t_bool ()) -> ok ("AND", t_bool ()) | "AND", _ -> simple_fail "AND only defined over bool" | "NONE", [] -> ( match tv_opt with @@ -416,7 +416,7 @@ and type_constant (name:string) (lst:O.type_value list) (tv_opt:O.type_value opt | None -> simple_fail "untyped NONE" ) | "NONE", _ -> simple_fail "bad number of params to NONE" - | "SOME", [s] -> ok ("SOME", make_t_option s) + | "SOME", [s] -> ok ("SOME", t_option s ()) | "SOME", _ -> simple_fail "bad number of params to SOME" | "get_force", [i_ty;m_ty] -> let%bind (src, dst) = get_t_map m_ty in