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

Refactoring: remove make_ combinators in ast_typed and use optional argument instead

Browse Source
This commit is contained in:
Georges Dupéron 2019-04-02 18:36:11 +02:00
parent 206a3dbd35
commit 8edada0f6c
6 changed files with 58 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/ligo/README_INSTALL
View File

@ -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 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) # 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 .) (cd ligo-parser && opam install -y .)
eval $(opam env) eval $(opam env)
@ -16,5 +16,5 @@ eval $(opam env)
eval $(opam env) eval $(opam env)
(opam install -y .) (opam install -y .)
eval $(opam env) eval $(opam env)
opam install merlin ocp-indent opam install merlin ocp-indent ledit
opam user-setup install opam user-setup install

65
src/ligo/ast_typed.ml
View File

@ -410,50 +410,33 @@ let merge_annotation (a:type_value option) (b:type_value option) : type_value re
| _, Some _ -> ok b | _, Some _ -> ok b
module Combinators = struct module Combinators = struct
let t_bool s : type_value = type_value (T_constant ("bool", [])) s let t_bool ?s () : type_value = type_value (T_constant ("bool", [])) s
let make_t_bool = t_bool None 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 t_record m ?s () : type_value = type_value (T_record m) 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 make_t_ez_record (lst:(string * type_value) list) : type_value = let make_t_ez_record (lst:(string * type_value) list) : type_value =
let aux prev (k, v) = SMap.add k v prev in let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in let map = List.fold_left aux SMap.empty lst in
type_value (T_record map) None type_value (T_record map) None
let make_t_record m = t_record m None let ez_t_record lst ?s () : type_value =
let make_t_record_ez lst =
let m = SMap.of_list lst in 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 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_sum m s : type_value = type_value (T_sum m) s let t_sum m ?s () : type_value = type_value (T_sum m) s
let make_t_sum m = t_sum m None
let make_t_ez_sum (lst:(string * type_value) list) : type_value = let make_t_ez_sum (lst:(string * type_value) list) : type_value =
let aux prev (k, v) = SMap.add k v prev in let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in let map = List.fold_left aux SMap.empty lst in
type_value (T_sum map) None type_value (T_sum map) None
let t_function param result s : type_value = type_value (T_function (param, result)) s 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 get_annotation (x:annotated_expression) = x.type_annotation 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_bool b : expression = E_literal (Literal_bool b)
let e_pair a b : expression = E_constant ("PAIR", [a; 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_unit = annotated_expression e_unit (t_unit ())
let e_a_int n = annotated_expression (e_int n) make_t_int let e_a_int n = annotated_expression (e_int n) (t_int ())
let e_a_bool b = annotated_expression (e_bool b) make_t_bool let e_a_bool b = annotated_expression (e_bool b) (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_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) (make_t_option s.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 (make_t_option t) let e_a_none t = annotated_expression e_none (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_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) (make_t_record (SMap.map get_type_annotation r)) 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) (make_t_record_ez (List.map (fun (x, y) -> x, y.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) (make_t_map k v) let e_a_map lst k v = annotated_expression (e_map lst) (t_map k v ())
let get_a_int (t:annotated_expression) = let get_a_int (t:annotated_expression) =
match t.expression with match t.expression with

6
src/ligo/test/integration_tests.ml
View File

@ -172,7 +172,7 @@ let option () : unit result =
in in
let%bind _none = trace (simple_error "none") @@ let%bind _none = trace (simple_error "none") @@
let%bind result = easy_evaluate_typed "n" program in 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) AST_Typed.assert_value_eq (expect, result)
in in
ok () ok ()
@ -182,7 +182,7 @@ let map () : unit result =
let ez lst = let ez lst =
let open AST_Typed.Combinators in let open AST_Typed.Combinators in
let lst' = List.map (fun (x, y) -> e_a_int x, e_a_int y) lst 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 in
let%bind _get_force = trace (simple_error "get_force") @@ let%bind _get_force = trace (simple_error "get_force") @@
let aux n = let aux n =
@ -267,7 +267,7 @@ let matching () : unit result =
let open AST_Typed.Combinators in let open AST_Typed.Combinators in
let input = match n with let input = match n with
| Some s -> e_a_some (e_a_int s) | 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 = easy_run_typed "match_option" program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@

20
src/ligo/test/typer_tests.ml
View File

@ -14,7 +14,7 @@ let int () : unit result =
let%bind post = type_annotated_expression e pre in let%bind post = type_annotated_expression e pre in
let open Typed in let open Typed in
let open Combinators 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 () ok ()
module TestExpressions = struct module TestExpressions = struct
@ -32,25 +32,25 @@ module TestExpressions = struct
module O = Typed.Combinators module O = Typed.Combinators
module E = Typer.Environment.Combinators module E = Typer.Environment.Combinators
let unit () : unit result = test_expression I.(e_unit ()) O.make_t_unit let unit () : unit result = test_expression I.(e_unit ()) O.(t_unit ())
let int () : unit result = test_expression I.(e_number 32) O.make_t_int let int () : unit result = test_expression I.(e_number 32) O.(t_int ())
let bool () : unit result = test_expression I.(e_bool true) O.make_t_bool let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ())
let string () : unit result = test_expression I.(e_string "s") O.make_t_string let string () : unit result = test_expression I.(e_string "s") O.(t_string ())
let bytes () : unit result = test_expression I.(e_bytes "b") O.make_t_bytes let bytes () : unit result = test_expression I.(e_bytes "b") O.(t_bytes ())
let lambda () : unit result = let lambda () : unit result =
test_expression test_expression
I.(e_lambda "x" t_int t_int (e_var "x") []) 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 = let tuple () : unit result =
test_expression test_expression
I.(ez_e_tuple [e_number 32; e_string "foo"]) 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 constructor () : unit result =
let variant_foo_bar = let variant_foo_bar =
O.[("foo", make_t_int); ("bar", make_t_string)] O.[("foo", t_int ()); ("bar", t_string ())]
in test_expression in test_expression
~env:(E.env_sum_type variant_foo_bar) ~env:(E.env_sum_type variant_foo_bar)
I.(e_constructor "foo" (ae @@ e_number 32)) I.(e_constructor "foo" (ae @@ e_number 32))
@ -59,7 +59,7 @@ module TestExpressions = struct
let record () : unit result = let record () : unit result =
test_expression test_expression
I.(ez_e_record [("foo", e_number 32); ("bar", e_string "foo")]) 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 end
(* TODO: deep types (e.g. record of record) (* TODO: deep types (e.g. record of record)

4
src/ligo/transpiler.ml
View File

@ -308,11 +308,11 @@ let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value =
let open! AST in let open! AST in
{ {
binder = "_" ; binder = "_" ;
input_type = Combinators.make_t_unit ; input_type = Combinators.t_unit () ;
output_type = t ; output_type = t ;
result = e ; result = e ;
body = [I_skip] 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 translate_entry (lst:AST.program) (name:string) : anon_function result =
let rec aux acc (lst:AST.program) = let rec aux acc (lst:AST.program) =

34
src/ligo/typer.ml
View File

@ -139,7 +139,7 @@ and type_instruction (e:environment) : I.instruction -> (environment * O.instruc
| I_loop (cond, body) -> | I_loop (cond, body) ->
let%bind cond = type_annotated_expression e cond in let%bind cond = type_annotated_expression e cond in
let%bind _ = 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 let%bind body = type_block e body in
ok (e, O.I_loop (cond, body)) ok (e, O.I_loop (cond, body))
| I_assignment {name;annotated_expression} -> ( | 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 let%bind type_annotation = check tv' in
ok O.{expression = E_variable name ; type_annotation} ok O.{expression = E_variable name ; type_annotation}
| E_literal (Literal_bool b) -> | 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 } ok O.{expression = E_literal (Literal_bool b) ; type_annotation }
| E_literal Literal_unit -> | 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 } ok O.{expression = E_literal (Literal_unit) ; type_annotation }
| E_literal (Literal_string s) -> | 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 } ok O.{expression = E_literal (Literal_string s) ; type_annotation }
| E_literal (Literal_bytes s) -> | 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 } ok O.{expression = E_literal (Literal_bytes s) ; type_annotation }
| E_literal (Literal_number n) -> | 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 } ok O.{expression = E_literal (Literal_int n) ; type_annotation }
(* Tuple *) (* Tuple *)
| E_tuple lst -> | E_tuple lst ->
let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in
let tv_lst = List.map get_annotation 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 } ok O.{expression = E_tuple lst' ; type_annotation }
| E_accessor (ae, path) -> | E_accessor (ae, path) ->
let%bind e' = type_annotated_expression e ae in 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) ok (SMap.add k expr' prev)
in in
let%bind m' = bind_fold_smap aux (ok SMap.empty) m 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 } ok O.{expression = O.E_record m' ; type_annotation }
(* Data-structure *) (* Data-structure *)
| E_map lst -> | E_map lst ->
@ -344,7 +344,7 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an
@@ List.map snd lst' in @@ List.map snd lst' in
trace_option (simple_error "empty map expression") opt trace_option (simple_error "empty map expression") opt
in in
check (make_t_map key_type value_type) check (t_map key_type value_type ())
in in
ok O.{expression = O.E_map lst' ; type_annotation} ok O.{expression = O.E_map lst' ; type_annotation}
| E_lambda { | 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 e' = Environment.add e binder input_type in
let%bind (body, e'') = type_block_full e' body in let%bind (body, e'') = type_block_full e' body in
let%bind result = type_annotated_expression e'' result 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} ok O.{expression = E_lambda {binder;input_type;output_type;result;body} ; type_annotation}
| E_constant (name, lst) -> | E_constant (name, lst) ->
let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in 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 (ds, ind) = bind_map_pair (type_annotated_expression e) dsi in
let%bind (src, dst) = get_t_map ds.type_annotation 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%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 let%bind type_annotation = check dst_opt in
ok O.{expression = E_look_up (ds, ind) ; type_annotation} ok O.{expression = E_look_up (ds, ind) ; type_annotation}
(* Advanced *) (* 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 *) (* Constant poorman's polymorphism *)
let open O in let open O in
match (name, lst) with 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, t_int ()) && type_value_eq (b, t_int ()) -> ok ("ADD_INT", 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_string ()) && type_value_eq (b, t_string ()) -> ok ("CONCAT", t_string ())
| "ADD", [_ ; _] -> simple_fail "bad types to add" | "ADD", [_ ; _] -> simple_fail "bad types to add"
| "ADD", _ -> simple_fail "bad number of params 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" | "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" | "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" | "AND", _ -> simple_fail "AND only defined over bool"
| "NONE", [] -> ( | "NONE", [] -> (
match tv_opt with 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 "untyped NONE"
) )
| "NONE", _ -> simple_fail "bad number of params to 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" | "SOME", _ -> simple_fail "bad number of params to SOME"
| "get_force", [i_ty;m_ty] -> | "get_force", [i_ty;m_ty] ->
let%bind (src, dst) = get_t_map m_ty in let%bind (src, dst) = get_t_map m_ty in