From c6f74061ef4f7d473f13c3cc4d2f1a01efd27001 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Thu, 28 Mar 2019 17:24:12 +0100 Subject: [PATCH] Test for lambda --- src/ligo/ast_simplified.ml | 41 ++++++++++++++++++++++++++++++++++++ src/ligo/ast_typed.ml | 4 ++-- src/ligo/test/typer_tests.ml | 14 +++++++++--- src/ligo/transpiler.ml | 2 +- src/ligo/typer.ml | 2 +- 5 files changed, 56 insertions(+), 7 deletions(-) diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index 51b116164..aac2c4aa2 100644 --- a/src/ligo/ast_simplified.ml +++ b/src/ligo/ast_simplified.ml @@ -715,16 +715,57 @@ module Simplify = struct end module Combinators = struct + let t_bool : type_expression = Type_constant ("bool", []) + let t_string : type_expression = Type_constant ("string", []) + let t_bytes : type_expression = Type_constant ("bytes", []) + let t_int : type_expression = Type_constant ("int", []) + let t_unit : type_expression = Type_constant ("unit", []) + let t_tuple lst : type_expression = Type_tuple lst + let t_pair a b = t_tuple [a ; b] + let t_record m : type_expression = (Type_record m) + let t_ez_record (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 + Type_record map + + let t_record_ez lst = + let m = SMap.of_list lst in + t_record m + + let t_sum m : type_expression = Type_sum m + let make_t_ez_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 + Type_sum map + + let t_function param result : type_expression = Type_function (param, result) + let annotated_expression ?type_annotation expression = {expression ; type_annotation} let name (s : string) : name = s + let var (s : string) : expression = Variable s + let unit () : expression = Literal (Unit) let number n : expression = Literal (Number n) let bool b : expression = Literal (Bool b) let string s : expression = Literal (String s) let bytes b : expression = Literal (Bytes (Bytes.of_string b)) + let lambda (binder : string) + (input_type : type_expression) + (output_type : type_expression) + (result : expression) + (body : block) + : expression = + Lambda { + binder = (name binder) ; + input_type = input_type ; + output_type = output_type ; + result = (ae result) ; + body ; + } + let tuple (lst : ae list) : expression = Tuple lst let ez_tuple (lst : expression list) : expression = tuple (List.map (fun e -> ae e) lst) diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml index c034b7f28..22aa156f5 100644 --- a/src/ligo/ast_typed.ml +++ b/src/ligo/ast_typed.ml @@ -346,8 +346,8 @@ module Combinators = struct let map = List.fold_left aux SMap.empty lst in type_value (Type_sum map) None - let t_function (param, result) s : type_value = type_value (Type_function (param, result)) s - let make_t_function f = t_function f None + let t_function param result s : type_value = type_value (Type_function (param, result)) s + let make_t_function param result = t_function param result None let get_annotation (x:annotated_expression) = x.type_annotation diff --git a/src/ligo/test/typer_tests.ml b/src/ligo/test/typer_tests.ml index a7fb56e52..4cdab7c1e 100644 --- a/src/ligo/test/typer_tests.ml +++ b/src/ligo/test/typer_tests.ml @@ -38,16 +38,23 @@ module TestExpressions = struct 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 lambda () : unit result = + test_expression + I.(lambda "x" t_int t_int (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"]) O.(make_t_tuple [make_t_int; make_t_string]) let constructor () : unit result = - test_expression - ~env:(E.env_sum_type O.[("foo", make_t_int); ("bar", make_t_string)]) + let variant_foo_bar = + 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)) - O.(make_t_ez_sum [("foo", make_t_int); ("bar", make_t_string)]) + O.(make_t_ez_sum variant_foo_bar) let record () : unit result = test_expression @@ -68,4 +75,5 @@ let main = "Typer (from simplified AST)", [ test "tuple" TestExpressions.tuple ; test "constructor" TestExpressions.constructor ; test "record" TestExpressions.record ; + test "lambda" TestExpressions.lambda ; ] diff --git a/src/ligo/transpiler.ml b/src/ligo/transpiler.ml index 70b0ef073..16c50bdbc 100644 --- a/src/ligo/transpiler.ml +++ b/src/ligo/transpiler.ml @@ -266,7 +266,7 @@ let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value = output_type = t ; result = e ; body = [Skip] - }, Combinators.(make_t_function (make_t_unit, t)) + }, Combinators.(make_t_function make_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 f3d8b36c5..aa7457e85 100644 --- a/src/ligo/typer.ml +++ b/src/ligo/typer.ml @@ -329,7 +329,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 @@ make_t_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