CatalaLang/catala
1
1
Fork 0
mirror of https://github.com/CatalaLang/catala.git synced 2024-09-19 16:28:12 +03:00
Code Issues Projects Releases Wiki Activity

The typer doesn't handle monomorphised code yet

Browse Source 
so don't retype after monomorphisation, which is now possible as the pass itself
correctly preserves types.

In time the typer will need a special case to get knowledge of the new types and
modified operator types.
This commit is contained in:
Louis Gesbert 2024-02-06 17:51:42 +01:00
parent df70c5dd57
commit ea512bfd5b
3 changed files with 12 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/driver.ml
View File

@ -238,15 +238,13 @@ module Passes = struct
Message.raise_error Message.raise_error
"Option --avoid-exceptions is not compatible with option --trace" "Option --avoid-exceptions is not compatible with option --trace"
| true, _, Untyped _ -> | true, _, Untyped _ ->
Lcalc.From_dcalc.translate_program_without_exceptions Lcalc.From_dcalc.translate_program_without_exceptions prg
(Shared_ast.Typing.program ~leave_unresolved:ErrorOnAny prg)
| true, _, Typed _ -> | true, _, Typed _ ->
Lcalc.From_dcalc.translate_program_without_exceptions prg Lcalc.From_dcalc.translate_program_without_exceptions prg
| false, _, Typed _ -> | false, _, Typed _ ->
Lcalc.From_dcalc.translate_program_with_exceptions prg Lcalc.From_dcalc.translate_program_with_exceptions prg
| false, _, Untyped _ -> | false, _, Untyped _ ->
Lcalc.From_dcalc.translate_program_with_exceptions Lcalc.From_dcalc.translate_program_with_exceptions prg
(Shared_ast.Typing.program ~leave_unresolved:ErrorOnAny prg)
| _, _, Custom _ -> invalid_arg "Driver.Passes.lcalc" | _, _, Custom _ -> invalid_arg "Driver.Passes.lcalc"
in in
let prg = let prg =
@ -275,10 +273,11 @@ module Passes = struct
let prg, type_ordering = let prg, type_ordering =
if monomorphize_types then ( if monomorphize_types then (
Message.emit_debug "Monomorphizing types..."; Message.emit_debug "Monomorphizing types...";
let prg, type_ordering = Lcalc.Monomorphize.program prg in Lcalc.Monomorphize.program prg
Message.emit_debug "Retyping lambda calculus..."; (* (* FIXME: typing no longer works after monomorphisation, it would
let prg = Typing.program ~leave_unresolved:ErrorOnAny prg in * need special operator handling for arrays and options *)
prg, type_ordering) * Message.emit_debug "Retyping lambda calculus...";
* let prg = Typing.program ~leave_unresolved:LeaveAny prg in *))
else prg, type_ordering else prg, type_ordering
in in
prg, type_ordering prg, type_ordering

4
compiler/lcalc/monomorphize.ml
View File

@ -243,9 +243,7 @@ let rec monomorphize_expr
let tup_ty = let tup_ty =
match e0 with ETupleAccess { e; _ }, _ -> Expr.ty e | _ -> assert false match e0 with ETupleAccess { e; _ }, _ -> Expr.ty e | _ -> assert false
in in
let tuple_instance = let tuple_instance = Type.Map.find tup_ty monomorphized_instances.tuples in
Type.Map.find tup_ty monomorphized_instances.tuples
in
EStructAccess EStructAccess
{ {
name = tuple_instance.name; name = tuple_instance.name;

11
compiler/shared_ast/typing.ml
View File

@ -297,6 +297,7 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
let it = lazy (UnionFind.make (TLit TInt, pos)) in let it = lazy (UnionFind.make (TLit TInt, pos)) in
let cet = lazy (UnionFind.make (TClosureEnv, pos)) in let cet = lazy (UnionFind.make (TClosureEnv, pos)) in
let array a = lazy (UnionFind.make (TArray (Lazy.force a), 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 ( @-> ) x y = let ( @-> ) x y =
lazy (UnionFind.make (TArrow (List.map Lazy.force x, Lazy.force y), pos)) lazy (UnionFind.make (TArrow (List.map Lazy.force x, Lazy.force y), pos))
in in
@ -312,13 +313,9 @@ let polymorphic_op_type (op : Operator.polymorphic A.operator Mark.pos) :
| Log (PosRecordIfTrueBool, _) -> [bt] @-> bt | Log (PosRecordIfTrueBool, _) -> [bt] @-> bt
| Log _ -> [any] @-> any | Log _ -> [any] @-> any
| Length -> [array any] @-> it | Length -> [array any] @-> it
(* The [HandleDefault] and [HandleDefaultOpt] need to be typed before and | HandleDefault -> [array ([ut] @-> any); [ut] @-> bt; [ut] @-> any] @-> any
after the Lcalc monomorphization which affects arrays and option types. | HandleDefaultOpt ->
Because of that, we give the operators very lax typing rules with [any] [array (option any); [ut] @-> bt; [ut] @-> option any] @-> option any
but it doesn't matter for unification because the concrete types on which
they will be instantiated are stored in the [EAppOp] node. *)
| HandleDefault -> [any2; [ut] @-> bt; [ut] @-> any] @-> any
| HandleDefaultOpt -> [any2; [ut] @-> bt; [ut] @-> any] @-> any
| ToClosureEnv -> [any] @-> cet | ToClosureEnv -> [any] @-> cet
| FromClosureEnv -> [cet] @-> any | FromClosureEnv -> [cet] @-> any
in in