Fix monomorphization

compiler/lcalc/monomorphize.ml

@@ -240,12 +240,28 @@ let rec monomorphize_expr
       | __ -> failwith "should not happen"
     in
     Expr.einj ~name:option_instance.name ~e:new_e1 ~cons:new_cons (Mark.get e)
+    (* We do not forget to tweak types stored directly in the AST in the nodes
+       of kind [EAbs], [EApp] and [EAppOp]. *)
+  | EAbs { binder; tys } ->
+    let new_tys = List.map (monomorphize_typ monomorphized_instances) tys in
+    let vars, body = Bindlib.unmbind binder in
+    let new_body = monomorphize_expr monomorphized_instances body in
+    Expr.make_abs vars new_body new_tys (Expr.pos e)
+  | EApp { f; args; tys } ->
+    let new_f = monomorphize_expr monomorphized_instances f in
+    let new_args = List.map (monomorphize_expr monomorphized_instances) args in
+    let new_tys = List.map (monomorphize_typ monomorphized_instances) tys in
+    Expr.eapp ~f:new_f ~args:new_args ~tys:new_tys (Mark.get e)
+  | EAppOp { op; args; tys } ->
+    let new_args = List.map (monomorphize_expr monomorphized_instances) args in
+    let new_tys = List.map (monomorphize_typ monomorphized_instances) tys in
+    Expr.eappop ~op ~args:new_args ~tys:new_tys (Mark.get e)
   | _ -> Expr.map ~f:(monomorphize_expr monomorphized_instances) e
 
 let program (prg : typed program) :
     untyped program * Scopelang.Dependency.TVertex.t list =
   let monomorphized_instances = collect_monomorphized_instances prg in
-  (* First we augment the [decl_ctx] with the option instances *)
+  (* First we augment the [decl_ctx] with the monomorphized instances *)
   let prg =
     {
       prg with
@@ -276,6 +292,18 @@ let program (prg : typed program) :
         };
     }
   in
+  (* And we remove the polymorphic option type *)
+  let prg =
+    {
+      prg with
+      decl_ctx =
+        {
+          prg.decl_ctx with
+          ctx_enums =
+            EnumName.Map.remove Expr.option_enum prg.decl_ctx.ctx_enums;
+        };
+    }
+  in
   (* Then we replace all hardcoded types and expressions with the monomorphized
      instances *)
   let prg =

compiler/shared_ast/print.ml

@@ -867,7 +867,7 @@ let struct_
     fmt
     (pp_name : Format.formatter -> unit)
     (c : typ StructField.Map.t) =
-  Format.fprintf fmt "@[<hv 2>%a %t %a %a@ %a@;<1 -2>%a@]@," keyword "type"
+  Format.fprintf fmt "@[<hv 2>%a %t %a %a@ %a@;<1 -2>%a@]" keyword "type"
     pp_name punctuation "=" punctuation "{"
     (StructField.Map.format_bindings ~pp_sep:Format.pp_print_space
        (fun fmt pp_n ty ->
@@ -879,7 +879,7 @@ let struct_
 let decl_ctx ?(debug = false) decl_ctx (fmt : Format.formatter) (ctx : decl_ctx)
     : unit =
   let { ctx_enums; ctx_structs; _ } = ctx in
-  Format.fprintf fmt "@[<v>%a@;@;%a@] @;"
+  Format.fprintf fmt "%a@.%a@.@."
     (EnumName.Map.format_bindings (enum ~debug decl_ctx))
     ctx_enums
     (StructName.Map.format_bindings (struct_ ~debug decl_ctx))

compiler/shared_ast/typing.ml

@@ -439,8 +439,6 @@ and typecheck_expr_top_down :
     (a, m) A.gexpr ->
     (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 (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