Test for lambda

This commit is contained in:
Georges Dupéron 2019-03-28 17:24:12 +01:00
parent e58cf2a19d
commit c6f74061ef
5 changed files with 56 additions and 7 deletions

View File

@ -715,16 +715,57 @@ module Simplify = struct
end end
module Combinators = struct 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 annotated_expression ?type_annotation expression = {expression ; type_annotation}
let name (s : string) : name = s let name (s : string) : name = s
let var (s : string) : expression = Variable s
let unit () : expression = Literal (Unit) let unit () : expression = Literal (Unit)
let number n : expression = Literal (Number n) let number n : expression = Literal (Number n)
let bool b : expression = Literal (Bool b) let bool b : expression = Literal (Bool b)
let string s : expression = Literal (String s) let string s : expression = Literal (String s)
let bytes b : expression = Literal (Bytes (Bytes.of_string b)) 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 tuple (lst : ae list) : expression = Tuple lst
let ez_tuple (lst : expression list) : expression = let ez_tuple (lst : expression list) : expression =
tuple (List.map (fun e -> ae e) lst) tuple (List.map (fun e -> ae e) lst)

View File

@ -346,8 +346,8 @@ module Combinators = struct
let map = List.fold_left aux SMap.empty lst in let map = List.fold_left aux SMap.empty lst in
type_value (Type_sum map) None type_value (Type_sum map) None
let t_function (param, result) s : type_value = type_value (Type_function (param, result)) s 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 make_t_function param result = t_function param result None
let get_annotation (x:annotated_expression) = x.type_annotation let get_annotation (x:annotated_expression) = x.type_annotation

View File

@ -38,16 +38,23 @@ module TestExpressions = struct
let string () : unit result = test_expression I.(string "s") O.make_t_string 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 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 = let tuple () : unit result =
test_expression test_expression
I.(ez_tuple [number 32; string "foo"]) I.(ez_tuple [number 32; string "foo"])
O.(make_t_tuple [make_t_int; make_t_string]) O.(make_t_tuple [make_t_int; make_t_string])
let constructor () : unit result = let constructor () : unit result =
test_expression let variant_foo_bar =
~env:(E.env_sum_type O.[("foo", make_t_int); ("bar", make_t_string)]) 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)) 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 = let record () : unit result =
test_expression test_expression
@ -68,4 +75,5 @@ let main = "Typer (from simplified AST)", [
test "tuple" TestExpressions.tuple ; test "tuple" TestExpressions.tuple ;
test "constructor" TestExpressions.constructor ; test "constructor" TestExpressions.constructor ;
test "record" TestExpressions.record ; test "record" TestExpressions.record ;
test "lambda" TestExpressions.lambda ;
] ]

View File

@ -266,7 +266,7 @@ let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value =
output_type = t ; output_type = t ;
result = e ; result = e ;
body = [Skip] 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 translate_entry (lst:AST.program) (name:string) : anon_function result =
let rec aux acc (lst:AST.program) = let rec aux acc (lst:AST.program) =

View File

@ -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 e' = Environment.add e binder input_type in
let%bind (body, e'') = type_block_full e' body in let%bind (body, e'') = type_block_full e' body in
let%bind result = type_annotated_expression e'' result 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} ok O.{expression = Lambda {binder;input_type;output_type;result;body} ; type_annotation}
| Constant (name, lst) -> | Constant (name, lst) ->
let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in