refactor: Replace "prot" with "fun_ty" as suggested by @yurug

Author: erikmd

demo-repository/exercises/demo/test.ml

@@ -22,16 +22,16 @@ let () =
     Section
       ([ Text "Function:" ; Code "divide" ],
        test_function_against_solution
-         [%prot: int -> int -> int] "divide"
+         [%funty: int -> int -> int] "divide"
          [ 16 @:!! 4 ;
            12 @:!! 5 ;
            3 @:!! 0 ]) ;
     Section
     ([ Text "Function:" ; Code "sum3" ],
        test_function_against_solution
-         ~gen:2                 (* only 2 random test cases *)
-         [%prot: int -> int -> int -> int] (* function type *)
-         "sum3"                            (* function name *)
+         ~gen:2                  (* only 2 random test cases *)
+         [%funty: int -> int -> int -> int] (* function type *)
+         "sum3"                             (* function name *)
          (* list of additional, explicit test cases *)
          [ 10 @: 20 @:!! 30 ;
            -1 @: -2 @:!! -3 ])

src/grader/dune

@@ -104,7 +104,7 @@
         %{ocaml-config:standard_library}/compiler-libs/parse.cmi)
        (:generated-cmis
         ../ppx-metaquot/.ty.objs/ty.cmi
-        ../ppx-metaquot/.prot.objs/prot.cmi
+        ../ppx-metaquot/.fun_ty.objs/fun_ty.cmi
         .testing.objs/introspection_intf.cmi
         .learnocaml_report.objs/learnocaml_report.cmi
         .testing.objs/test_lib.cmi))

src/grader/test_lib.ml

