From e58cf2a19d6553e4092104f541d6e9788bc2c240 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= Date: Thu, 28 Mar 2019 15:07:59 +0100 Subject: [PATCH] Refactored typer tests + test for constructor --- src/ligo/ast_simplified.ml | 11 +++++++ src/ligo/ast_typed.ml | 4 +++ src/ligo/test/typer_tests.ml | 64 ++++++++++++++++++------------------ src/ligo/typer.ml | 8 +++++ 4 files changed, 55 insertions(+), 32 deletions(-) diff --git a/src/ligo/ast_simplified.ml b/src/ligo/ast_simplified.ml index 3000cb1ff..51b116164 100644 --- a/src/ligo/ast_simplified.ml +++ b/src/ligo/ast_simplified.ml @@ -717,6 +717,8 @@ end module Combinators = struct let annotated_expression ?type_annotation expression = {expression ; type_annotation} + let name (s : string) : name = s + let unit () : expression = Literal (Unit) let number n : expression = Literal (Number n) let bool b : expression = Literal (Bool b) @@ -724,9 +726,18 @@ module Combinators = struct let bytes b : expression = Literal (Bytes (Bytes.of_string b)) let tuple (lst : ae list) : expression = Tuple lst + let ez_tuple (lst : expression list) : expression = + tuple (List.map (fun e -> ae e) lst) + + let constructor (s : string) (e : ae) : expression = Constructor (name s, e) let 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 ez_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) end diff --git a/src/ligo/ast_typed.ml b/src/ligo/ast_typed.ml index 128c59609..c034b7f28 100644 --- a/src/ligo/ast_typed.ml +++ b/src/ligo/ast_typed.ml @@ -341,6 +341,10 @@ module Combinators = struct let t_sum m s : type_value = type_value (Type_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 aux prev (k, v) = SMap.add k v prev in + 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 diff --git a/src/ligo/test/typer_tests.ml b/src/ligo/test/typer_tests.ml index e7a1a9667..a7fb56e52 100644 --- a/src/ligo/test/typer_tests.ml +++ b/src/ligo/test/typer_tests.ml @@ -18,43 +18,41 @@ let int () : unit result = ok () module TestExpressions = struct - let test_expression (expr : expression) (test_expected_ty : Typed.tv) = + let test_expression ?(env = Typer.Environment.empty) + (expr : expression) + (test_expected_ty : Typed.tv) = let open Typer in let open Typed in let pre = ae @@ expr in - let e = Environment.empty in - let%bind post = type_annotated_expression e pre in + let%bind post = type_annotated_expression env pre in let%bind () = assert_type_value_eq (post.type_annotation, test_expected_ty) in ok () - open Simplified.Combinators - open Typed.Combinators + module I = Simplified.Combinators + module O = Typed.Combinators + module E = Typer.Environment.Combinators - let unit () : unit result = test_expression (unit ()) (make_t_unit) - let int () : unit result = test_expression (number 32) (make_t_int) - let bool () : unit result = test_expression (Simplified.Combinators.bool true) (make_t_bool) - let string () : unit result = test_expression (string "s") (make_t_string) - let bytes () : unit result = test_expression (bytes "b") (make_t_bytes) + 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 tuple () : unit result = - test_expression Simplified.Combinators.(tuple [ - ae @@ number 32 ; - ae @@ string "foo" ; - ]) - (make_t_tuple [ - make_t_int ; - make_t_string ; - ]) + 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)]) + I.(constructor "foo" (ae @@ number 32)) + O.(make_t_ez_sum [("foo", make_t_int); ("bar", make_t_string)]) let record () : unit result = - test_expression Simplified.Combinators.(record [ - ("foo", ae @@ number 32) ; - ("bar", ae @@ string "foo") ; - ]) - (make_t_ez_record [ - ("foo", make_t_int) ; - ("bar", make_t_string) ; - ]) + test_expression + I.(ez_record [("foo", number 32); ("bar", string "foo")]) + O.(make_t_ez_record [("foo", make_t_int); ("bar", make_t_string)]) end (* TODO: deep types (e.g. record of record) @@ -62,10 +60,12 @@ end let main = "Typer (from simplified AST)", [ test "int" int ; - test "unit" TestExpressions.unit ; - test "int2" TestExpressions.int ; - test "bool" TestExpressions.bool ; - test "string" TestExpressions.string ; - test "bytes" TestExpressions.bytes ; - test "record" TestExpressions.record ; + test "unit" TestExpressions.unit ; + test "int2" TestExpressions.int ; + test "bool" TestExpressions.bool ; + test "string" TestExpressions.string ; + test "bytes" TestExpressions.bytes ; + test "tuple" TestExpressions.tuple ; + test "constructor" TestExpressions.constructor ; + test "record" TestExpressions.record ; ] diff --git a/src/ligo/typer.ml b/src/ligo/typer.ml index d25537680..f3d8b36c5 100644 --- a/src/ligo/typer.ml +++ b/src/ligo/typer.ml @@ -14,6 +14,7 @@ module Environment = struct type_environment: (string * ele) list ; } let empty : t = { + (* TODO: use maps *) environment = [] ; type_environment = [] ; } @@ -50,6 +51,13 @@ module Environment = struct let full ppf e = fprintf ppf "%a\n%a" value e type_ e end + + module Combinators = struct + let env_sum_type ?(env = empty) + ?(name = "a_sum_type") + (lst : (string * ele) list) = + add env name (make_t_ez_sum lst) + end end type environment = Environment.t