Add checks for misuse of -as-parameter

ocaml/typing/env.ml

@@ -993,6 +993,9 @@ let is_imported_opaque modname =
 let register_import_as_opaque modname =
   Persistent_env.register_import_as_opaque !persistent_env modname
 
+let is_parameter_unit modname =
+  Persistent_env.is_parameter_unit !persistent_env modname
+
 let reset_declaration_caches () =
   Types.Uid.Tbl.clear !value_declarations;
   Types.Uid.Tbl.clear !type_declarations;

ocaml/typing/env.mli

@@ -449,6 +449,10 @@ val is_imported_opaque: Compilation_unit.Name.t -> bool
 (* [register_import_as_opaque md] registers [md] as an opaque imported module *)
 val register_import_as_opaque: Compilation_unit.Name.t -> unit
 
+(* [is_parameter_unit md] returns true if [md] was compiled with
+   -as-parameter *)
+val is_parameter_unit: Compilation_unit.Name.t -> bool
+
 (* Summaries -- compact representation of an environment, to be
    exported in debugging information. *)
 

ocaml/typing/persistent_env.ml

@@ -392,6 +392,9 @@ let is_imported {imported_units; _} s =
 let is_imported_opaque {imported_opaque_units; _} s =
   CU.Name.Set.mem s !imported_opaque_units
 
+let is_parameter_unit penv s =
+  is_registered_parameter_import penv s
+
 let make_cmi penv modname kind sign alerts =
   let flags =
     List.concat [

ocaml/typing/persistent_env.mli

@@ -90,6 +90,10 @@ val is_imported_opaque : 'a t -> Compilation_unit.Name.t -> bool
    opaque module *)
 val register_import_as_opaque : 'a t -> Compilation_unit.Name.t -> unit
 
+(* [is_parameter_unit penv md] checks if [md] has been imported in [penv] and
+   was compiled as a parameter *)
+val is_parameter_unit : 'a t -> Compilation_unit.Name.t -> bool
+
 val make_cmi : 'a t
   -> Compilation_unit.t
   -> Cmi_format.kind

ocaml/typing/typemod.ml

@@ -86,6 +86,8 @@ type error =
   | Unpackable_local_modtype_subst of Path.t
   | With_cannot_remove_packed_modtype of Path.t * module_type
   | Toplevel_nonvalue of string * sort
+  | Cannot_implement_parameter of filepath
+  | Cannot_compile_implementation_as_parameter
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
@@ -3214,6 +3216,9 @@ let gen_annot outputprefix sourcefile annots =
     ~sourcefile:(Some sourcefile) ~use_summaries:false annots
 
 let type_implementation sourcefile outputprefix modulename initial_env ast =
+  let error e =
+    raise (Error (Location.in_file sourcefile, initial_env, e))
+  in
   Cmt_format.clear ();
   Misc.try_finally (fun () ->
       Typecore.reset_delayed_checks ();
@@ -3246,6 +3251,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
           signature = simple_sg
         } (* result is ignored by Compile.implementation *)
       end else begin
+        if !Clflags.as_parameter then
+          error Cannot_compile_implementation_as_parameter;
         let sourceintf =
           Filename.remove_extension sourcefile ^ !Config.interface_suffix in
         if Sys.file_exists sourceintf then begin
@@ -3258,6 +3265,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
                           Interface_not_compiled sourceintf)) in
           let dclsig =
             Env.read_signature modulename intf_file ~add_binding:false in
+          if Env.is_parameter_unit (Compilation_unit.name modulename) then
+            error (Cannot_implement_parameter intf_file);
           let coercion, shape =
             Profile.record_call "check_sig" (fun () ->
               Includemod.compunit initial_env ~mark:Mark_positive
@@ -3282,6 +3291,8 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
             signature = dclsig
           }
         end else begin
+          if !Clflags.as_parameter then
+            error Cannot_compile_implementation_as_parameter;
           Location.prerr_warning (Location.in_file sourcefile)
             Warnings.Missing_mli;
           let coercion, shape =
@@ -3634,6 +3645,14 @@ let report_error ~loc _env = function
       Location.errorf ~loc
         "@[Top-level module bindings must have layout value, but@ \
          %s has layout@ %a.@]" id Sort.format sort
+  | Cannot_implement_parameter path ->
+      Location.errorf ~loc
+        "@[Interface %s@ found for this unit is flagged as a parameter.@ \
+         It cannot be implemented directly. Use -as-argument-for instead.@]"
+        path
+  | Cannot_compile_implementation_as_parameter ->
+      Location.errorf ~loc
+        "Cannot compile an implementation with -as-parameter."
 
 let report_error env ~loc err =
   Printtyp.wrap_printing_env ~error:true env

ocaml/typing/typemod.mli

@@ -145,6 +145,8 @@ type error =
   | Unpackable_local_modtype_subst of Path.t
   | With_cannot_remove_packed_modtype of Path.t * module_type
   | Toplevel_nonvalue of string * sort
+  | Cannot_implement_parameter of Misc.filepath
+  | Cannot_compile_implementation_as_parameter
 
 exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error