From d23c49920c7dbba8968b1c7c281b22a4f8f892a2 Mon Sep 17 00:00:00 2001 From: Galfour Date: Wed, 20 Mar 2019 17:25:32 +0000 Subject: [PATCH] tmp --- src/ligo/ast_simplified.ml | 1 + src/ligo/ast_typed.ml | 2 ++ src/ligo/type_ast.ml | 38 +++++++++++++++++++++++++++++++++++++- 3 files changed, 40 insertions(+), 1 deletion(-) diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index ab1747ffd..99ae6824b 100644 --- a/src/ligo/ast_simplified.ml +++ b/src/ligo/ast_simplified.ml @@ -37,6 +37,7 @@ and type_expression = | Type_tuple of te list | Type_sum of te_map | Type_record of te_map + | Type_function of te * te | Type_variable of type_name | Type_constant of type_name * te list diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml index 3ad88684f..5a5397c56 100644 --- a/src/ligo/ast_typed.ml +++ b/src/ligo/ast_typed.ml @@ -35,6 +35,7 @@ and type_value = | Type_sum of tv_map | Type_record of tv_map | Type_constant of type_name * tv list + | Type_function of tv * tv and expression = (* Base *) @@ -148,6 +149,7 @@ let merge_annotation (a:type_value option) (b:type_value option) : type_value re let t_bool : type_value = Type_constant ("bool", []) let t_string : type_value = Type_constant ("string", []) +let t_bytes : type_value = Type_constant ("bytes", []) let t_int : type_value = Type_constant ("int", []) let get_annotation (x:annotated_expression) = x.type_annotation diff --git a/src/ligo/type_ast.ml b/src/ligo/type_ast.ml index 97b7ced20..496b8941e 100644 --- a/src/ligo/type_ast.ml +++ b/src/ligo/type_ast.ml @@ -123,6 +123,10 @@ and type_match (e:environment) : I.matching -> O.matching result = function ok (O.Match_tuple lst') and evaluate_type (e:environment) : I.type_expression -> O.type_value result = function + | Type_function (a, b) -> + let%bind a' = evaluate_type e a in + let%bind b' = evaluate_type e b in + ok (O.Type_function (a', b')) | Type_tuple lst -> let%bind lst' = bind_list @@ List.map (evaluate_type e) lst in ok (O.Type_tuple lst') @@ -170,6 +174,9 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an | Literal (String s) -> let%bind type_annotation = check O.t_string in ok O.{expression = Literal (String s) ; type_annotation } + | Literal (Bytes s) -> + let%bind type_annotation = check O.t_bytes in + ok O.{expression = Literal (Bytes s) ; type_annotation } | Literal (Number n) -> let%bind type_annotation = check O.t_int in ok O.{expression = Literal (Int n) ; type_annotation } @@ -214,4 +221,33 @@ and type_annotated_expression (e:environment) (ae:I.annotated_expression) : O.an @@ (fun () -> SMap.find ind r_tv) in let%bind type_annotation = check tv in ok O.{expression = O.Record_accessor (r', ind) ; type_annotation } - | _ -> simple_fail "default" + | Lambda { + binder ; + input_type ; + output_type ; + result ; + body ; + } -> + let%bind input_type = evaluate_type e input_type in + let%bind output_type = evaluate_type e output_type in + let e' = Environment.add e binder input_type in + let%bind result = type_annotated_expression e' result in + let%bind body = type_block e' body in + let%bind type_annotation = check O.(Type_function (input_type, output_type)) in + ok O.{expression = Lambda {binder;input_type;output_type;result;body} ; type_annotation} + | Constant (name, lst) -> + let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in + let tv_lst = List.map O.get_annotation lst' in + let%bind (name', tv) = type_constant name tv_lst in + let%bind type_annotation = check tv in + ok O.{expression = O.Constant (name', lst') ; type_annotation} + +and type_constant (name:string) (lst:O.type_value list) : (string * O.type_value) result = + (* Constant poorman's polymorphism *) + let open O in + match (name, lst) with + | "add", [a ; b] when a = t_int && b = t_int -> ok ("add_int", t_int) + | "add", [a ; b] when a = t_string && b = t_string -> ok ("concat_string", t_string) + | "add", [_ ; _] -> simple_fail "bad types to add" + | "add", _ -> simple_fail "bad number of params to add" + | _ -> simple_fail "unrecognized constant"