Renaming (WIP)

This commit is contained in:
Georges Dupéron 2019-04-01 15:48:04 +02:00
parent 24b9b9f5ce
commit e54c5e0c42
7 changed files with 76 additions and 83 deletions

View File

@ -349,26 +349,26 @@ module Combinators = struct
t_record m
let t_sum m : type_expression = T_sum m
let make_t_ez_sum (lst:(string * type_expression) list) : type_expression =
let ez_t_sum (lst:(string * type_expression) list) : type_expression =
let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in
T_sum map
let t_function param result : type_expression = T_function (param, result)
let annotated_expression ?type_annotation expression = {expression ; type_annotation}
let e_annotated_expression ?type_annotation expression = {expression ; type_annotation}
let name (s : string) : name = s
let var (s : string) : expression = E_variable s
let e_var (s : string) : expression = E_variable s
let unit () : expression = E_literal (Literal_unit)
let number n : expression = E_literal (Literal_number n)
let bool b : expression = E_literal (Literal_bool b)
let string s : expression = E_literal (Literal_string s)
let bytes b : expression = E_literal (Literal_bytes (Bytes.of_string b))
let e_unit () : expression = E_literal (Literal_unit)
let e_number n : expression = E_literal (Literal_number n)
let e_bool b : expression = E_literal (Literal_bool b)
let e_string s : expression = E_literal (Literal_string s)
let e_bytes b : expression = E_literal (Literal_bytes (Bytes.of_string b))
let lambda (binder : string)
let e_lambda (binder : string)
(input_type : type_expression)
(output_type : type_expression)
(result : expression)
@ -382,19 +382,19 @@ module Combinators = struct
body ;
}
let tuple (lst : ae list) : expression = E_tuple lst
let ez_tuple (lst : expression list) : expression =
tuple (List.map (fun e -> ae e) lst)
let e_tuple (lst : ae list) : expression = E_tuple lst
let ez_e_tuple (lst : expression list) : expression =
e_tuple (List.map (fun e -> ae e) lst)
let constructor (s : string) (e : ae) : expression = E_constructor (name s, e)
let e_constructor (s : string) (e : ae) : expression = E_constructor (name s, e)
let record (lst : (string * ae) list) : expression =
let e_record (lst : (string * ae) list) : expression =
let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in
E_record map
let ez_record (lst : (string * expression) list) : expression =
let ez_e_record (lst : (string * expression) list) : expression =
(* TODO: define a correct implementation of List.map
* (an implementation that does not fail with stack overflow) *)
record (List.map (fun (s,e) -> (s, ae e)) lst)
e_record (List.map (fun (s,e) -> (s, ae e)) lst)
end

View File

