balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactored typer tests + test for constructor

Browse Source
This commit is contained in:
Georges Dupéron 2019-03-28 15:07:59 +01:00
parent e184903a4f
commit e58cf2a19d
4 changed files with 55 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/ligo/ast_simplified.ml
View File

@ -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

4
src/ligo/ast_typed.ml
View File

@ -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

64
src/ligo/test/typer_tests.ml
View File

@ -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 ;
]

8
src/ligo/typer.ml
View File

@ -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