Test for lambda
This commit is contained in:
parent
e58cf2a19d
commit
c6f74061ef
@ -715,16 +715,57 @@ module Simplify = struct
|
||||
end
|
||||
|
||||
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 name (s : string) : name = s
|
||||
|
||||
let var (s : string) : expression = Variable s
|
||||
|
||||
let unit () : expression = Literal (Unit)
|
||||
let number n : expression = Literal (Number n)
|
||||
let bool b : expression = Literal (Bool b)
|
||||
let string s : expression = Literal (String s)
|
||||
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 ez_tuple (lst : expression list) : expression =
|
||||
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
|
||||
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
|
||||
let t_function param result s : type_value = type_value (Type_function (param, result)) s
|
||||
let make_t_function param result = t_function param result None
|
||||
|
||||
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 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 =
|
||||
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)])
|
||||
let variant_foo_bar =
|
||||
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))
|
||||
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 =
|
||||
test_expression
|
||||
@ -68,4 +75,5 @@ let main = "Typer (from simplified AST)", [
|
||||
test "tuple" TestExpressions.tuple ;
|
||||
test "constructor" TestExpressions.constructor ;
|
||||
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 ;
|
||||
result = e ;
|
||||
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 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%bind (body, e'') = type_block_full e' body 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}
|
||||
| Constant (name, lst) ->
|
||||
let%bind lst' = bind_list @@ List.map (type_annotated_expression e) lst in
|
||||
|
Loading…
Reference in New Issue
Block a user