There are no more defaults in type after compile_with_exceptions...

This commit is contained in:
Denis Merigoux 2023-12-18 15:14:28 +01:00
parent 91f8451899
commit 4eead4850b
No known key found for this signature in database
GPG Key ID: EE99DCFA365C3EE3
2 changed files with 9 additions and 13 deletions

View File

@ -294,7 +294,7 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
let cet = lazy (UnionFind.make (TClosureEnv, pos)) in
let array a = lazy (UnionFind.make (TArray (Lazy.force a), pos)) in
let option a = lazy (UnionFind.make (TOption (Lazy.force a), pos)) in
let default a = lazy (UnionFind.make (TDefault (Lazy.force a), pos)) in
let _default a = lazy (UnionFind.make (TDefault (Lazy.force a), pos)) in
let ( @-> ) x y =
lazy (UnionFind.make (TArrow (List.map Lazy.force x, Lazy.force y), pos))
in
@ -309,8 +309,7 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
| Log (PosRecordIfTrueBool, _) -> [bt] @-> bt
| Log _ -> [any] @-> any
| Length -> [array any] @-> it
| HandleDefault ->
[array ([ut] @-> default any); [ut] @-> bt; [ut] @-> any] @-> default any
| HandleDefault -> [array ([ut] @-> any); [ut] @-> bt; [ut] @-> any] @-> any
| HandleDefaultOpt ->
[array (option any); [ut] @-> bt; [ut] @-> option any] @-> option any
| ToClosureEnv -> [any] @-> cet
@ -442,7 +441,7 @@ and typecheck_expr_top_down :
(a, unionfind_typ A.custom) A.boxed_gexpr =
fun ~leave_unresolved ctx env tau e ->
(* Message.emit_debug "Propagating type %a for naked_expr %a" (format_typ ctx)
tau (Expr.format ctx) e; *)
tau (Print.expr ~debug:true ()) e; *)
let pos_e = Expr.pos e in
let () =
(* If there already is a type annotation on the given expr, ensure it
@ -688,10 +687,7 @@ and typecheck_expr_top_down :
Expr.escopecall ~scope ~args:args' mark
| A.ERaise ex -> Expr.eraise ex context_mark
| A.ECatch { body; exn; handler } ->
let body' =
typecheck_expr_top_down ~leave_unresolved ctx env
(unionfind (TDefault tau)) body
in
let body' = typecheck_expr_top_down ~leave_unresolved ctx env tau body in
let handler' =
typecheck_expr_top_down ~leave_unresolved ctx env tau handler
in

View File

@ -143,7 +143,7 @@ let S2_6 (S2_in_11: S2_in) =
decl temp_a_20 : unit → bool;
let temp_a_20 (__21 : unit) =
return false;
decl temp_a_14 : unit → decimal;
decl temp_a_14 : unit → decimal;
let temp_a_14 (__15 : unit) =
decl temp_a_18 : unit → decimal;
let temp_a_18 (__19 : unit) =
@ -168,7 +168,7 @@ let S3_7 (S3_in_24: S3_in) =
decl temp_a_33 : unit → bool;
let temp_a_33 (__34 : unit) =
return false;
decl temp_a_27 : unit → decimal;
decl temp_a_27 : unit → decimal;
let temp_a_27 (__28 : unit) =
decl temp_a_31 : unit → decimal;
let temp_a_31 (__32 : unit) =
@ -193,7 +193,7 @@ let S4_8 (S4_in_37: S4_in) =
decl temp_a_46 : unit → bool;
let temp_a_46 (__47 : unit) =
return false;
decl temp_a_40 : unit → decimal;
decl temp_a_40 : unit → decimal;
let temp_a_40 (__41 : unit) =
decl temp_a_44 : unit → decimal;
let temp_a_44 (__45 : unit) =
@ -218,7 +218,7 @@ let S_9 (S_in_50: S_in) =
decl temp_a_71 : unit → bool;
let temp_a_71 (__72 : unit) =
return false;
decl temp_a_65 : unit → decimal;
decl temp_a_65 : unit → decimal;
let temp_a_65 (__66 : unit) =
decl temp_a_69 : unit → decimal;
let temp_a_69 (__70 : unit) =
@ -240,7 +240,7 @@ let S_9 (S_in_50: S_in) =
decl temp_b_60 : unit → bool;
let temp_b_60 (__61 : unit) =
return false;
decl temp_b_54 : unit → A {y: bool; z: decimal};
decl temp_b_54 : unit → A {y: bool; z: decimal};
let temp_b_54 (__55 : unit) =
decl temp_b_58 : unit → A {y: bool; z: decimal};
let temp_b_58 (__59 : unit) =