Test for lambda
This commit is contained in:
parent
e58cf2a19d
commit
c6f74061ef
@ -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)
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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 ;
|
||||||
]
|
]
|
||||||
|
@ -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) =
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user