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 t_record m
let t_sum m : type_expression = T_sum 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 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
T_sum map T_sum map
let t_function param result : type_expression = T_function (param, result) 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 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 e_unit () : expression = E_literal (Literal_unit)
let number n : expression = E_literal (Literal_number n) let e_number n : expression = E_literal (Literal_number n)
let bool b : expression = E_literal (Literal_bool b) let e_bool b : expression = E_literal (Literal_bool b)
let string s : expression = E_literal (Literal_string s) let e_string s : expression = E_literal (Literal_string s)
let bytes b : expression = E_literal (Literal_bytes (Bytes.of_string b)) 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) (input_type : type_expression)
(output_type : type_expression) (output_type : type_expression)
(result : expression) (result : expression)
@ -382,19 +382,19 @@ module Combinators = struct
body ; body ;
} }
let tuple (lst : ae list) : expression = E_tuple lst let e_tuple (lst : ae list) : expression = E_tuple lst
let ez_tuple (lst : expression list) : expression = let ez_e_tuple (lst : expression list) : expression =
tuple (List.map (fun e -> ae e) lst) 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 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
E_record map 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 (* TODO: define a correct implementation of List.map
* (an implementation that does not fail with stack overflow) *) * (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 end

View File

@ -410,32 +410,25 @@ 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 simplify_t_bool s = t_bool (Some s)
let make_t_bool = t_bool None let make_t_bool = t_bool None
let t_string s : type_value = type_value (T_constant ("string", [])) s 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 make_t_string = t_string None
let t_bytes s : type_value = type_value (T_constant ("bytes", [])) s 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 make_t_bytes = t_bytes None
let t_int s : type_value = type_value (T_constant ("int", [])) s 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 make_t_int = t_int None
let t_unit s : type_value = type_value (T_constant ("unit", [])) s 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 make_t_unit = t_unit None
let t_option o s : type_value = type_value (T_constant ("option", [o])) s let t_option o s : type_value = type_value (T_constant ("option", [o])) s
let make_t_option o = t_option o None let make_t_option o = t_option o None
let t_tuple lst s : type_value = type_value (T_tuple lst) s 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_tuple lst = t_tuple lst None
let make_t_pair a b = make_t_tuple [a ; b] 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) | T_constant ("map", [k;v]) -> ok (k, v)
| _ -> simple_fail "not a map" | _ -> simple_fail "not a map"
let record map : expression = E_record map let e_record map : expression = E_record map
let record_ez (lst : (string * ae) list) : expression = let ez_e_record (lst : (string * ae) list) : expression =
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
record map e_record map
let some s : expression = E_constant ("SOME", [s]) let e_some s : expression = E_constant ("SOME", [s])
let none : expression = E_constant ("NONE", []) 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 e_unit : expression = E_literal (Literal_unit)
let int n : expression = E_literal (Literal_int n) let e_int n : expression = E_literal (Literal_int n)
let bool b : expression = E_literal (Literal_bool b) let e_bool b : expression = E_literal (Literal_bool b)
let pair a b : expression = E_constant ("PAIR", [a; b]) let e_pair a b : expression = E_constant ("PAIR", [a; b])
let a_unit = annotated_expression unit make_t_unit let e_a_unit = annotated_expression e_unit make_t_unit
let a_int n = annotated_expression (int n) make_t_int let e_a_int n = annotated_expression (e_int n) make_t_int
let a_bool b = annotated_expression (bool b) make_t_bool let e_a_bool b = annotated_expression (e_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 e_a_pair a b = annotated_expression (e_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 e_a_some s = annotated_expression (e_some s) (make_t_option s.type_annotation)
let a_none t = annotated_expression none (make_t_option t) let e_a_none t = annotated_expression e_none (make_t_option t)
let 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) (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 e_a_record r = annotated_expression (e_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 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 a_map lst k v = annotated_expression (map lst) (make_t_map k v) let e_a_map lst k v = annotated_expression (e_map lst) (make_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

View File

@ -1197,8 +1197,8 @@ module Combinators = struct
let e = Environment.empty in let e = Environment.empty in
Environment.add ("input", t_int) e Environment.add ("input", t_int) e
let expr_int expr env : expression = (expr, t_int, env) let e_int expr env : expression = (expr, t_int, env)
let var_int name env : expression = expr_int (E_variable name) env let e_var_int name env : expression = e_int (E_variable name) env
let d_unit : value = D_unit 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 identity () : unit result =
let e = basic_int_quote_env in 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 b = block [s] in
let%bind f = basic_int_quote b in let%bind f = basic_int_quote b in
let%bind result = run_entry_int f 42 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. Yes. One could do a monad. Feel free when we have the time.
*) *)
let ss = statements [ let ss = statements [
(fun e -> statement (Assignment ("a", var_int "input" e)) e) ; (fun e -> statement (Assignment ("a", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("b", var_int "input" e)) e) ; (fun e -> statement (Assignment ("b", e_var_int "input" e)) e) ;
(fun e -> statement (Assignment ("c", var_int "a" e)) e) ; (fun e -> statement (Assignment ("c", e_var_int "a" e)) e) ;
(fun e -> statement (Assignment ("output", var_int "c" e)) e) ; (fun e -> statement (Assignment ("output", e_var_int "c" e)) e) ;
] e in ] e in
let%bind b = block ss in let%bind b = block ss in
let%bind f = basic_int_quote b 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%bind program = type_file "./contracts/function-complex.ligo" in
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_main_typed program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@
@ -46,7 +46,7 @@ let bool_expression () : unit result =
let aux (name, f) = let aux (name, f) =
let aux b = let aux b =
let open AST_Typed.Combinators in 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 = easy_run_typed name program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@
@ -78,7 +78,7 @@ let unit_expression () : unit result =
let record_ez_int names n = let record_ez_int names n =
let open AST_Typed.Combinators in 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 multiple_parameters () : unit result =
let%bind program = type_file "./contracts/multiple-parameters.ligo" in let%bind program = type_file "./contracts/multiple-parameters.ligo" in
@ -113,7 +113,7 @@ let record () : unit result =
let aux n = let aux n =
let input = record_ez_int ["foo";"bar"] n in let input = record_ez_int ["foo";"bar"] n in
let%bind result = easy_run_typed "projection" program input 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) AST_Typed.assert_value_eq (expect, result)
in in
bind_list @@ List.map aux [0 ; -42 ; 144] 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%bind program = type_file "./contracts/tuple.ligo" in
let ez n = let ez n =
let open AST_Typed.Combinators in 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 = let%bind _foobar =
trace (simple_error "foobar") ( trace (simple_error "foobar") (
let%bind result = easy_evaluate_typed "fb" program in let%bind result = easy_evaluate_typed "fb" program in
@ -141,7 +141,7 @@ let tuple () : unit result =
let aux n = let aux n =
let input = ez [n ; n] in let input = ez [n ; n] in
let%bind result = easy_run_typed "projection" program input 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) AST_Typed.assert_value_eq (expect, result)
in in
bind_list @@ List.map aux [0 ; -42 ; 144] bind_list @@ List.map aux [0 ; -42 ; 144]
@ -159,12 +159,12 @@ let option () : unit result =
let open AST_Typed.Combinators in let open AST_Typed.Combinators in
let%bind _some = trace (simple_error "some") @@ let%bind _some = trace (simple_error "some") @@
let%bind result = easy_evaluate_typed "s" program in 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) AST_Typed.assert_value_eq (expect, 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 = a_none make_t_int in let expect = e_a_none make_t_int in
AST_Typed.assert_value_eq (expect, result) AST_Typed.assert_value_eq (expect, result)
in in
ok () ok ()
@ -173,14 +173,14 @@ let map () : unit result =
let%bind program = type_file "./contracts/map.ligo" in let%bind program = type_file "./contracts/map.ligo" in
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) -> a_int x, a_int y) lst in let lst' = List.map (fun (x, y) -> e_a_int x, e_a_int y) lst in
a_map lst' make_t_int make_t_int e_a_map lst' make_t_int make_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 =
let input = ez [(23, n) ; (42, 4)] in let input = ez [(23, n) ; (42, 4)] in
let%bind result = easy_run_typed "gf" program input 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) AST_Typed.assert_value_eq (expect, result)
in in
bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3] bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3]
@ -194,7 +194,7 @@ let map () : unit result =
let aux n = let aux n =
let input = ez [(23, n) ; (42, 4)] in let input = ez [(23, n) ; (42, 4)] in
let%bind result = easy_run_typed "get" program input 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) AST_Typed.assert_value_eq (expect, result)
in in
bind_map_list aux [0 ; 42 ; 51 ; 421 ; -3] 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%bind program = type_file "./contracts/condition.ligo" in
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_main_typed program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@
@ -227,7 +227,7 @@ let matching () : unit result =
let%bind _bool = let%bind _bool =
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_typed "match_bool" program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@
@ -242,7 +242,7 @@ let matching () : unit result =
let%bind _expr_bool = let%bind _expr_bool =
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_typed "match_expr_bool" program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@
@ -258,8 +258,8 @@ let matching () : unit result =
let aux n = let aux n =
let open AST_Typed.Combinators in let open AST_Typed.Combinators in
let input = match n with let input = match n with
| Some s -> a_some (a_int s) | Some s -> e_a_some (e_a_int s)
| None -> a_none (make_t_int) in | None -> e_a_none (make_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") @@
@ -277,7 +277,7 @@ let declarations () : unit result =
let%bind program = type_file "./contracts/declarations.ligo" in let%bind program = type_file "./contracts/declarations.ligo" in
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_main_typed program input in
let%bind result' = let%bind result' =
trace (simple_error "bad 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%bind program = type_file "./contracts/quote-declaration.ligo" in
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_main_typed program input in
let%bind result' = let%bind result' =
trace (simple_error "bad 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%bind program = type_file "./contracts/quote-declarations.ligo" in
let aux n = let aux n =
let open AST_Typed.Combinators in 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 = easy_run_main_typed program input in
let%bind result' = let%bind result' =
trace (simple_error "bad result") @@ trace (simple_error "bad result") @@

View File

@ -8,7 +8,7 @@ module Simplified = Ligo.AST_Simplified
let int () : unit result = let int () : unit result =
let open Combinators in let open Combinators in
let pre = ae @@ number 32 in let pre = ae @@ e_number 32 in
let open Typer in let open Typer in
let e = Environment.empty in let e = Environment.empty in
let%bind post = type_annotated_expression e pre in let%bind post = type_annotated_expression e pre in
@ -32,20 +32,20 @@ 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.(unit ()) O.make_t_unit let unit () : unit result = test_expression I.(e_unit ()) O.make_t_unit
let int () : unit result = test_expression I.(number 32) O.make_t_int let int () : unit result = test_expression I.(e_number 32) O.make_t_int
let bool () : unit result = test_expression I.(bool true) O.make_t_bool let bool () : unit result = test_expression I.(e_bool true) O.make_t_bool
let string () : unit result = test_expression I.(string "s") O.make_t_string let string () : unit result = test_expression I.(e_string "s") O.make_t_string
let bytes () : unit result = test_expression I.(bytes "b") O.make_t_bytes let bytes () : unit result = test_expression I.(e_bytes "b") O.make_t_bytes
let lambda () : unit result = let lambda () : unit result =
test_expression 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) O.(make_t_function make_t_int make_t_int)
let tuple () : unit result = let tuple () : unit result =
test_expression 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]) O.(make_t_tuple [make_t_int; make_t_string])
let constructor () : unit result = let constructor () : unit result =
@ -53,12 +53,12 @@ module TestExpressions = struct
O.[("foo", make_t_int); ("bar", make_t_string)] O.[("foo", make_t_int); ("bar", make_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.(constructor "foo" (ae @@ number 32)) I.(e_constructor "foo" (ae @@ e_number 32))
O.(make_t_ez_sum variant_foo_bar) O.(make_t_ez_sum variant_foo_bar)
let record () : unit result = let record () : unit result =
test_expression 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)]) O.(make_t_ez_record [("foo", make_t_int); ("bar", make_t_string)])
end 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 aux : expression result -> (AST.ae * AST.ae) -> expression result = fun prev (k, v) ->
let%bind prev' = prev in let%bind prev' = prev in
let%bind (k', v') = 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 bind_map_pair (translate_annotated_expression env) (k, v') in
return (E_constant ("UPDATE", [k' ; v' ; prev']), tv) return (E_constant ("UPDATE", [k' ; v' ; prev']), tv)
in in
@ -410,10 +410,10 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
return (E_literal (Literal_string n)) return (E_literal (Literal_string n))
| T_constant ("option", [o]) -> ( | T_constant ("option", [o]) -> (
match%bind get_option v with match%bind get_option v with
| None -> ok (a_none o) | None -> ok (e_a_none o)
| Some s -> | Some s ->
let%bind s' = untranspile s o in let%bind s' = untranspile s o in
ok (a_some s') ok (e_a_some s')
) )
| T_constant ("map", [k_ty;v_ty]) -> ( | T_constant ("map", [k_ty;v_ty]) -> (
let%bind lst = get_map v in let%bind lst = get_map v in