@@ -1097,17 +1097,17 @@ module type S = sig
         can be returned. *)
     val result : (unit -> 'a) -> 'a result
 
-    (** Helper notations for [Prot.args] *)
+    (** Helper notations for [Fun_ty.args] *)
     val (!!) :
       'a ->
-      ('a -> 'ret, 'a -> unit, 'ret) Prot.args
+      ('a -> 'ret, 'a -> unit, 'ret) Fun_ty.args
     val (@:) :
       'a ->
-      ('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args ->
-      ('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) Prot.args
+      ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
+      ('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) Fun_ty.args
     val (@:!!) :
       'a -> 'b ->
-      ('a -> 'b -> 'ret, 'a -> 'b -> unit, 'ret) Prot.args
+      ('a -> 'b -> 'ret, 'a -> 'b -> unit, 'ret) Fun_ty.args
 
     (** {2 Lookup functions} *)
 
@@ -1135,16 +1135,16 @@ module type S = sig
       ?test_stdout: io_tester ->
       ?test_stderr: io_tester ->
       ?before :
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
          unit) ->
       ?after :
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
          ('ret * string * string) ->
          ('ret * string * string) ->
          Learnocaml_report.t) ->
-      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Prot.prot ->
+      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
       ('ar -> 'row) lookup ->
-      (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args * (unit -> 'ret)) list ->
+      (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args * (unit -> 'ret)) list ->
       Learnocaml_report.t
 
     (** [test_function_against ~gen ~test ~test_stdout ~test_stderr
@@ -1155,19 +1155,19 @@ module type S = sig
       ?test_stdout: io_tester ->
       ?test_stderr: io_tester ->
       ?before_reference :
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args -> unit) ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
       ?before_user :
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args -> unit) ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
       ?after :
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
          ('ret * string * string) ->
          ('ret * string * string) ->
          Learnocaml_report.t) ->
       ?sampler:
-        (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args) ->
-      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Prot.prot ->
+        (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
+      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
       ('ar -> 'row) lookup -> ('ar -> 'row) lookup ->
-      ('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args list ->
+      ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
       Learnocaml_report.t
 
     (** [test_function_against_solution ~gen ~test ~test_stdout ~test_stderr
@@ -1178,27 +1178,27 @@ module type S = sig
       ?test_stdout: io_tester ->
       ?test_stderr: io_tester ->
       ?before_reference:
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args -> unit) ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
       ?before_user:
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args -> unit) ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
       ?after:
-        (('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args ->
+        (('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
          'ret * string * string ->
          'ret * string * string ->
          Learnocaml_report.item list) ->
       ?sampler:
-        (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args) ->
-      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Prot.prot ->
+        (unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
+      (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
       string ->
-      ('ar -> 'row, 'ar -> 'urow, 'ret) Prot.args list ->
+      ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
       Learnocaml_report.item list
 
     (** Helper notation to test pure functions.
 
         [p ==> r] is the pair [(p, fun () -> r)].
 
         Example: [test_function prot
-                  (lookup_student (ty_of_prot prot) name)
+                  (lookup_student (ty_of_fun_ty prot) name)
                   [1 @: 2 @: 3 @: 4 @:!! 5 ==> 15; ... ==> ...]] *)
     val (==>) : 'params -> 'ret -> 'params * (unit -> 'ret)
   end

src/grader/test_lib.mli

@@ -23,7 +23,7 @@
 (library
  (name learnocaml_ppx_metaquot)
  (wrapped false)
- (libraries learnocaml_ppx_metaquot_lib ty prot ocaml-migrate-parsetree)
+ (libraries learnocaml_ppx_metaquot_lib ty fun_ty ocaml-migrate-parsetree)
  (modules Ppx_metaquot_main)
  (kind ppx_rewriter)
 )
@@ -37,9 +37,9 @@
 )
 
 (library
- (name prot)
+ (name fun_ty)
  (wrapped false)
  (library_flags :standard -linkall)
- (modules Prot)
+ (modules Fun_ty)
  (libraries ty)
 )

src/ppx-metaquot/dune

@@ -15,24 +15,30 @@ type (_, _, _) args =
 let last x = Last x
 let arg x r = Arg (x, r)
 
-let rec apply : type p a c r. (p -> a) -> (p -> a, p -> c, r) args -> r = fun f x ->
+let rec apply
+        : type p a c r. (p -> a) -> (p -> a, p -> c, r) args -> r = fun f x ->
   match x with
   | Last x -> f x
   | Arg (x, Last r) -> (f x) r
   | Arg (x, Arg (y, r)) -> apply (f x) (Arg (y, r))
 
-(* Usage: arg_ty [%ty: int] @@ arg_ty [%ty: string] @@ last_ty [%ty: bool] [%ty: unit] *)
-type (_, _, _) prot =
-  | Last_ty : 'a Ty.ty * 'r Ty.ty -> (('a -> 'r) Ty.ty, 'a -> unit, 'r) prot
-  | Arg_ty : 'a Ty.ty * (('b -> 'c) Ty.ty, 'b -> 'd, 'r) prot -> (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) prot
+(* Usage:
+   arg_ty [%ty: int] @@ arg_ty [%ty: string] @@ last_ty [%ty: bool] [%ty: unit]
+ *)
+type (_, _, _) fun_ty =
+  | Last_ty : 'a Ty.ty * 'r Ty.ty -> (('a -> 'r) Ty.ty, 'a -> unit, 'r) fun_ty
+  | Arg_ty : 'a Ty.ty * (('b -> 'c) Ty.ty, 'b -> 'd, 'r) fun_ty ->
+             (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) fun_ty
 
 let last_ty x r = Last_ty (x, r)
 let arg_ty x r = Arg_ty (x, r)
 
-let rec ty_of_prot : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> (p -> a) Ty.ty  = function
+let rec ty_of_fun_ty
+        : type p a c r. ((p -> a) Ty.ty, p -> c, r) fun_ty -> (p -> a) Ty.ty =
+  function
   | Last_ty (a, b) -> Ty.curry a b
   | Arg_ty (x, Last_ty (l, r)) -> Ty.curry x (Ty.curry l r)
-  | Arg_ty (x, Arg_ty (y, r)) -> Ty.curry x (ty_of_prot (Arg_ty (y, r)))
+  | Arg_ty (x, Arg_ty (y, r)) -> Ty.curry x (ty_of_fun_ty (Arg_ty (y, r)))
 
 let rec get_ret_ty
         : type p a c r. (p -> a) Ty.ty -> (p -> a, p -> c, r) args -> r Ty.ty =
@@ -55,7 +61,8 @@ end
 
 module Make (M : S) = struct
   let rec print
-          : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> Format.formatter -> (p -> a, p -> c, r) args -> unit =
+          : type p a c r. ((p -> a) Ty.ty, p -> c, r) fun_ty ->
+                 Format.formatter -> (p -> a, p -> c, r) args -> unit =
     fun t ppf x ->
     match t, x with
     | Last_ty (arg_ty, _), Last x ->
@@ -72,7 +79,8 @@ module Make (M : S) = struct
     | Last_ty (_, _), Arg (_, _) -> .
 
   let rec get_sampler
-          : type p a c r. ((p -> a) Ty.ty, p -> c, r) prot -> unit -> (p -> a, p -> c, r) args =
+          : type p a c r. ((p -> a) Ty.ty, p -> c, r) fun_ty -> unit ->
+                 (p -> a, p -> c, r) args =
     fun wit ->
     match wit with
     | Last_ty (x, _) ->

src/ppx-metaquot/prot.ml renamed to src/ppx-metaquot/fun_ty.ml

@@ -8,9 +8,9 @@
 
 (** Library of heterogeneous, nonempty lists and their corresponding types.
 
-    let p = [%prot: int -> bool]
+    let p = [%funty: int -> bool]
 
-    val p : ((int -> bool) Ty.ty, int -> unit, bool) Prot.prot = <abstr>
+    val p : ((int -> bool) Ty.ty, int -> unit, bool) Fun_ty.fun_ty = <abstr>
 *)
 
 (** The type of arguments, represented as heterogeneous lists.
@@ -36,18 +36,18 @@ val apply : ('ar -> 'row) -> ('ar -> 'row, 'ar -> 'urow, 'ret) args -> 'ret
     [arg_ty [%ty: int]
      @@ arg_ty [%ty: string] @@ last_ty [%ty: bool] [%ty: unit]]
 *)
-type ('arrow, 'uarrow, 'ret) prot
+type ('arrow, 'uarrow, 'ret) fun_ty
 val last_ty :
   'a Ty.ty ->
   'ret Ty.ty ->
-  (('a -> 'ret) Ty.ty, 'a -> unit, 'ret) prot
+  (('a -> 'ret) Ty.ty, 'a -> unit, 'ret) fun_ty
 val arg_ty :
   'a Ty.ty ->
-  (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot ->
-  (('a -> 'ar -> 'row) Ty.ty, ('a -> 'ar -> 'urow), 'ret) prot
+  (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
+  (('a -> 'ar -> 'row) Ty.ty, ('a -> 'ar -> 'urow), 'ret) fun_ty
 
-val ty_of_prot :
-  (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) prot -> ('ar -> 'row) Ty.ty
+val ty_of_fun_ty :
+  (('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> ('ar -> 'row) Ty.ty
 val get_ret_ty :
   ('p -> 'a) Ty.ty -> ('p -> 'a, 'p -> 'c, 'ret) args -> 'ret Ty.ty
 
@@ -58,10 +58,10 @@ end
 
 module Make : functor (M : S) -> sig
   val print :
-    (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot ->
+    (('p -> 'a) Ty.ty, 'p -> 'c, 'r) fun_ty ->
     Format.formatter -> ('p -> 'a, 'p -> 'c, 'r) args -> unit
   val get_sampler :
-    (('p -> 'a) Ty.ty, 'p -> 'c, 'r) prot ->
+    (('p -> 'a) Ty.ty, 'p -> 'c, 'r) fun_ty ->
     unit -> ('p -> 'a, 'p -> 'c, 'r) args
 end
 

src/ppx-metaquot/prot.mli renamed to src/ppx-metaquot/fun_ty.mli

@@ -207,30 +207,30 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct
          [Nolabel, tyexpr])
       (Typ.constr ty_id [cty])
 
-  let prot_of this l e =
+  let fun_ty_of this l e =
     (* Naming convention: ty:=Ty.ty, cty:=core_type, ety:=expression *)
     let glob_cty = get_typ l e in
     match glob_cty with
     | { Parsetree.ptyp_desc = Parsetree.Ptyp_arrow (_, arg0, next) ; _ } ->
        (* OK: The type expression is an arrow type *)
        (* Recursion over [core_type]s: *)
-       let rec get_prot_of arg0 next =
+       let rec get_fun_ty_of arg0 next =
          match next with
          | { Parsetree.ptyp_desc = Parsetree.Ptyp_arrow (_, arg', next') ; _ } ->
-            let prot_next, ucty, ret = get_prot_of arg' next' in
-            (* Arg_ty (arg0, prot_next) : (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) *)
-            let cons_arg_id = Location.mknoloc Longident.(Ldot (Lident "Prot", "arg_ty")) in
+            let fun_ty_next, ucty, ret = get_fun_ty_of arg' next' in
+            (* Arg_ty (arg0, fun_ty_next) : (('a -> 'b -> 'c) Ty.ty, 'a -> 'b -> 'd, 'r) *)
+            let cons_arg_id = Location.mknoloc Longident.(Ldot (Lident "Fun_ty", "arg_ty")) in
             let arg0_ety = ty_of this arg0 in
             let ucty = Typ.arrow Nolabel arg0 ucty in
             (Exp.apply
                (Exp.apply
                   (Exp.ident cons_arg_id)
                   [Nolabel, arg0_ety])
-               [Nolabel, prot_next],
+               [Nolabel, fun_ty_next],
              ucty, ret)
          | _ ->
-            (* Last_ty (arg0, next) : (('a -> 'r) Ty.ty, 'a -> unit, 'r) prot *)
-            let cons_last_id = Location.mknoloc Longident.(Ldot (Lident "Prot", "last_ty")) in
+            (* Last_ty (arg0, next) : (('a -> 'r) Ty.ty, 'a -> unit, 'r) fun_ty *)
+            let cons_last_id = Location.mknoloc Longident.(Ldot (Lident "Fun_ty", "last_ty")) in
             let arg0_ety = ty_of this arg0 in
             let next_ety = ty_of this next in
             let unit_id = Location.mknoloc (Longident.Lident "unit") in
@@ -244,15 +244,15 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct
              ucty, next)
        in
        (* Main branch *)
-       let prot_next, ucty, ret = get_prot_of arg0 next in
-       (* prot_next : (('a -> 'b -> 'r) Ty.ty, 'a -> 'b -> unit, 'r) [typecast] *)
-       let prot_id = Location.mknoloc Longident.(Ldot (Lident "Prot", "prot")) in
+       let fun_ty_next, ucty, ret = get_fun_ty_of arg0 next in
+       (* fun_ty_next : (('a -> 'b -> 'r) Ty.ty, 'a -> 'b -> unit, 'r) [typecast] *)
+       let fun_ty_id = Location.mknoloc Longident.(Ldot (Lident "Fun_ty", "fun_ty")) in
        let ty_id = Location.mknoloc Longident.(Ldot (Lident "Ty", "ty")) in
        let glob_cty_ty = Typ.constr ty_id [glob_cty] in
        Exp.constraint_
-         prot_next
-         (Typ.constr prot_id [glob_cty_ty; ucty; ret])
-    | _ -> invalid_arg "prot_of: not an arrow type"
+         fun_ty_next
+         (Typ.constr fun_ty_id [glob_cty_ty; ucty; ret])
+    | _ -> invalid_arg "fun_ty_of: not an arrow type"
   (* ------ </edited for learn-ocaml> ------ *)
 
   let expander _args =
@@ -276,8 +276,8 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct
            | Pexp_extension({txt="ty";loc=l}, e) ->
               let ty = get_typ l e in
               ty_of this ty
-           | Pexp_extension({txt="prot";loc=l}, e) ->
-              prot_of this l e
+           | Pexp_extension({txt="funty";loc=l}, e) ->
+              fun_ty_of this l e
 (* ------ </edited for learn-ocaml> ------ *)
            | _ ->
                super.expr this e