Refactored typer tests + test for constructor
This commit is contained in:
parent
e184903a4f
commit
e58cf2a19d
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
@ -67,5 +65,7 @@ let main = "Typer (from simplified AST)", [
|
||||
test "bool" TestExpressions.bool ;
|
||||
test "string" TestExpressions.string ;
|
||||
test "bytes" TestExpressions.bytes ;
|
||||
test "tuple" TestExpressions.tuple ;
|
||||
test "constructor" TestExpressions.constructor ;
|
||||
test "record" TestExpressions.record ;
|
||||
]
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user