@ -410,32 +410,25 @@ 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 simplify_t_bool s = t_bool (Some s)
let make_t_bool = t_bool None
let t_string s : type_value = type_value (T_constant ("string", [])) s
let simplify_t_string s = t_string (Some s)
let make_t_string = t_string None
let t_bytes s : type_value = type_value (T_constant ("bytes", [])) s
let simplify_t_bytes s = t_bytes (Some s)
let make_t_bytes = t_bytes None
let t_int s : type_value = type_value (T_constant ("int", [])) s
let simplify_t_int s = t_int (Some s)
let make_t_int = t_int None
let t_unit s : type_value = type_value (T_constant ("unit", [])) s
let simplify_t_unit s = t_unit (Some 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 simplify_t_tuple lst s = t_tuple lst (Some s)
let make_t_tuple lst = t_tuple lst None
let make_t_pair a b = make_t_tuple [a ; b]
@ -493,31 +486,31 @@ module Combinators = struct
| T_constant ("map", [k;v]) -> ok (k, v)
| _ -> simple_fail "not a map"
let record map : expression = E_record map
let record_ez (lst : (string * ae) list) : expression =
let e_record map : expression = E_record map
let ez_e_record (lst : (string * ae) list) : expression =
let aux prev (k, v) = SMap.add k v prev in
let map = List.fold_left aux SMap.empty lst in
record map
let some s : expression = E_constant ("SOME", [s])
let none : expression = E_constant ("NONE", [])
e_record map
let e_some s : expression = E_constant ("SOME", [s])
let e_none : expression = E_constant ("NONE", [])
let map lst : expression = E_map lst
let e_map lst : expression = E_map lst
let unit : expression = E_literal (Literal_unit)
let int n : expression = E_literal (Literal_int n)
let bool b : expression = E_literal (Literal_bool b)
let pair a b : expression = E_constant ("PAIR", [a; b])
let e_unit : expression = E_literal (Literal_unit)
let e_int n : expression = E_literal (Literal_int n)
let e_bool b : expression = E_literal (Literal_bool b)
let e_pair a b : expression = E_constant ("PAIR", [a; b])
let a_unit = annotated_expression unit make_t_unit
let a_int n = annotated_expression (int n) make_t_int
let a_bool b = annotated_expression (bool b) make_t_bool
let a_pair a b = annotated_expression (pair a b) (make_t_pair a.type_annotation b.type_annotation)
let a_some s = annotated_expression (some s) (make_t_option s.type_annotation)
let a_none t = annotated_expression none (make_t_option t)
let a_tuple lst = annotated_expression (E_tuple lst) (make_t_tuple (List.map get_type_annotation lst))
let a_record r = annotated_expression (record r) (make_t_record (SMap.map get_type_annotation r))
let a_record_ez r = annotated_expression (record_ez r) (make_t_record_ez (List.map (fun (x, y) -> x, y.type_annotation) r))
let a_map lst k v = annotated_expression (map lst) (make_t_map k v)
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 get_a_int (t:annotated_expression) =
match t.expression with

View File

@ -1197,8 +1197,8 @@ module Combinators = struct
let e = Environment.empty in
Environment.add ("input", t_int) e
let expr_int expr env : expression = (expr, t_int, env)
let var_int name env : expression = expr_int (E_variable name) env
let e_int expr env : expression = (expr, t_int, env)
let e_var_int name env : expression = e_int (E_variable name) env
let d_unit : value = D_unit

View File

@ -12,7 +12,7 @@ let run_entry_int (e:anon_function) (n:int) : int result =
let identity () : unit result =
let e = basic_int_quote_env in
let s = statement (Assignment ("output", var_int "input" e)) e in
let s = statement (Assignment ("output", e_var_int "input" e)) e in
let%bind b = block [s] in
let%bind f = basic_int_quote b in
let%bind result = run_entry_int f 42 in
@ -27,10 +27,10 @@ let multiple_vars () : unit result =
Yes. One could do a monad. Feel free when we have the time.
*)
let ss = statements [
(fun e -> statement (Assignment ("a", var_int "input" e)) e) ;
(fun e -> statement (Assignment ("b", var_int "input" e)) e) ;
(fun e -> statement (Assignment ("c", var_int "a" e)) e) ;
(fun e -> statement (Assignment ("output", var_int "c" e)) e) ;
(fun e -> statement (Assignment ("a", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("b", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("c", e_var_int "a" e)) e) ;
(fun e -> statement (Assignment ("output", e_var_int "c" e)) e) ;
] e in
let%bind b = block ss in
let%bind f = basic_int_quote b in

View File

@ -29,7 +29,7 @@ let complex_function () : unit result =
let%bind program = type_file "./contracts/function-complex.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -46,7 +46,7 @@ let bool_expression () : unit result =
let aux (name, f) =
let aux b =
let open AST_Typed.Combinators in
let input = a_bool b in
let input = e_a_bool b in
let%bind result = easy_run_typed name program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -78,7 +78,7 @@ let unit_expression () : unit result =
let record_ez_int names n =
let open AST_Typed.Combinators in
a_record_ez @@ List.map (fun x -> x, a_int n) names
ez_e_a_record @@ List.map (fun x -> x, e_a_int n) names
let multiple_parameters () : unit result =
let%bind program = type_file "./contracts/multiple-parameters.ligo" in
@ -113,7 +113,7 @@ let record () : unit result =
let aux n =
let input = record_ez_int ["foo";"bar"] n in
let%bind result = easy_run_typed "projection" program input in
let expect = AST_Typed.Combinators.a_int (2 * n) in
let expect = AST_Typed.Combinators.e_a_int (2 * n) in
AST_Typed.assert_value_eq (expect, result)
in
bind_list @@ List.map aux [0 ; -42 ; 144]
@ -129,7 +129,7 @@ let tuple () : unit result =
let%bind program = type_file "./contracts/tuple.ligo" in
let ez n =
let open AST_Typed.Combinators in
a_tuple (List.map a_int n) in
e_a_tuple (List.map e_a_int n) in
let%bind _foobar =
trace (simple_error "foobar") (
let%bind result = easy_evaluate_typed "fb" program in
@ -141,7 +141,7 @@ let tuple () : unit result =
let aux n =
let input = ez [n ; n] in
let%bind result = easy_run_typed "projection" program input in
let expect = AST_Typed.Combinators.a_int (2 * n) in
let expect = AST_Typed.Combinators.e_a_int (2 * n) in
AST_Typed.assert_value_eq (expect, result)
in
bind_list @@ List.map aux [0 ; -42 ; 144]
@ -159,12 +159,12 @@ let option () : unit result =
let open AST_Typed.Combinators in
let%bind _some = trace (simple_error "some") @@
let%bind result = easy_evaluate_typed "s" program in
let expect = a_some (a_int 42) in
let expect = e_a_some (e_a_int 42) in
AST_Typed.assert_value_eq (expect, result)
in
let%bind _none = trace (simple_error "none") @@
let%bind result = easy_evaluate_typed "n" program in
let expect = a_none make_t_int in
let expect = e_a_none make_t_int in
AST_Typed.assert_value_eq (expect, result)
in
ok ()
@ -173,14 +173,14 @@ let map () : unit result =
let%bind program = type_file "./contracts/map.ligo" in
let ez lst =
let open AST_Typed.Combinators in
let lst' = List.map (fun (x, y) -> a_int x, a_int y) lst in
a_map lst' make_t_int make_t_int
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
in
let%bind _get_force = trace (simple_error "get_force") @@
let aux n =
let input = ez [(23, n) ; (42, 4)] in
let%bind result = easy_run_typed "gf" program input in
let expect = AST_Typed.Combinators.(a_int n) in
let expect = AST_Typed.Combinators.(e_a_int n) in
AST_Typed.assert_value_eq (expect, result)
in
bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3]
@ -194,7 +194,7 @@ let map () : unit result =
let aux n =
let input = ez [(23, n) ; (42, 4)] in
let%bind result = easy_run_typed "get" program input in
let expect = AST_Typed.Combinators.(a_some @@ a_int 4) in
let expect = AST_Typed.Combinators.(e_a_some @@ e_a_int 4) in
AST_Typed.assert_value_eq (expect, result)
in
bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3]
@ -210,7 +210,7 @@ let condition () : unit result =
let%bind program = type_file "./contracts/condition.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -227,7 +227,7 @@ let matching () : unit result =
let%bind _bool =
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_typed "match_bool" program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -242,7 +242,7 @@ let matching () : unit result =
let%bind _expr_bool =
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_typed "match_expr_bool" program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -258,8 +258,8 @@ let matching () : unit result =
let aux n =
let open AST_Typed.Combinators in
let input = match n with
| Some s -> a_some (a_int s)
| None -> a_none (make_t_int) in
| Some s -> e_a_some (e_a_int s)
| None -> e_a_none (make_t_int) in
let%bind result = easy_run_typed "match_option" program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -277,7 +277,7 @@ let declarations () : unit result =
let%bind program = type_file "./contracts/declarations.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -293,7 +293,7 @@ let quote_declaration () : unit result =
let%bind program = type_file "./contracts/quote-declaration.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@
@ -309,7 +309,7 @@ let quote_declarations () : unit result =
let%bind program = type_file "./contracts/quote-declarations.ligo" in
let aux n =
let open AST_Typed.Combinators in
let input = a_int n in
let input = e_a_int n in
let%bind result = easy_run_main_typed program input in
let%bind result' =
trace (simple_error "bad result") @@

View File

@ -8,7 +8,7 @@ module Simplified = Ligo.AST_Simplified
let int () : unit result =
let open Combinators in
let pre = ae @@ number 32 in
let pre = ae @@ e_number 32 in
let open Typer in
let e = Environment.empty in
let%bind post = type_annotated_expression e pre in
@ -32,20 +32,20 @@ module TestExpressions = struct
module O = Typed.Combinators
module E = Typer.Environment.Combinators
let unit () : unit result = test_expression I.(unit ()) O.make_t_unit
let int () : unit result = test_expression I.(number 32) O.make_t_int
let bool () : unit result = test_expression I.(bool true) O.make_t_bool
let string () : unit result = test_expression I.(string "s") O.make_t_string
let bytes () : unit result = test_expression I.(bytes "b") O.make_t_bytes
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 lambda () : unit result =
test_expression
I.(lambda "x" t_int t_int (var "x") [])
I.(e_lambda "x" t_int t_int (e_var "x") [])
O.(make_t_function make_t_int make_t_int)
let tuple () : unit result =
test_expression
I.(ez_tuple [number 32; string "foo"])
I.(ez_e_tuple [e_number 32; e_string "foo"])
O.(make_t_tuple [make_t_int; make_t_string])
let constructor () : unit result =
@ -53,12 +53,12 @@ module TestExpressions = struct
O.[("foo", make_t_int); ("bar", make_t_string)]
in test_expression
~env:(E.env_sum_type variant_foo_bar)
I.(constructor "foo" (ae @@ number 32))
I.(e_constructor "foo" (ae @@ e_number 32))
O.(make_t_ez_sum variant_foo_bar)
let record () : unit result =
test_expression
I.(ez_record [("foo", number 32); ("bar", 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)])
end

View File

@ -226,7 +226,7 @@ and translate_annotated_expression (env:Environment.t) (ae:AST.annotated_express
let aux : expression result -> (AST.ae * AST.ae) -> expression result = fun prev (k, v) ->
let%bind prev' = prev in
let%bind (k', v') =
let v' = a_some v in
let v' = e_a_some v in
bind_map_pair (translate_annotated_expression env) (k, v') in
return (E_constant ("UPDATE", [k' ; v' ; prev']), tv)
in
@ -410,10 +410,10 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
return (E_literal (Literal_string n))
| T_constant ("option", [o]) -> (
match%bind get_option v with
| None -> ok (a_none o)
| None -> ok (e_a_none o)
| Some s ->
let%bind s' = untranspile s o in
ok (a_some s')
ok (e_a_some s')
)
| T_constant ("map", [k_ty;v_ty]) -> (
let%bind lst = get_map v in