Skip to content

Commit dd44150

Browse files
erikmderikmd
committed
refactor: Ensure the new interface is backward-compatible
* test_lib.mli: Move notations (!!), (@:) to fun_ty.mli; Put some [include (module type of Fun_ty)] instead. * Therefore: no need for [open Fun_ty] in existing n-ary graders code. * Add a deprecated synonym so that the renaming of Test_lib.ty_of_prot to Test_lib.ty_of_fun_ty yields no backward-compatibility issue.
1 parent 205dc63 commit dd44150

File tree

4 files changed

+74
-59
lines changed

4 files changed

+74
-59
lines changed

‎src/grader/test_lib.ml‎

Lines changed: 30 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -290,7 +290,7 @@ module type S = sig
290290
?sampler : (unit -> 'a * 'b * 'c) ->
291291
('a -> 'b -> 'c -> 'd Ty.ty -> 'd result -> Learnocaml_report.t) ->
292292
('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> Learnocaml_report.t
293-
293+
294294
(*----------------------------------------------------------------------------*)
295295

296296
val test_function_4 :
@@ -349,16 +349,13 @@ module type S = sig
349349

350350
(*----------------------------------------------------------------------------*)
351351

352-
val (!!) :
353-
'a ->
354-
('a -> 'ret, 'a -> unit, 'ret) Fun_ty.args
355-
val (@:) :
356-
'a ->
357-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
358-
('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) Fun_ty.args
359-
val (@:!!) :
360-
'a -> 'b ->
361-
('a -> 'b -> 'ret, 'a -> 'b -> unit, 'ret) Fun_ty.args
352+
include (module type of Fun_ty
353+
with type ('a, 'b, 'c) args = ('a, 'b, 'c) Fun_ty.args
354+
and type ('a, 'b, 'c) fun_ty = ('a, 'b, 'c) Fun_ty.fun_ty)
355+
356+
val ty_of_prot :
357+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> ('ar -> 'row) Ty.ty
358+
[@@ocaml.deprecated "Use ty_of_fun_ty instead."]
362359

363360
type 'a lookup = unit -> [ `Found of string * Learnocaml_report.t * 'a | `Unbound of string * Learnocaml_report.t ]
364361

@@ -375,16 +372,16 @@ module type S = sig
375372
?test_stdout: io_tester ->
376373
?test_stderr: io_tester ->
377374
?before :
378-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
375+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
379376
unit) ->
380377
?after :
381-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
378+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
382379
('ret * string * string) ->
383380
('ret * string * string) ->
384381
Learnocaml_report.t) ->
385-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
382+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
386383
('ar -> 'row) lookup ->
387-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args * (unit -> 'ret)) list ->
384+
(('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list ->
388385
Learnocaml_report.t
389386

390387
val test_function_against :
@@ -393,19 +390,19 @@ module type S = sig
393390
?test_stdout: io_tester ->
394391
?test_stderr: io_tester ->
395392
?before_reference :
396-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
393+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
397394
?before_user :
398-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
395+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
399396
?after :
400-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
397+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
401398
('ret * string * string) ->
402399
('ret * string * string) ->
403400
Learnocaml_report.t) ->
404401
?sampler:
405-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
406-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
402+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
403+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
407404
('ar -> 'row) lookup -> ('ar -> 'row) lookup ->
408-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
405+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
409406
Learnocaml_report.t
410407

411408
val test_function_against_solution :
@@ -414,19 +411,19 @@ module type S = sig
414411
?test_stdout: io_tester ->
415412
?test_stderr: io_tester ->
416413
?before_reference:
417-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
414+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
418415
?before_user:
419-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
416+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
420417
?after:
421-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
418+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
422419
'ret * string * string ->
423420
'ret * string * string ->
424421
Learnocaml_report.item list) ->
425422
?sampler:
426-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
427-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
423+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
424+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
428425
string ->
429-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
426+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
430427
Learnocaml_report.item list
431428

432429
val (==>) : 'params -> 'ret -> 'params * (unit -> 'ret)
@@ -1196,20 +1193,22 @@ module Make
11961193
11971194
(*----------------------------------------------------------------------------*)
11981195
1196+
include Fun_ty
1197+
11991198
(* The GADT [args] & [last, arg] are defined in [fun_ty.ml] *)
1199+
12001200
(* The GADT [fun_ty] &
12011201
[last_ty, arg_ty, ty_of_fun_ty, apply, get_ret_ty, print, get_sampler]
12021202
are defined in [fun_ty.ml] *)
12031203
1204-
let (!!) = Fun_ty.last
1205-
let (@:) = Fun_ty.arg
1206-
let (@:!!) a b = a @: !! b
1204+
let ty_of_prot = ty_of_fun_ty
1205+
[@@ocaml.deprecated "Use ty_of_fun_ty instead."]
12071206
12081207
module Aux = struct
12091208
let typed_printer = typed_printer
12101209
let typed_sampler = Introspection.get_sampler
12111210
end
1212-
module FunTyAux = Fun_ty.Make(Aux)
1211+
module FunTyAux = Make(Aux)
12131212
12141213
(*----------------------------------------------------------------------------*)
12151214

‎src/grader/test_lib.mli‎

Lines changed: 23 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1102,17 +1102,13 @@ module type S = sig
11021102
can be returned. *)
11031103
val result : (unit -> 'a) -> 'a result
11041104

1105-
(** Helper notations for [Fun_ty.args] *)
1106-
val (!!) :
1107-
'a ->
1108-
('a -> 'ret, 'a -> unit, 'ret) Fun_ty.args
1109-
val (@:) :
1110-
'a ->
1111-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1112-
('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) Fun_ty.args
1113-
val (@:!!) :
1114-
'a -> 'b ->
1115-
('a -> 'b -> 'ret, 'a -> 'b -> unit, 'ret) Fun_ty.args
1105+
include (module type of Fun_ty
1106+
with type ('a, 'b, 'c) args = ('a, 'b, 'c) Fun_ty.args
1107+
and type ('a, 'b, 'c) fun_ty = ('a, 'b, 'c) Fun_ty.fun_ty)
1108+
1109+
val ty_of_prot :
1110+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty -> ('ar -> 'row) Ty.ty
1111+
[@@ocaml.deprecated "Use ty_of_fun_ty instead."]
11161112

11171113
(** {2 Lookup functions} *)
11181114

@@ -1140,16 +1136,16 @@ module type S = sig
11401136
?test_stdout: io_tester ->
11411137
?test_stderr: io_tester ->
11421138
?before :
1143-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1139+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11441140
unit) ->
11451141
?after :
1146-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1142+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11471143
('ret * string * string) ->
11481144
('ret * string * string) ->
11491145
Learnocaml_report.t) ->
1150-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1146+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11511147
('ar -> 'row) lookup ->
1152-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args * (unit -> 'ret)) list ->
1148+
(('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list ->
11531149
Learnocaml_report.t
11541150

11551151
(** [test_function_against ~gen ~test ~test_stdout ~test_stderr
@@ -1160,19 +1156,19 @@ module type S = sig
11601156
?test_stdout: io_tester ->
11611157
?test_stderr: io_tester ->
11621158
?before_reference :
1163-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1159+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11641160
?before_user :
1165-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1161+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11661162
?after :
1167-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1163+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11681164
('ret * string * string) ->
11691165
('ret * string * string) ->
11701166
Learnocaml_report.t) ->
11711167
?sampler:
1172-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
1173-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1168+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
1169+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11741170
('ar -> 'row) lookup -> ('ar -> 'row) lookup ->
1175-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
1171+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
11761172
Learnocaml_report.t
11771173

11781174
(** [test_function_against_solution ~gen ~test ~test_stdout ~test_stderr
@@ -1183,19 +1179,19 @@ module type S = sig
11831179
?test_stdout: io_tester ->
11841180
?test_stderr: io_tester ->
11851181
?before_reference:
1186-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1182+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11871183
?before_user:
1188-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1184+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11891185
?after:
1190-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1186+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11911187
'ret * string * string ->
11921188
'ret * string * string ->
11931189
Learnocaml_report.item list) ->
11941190
?sampler:
1195-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
1196-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1191+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
1192+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11971193
string ->
1198-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
1194+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
11991195
Learnocaml_report.item list
12001196

12011197
(** Helper notation to test pure functions.

‎src/ppx-metaquot/fun_ty.ml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,10 @@ type (_, _, _) args =
1515
let last x = Last x
1616
let arg x r = Arg (x, r)
1717

18+
let (!!) = last
19+
let (@:) = arg
20+
let (@:!!) a b = a @: !! b
21+
1822
let rec apply
1923
: type p a c r. (p -> a) -> (p -> a, p -> c, r) args -> r = fun f x ->
2024
match x with

‎src/ppx-metaquot/fun_ty.mli‎

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,13 +32,29 @@ val last :
3232
'a ->
3333
('a -> 'ret, 'a -> unit, 'ret) args
3434

35-
(** [arg e l], or equivalently [e @: l], adds [e] in front of the
35+
(** [arg a l], or equivalently [a @: l], adds [a] in front of the
3636
argument list [l] *)
3737
val arg :
3838
'a ->
3939
('ar -> 'row, 'ar -> 'urow, 'ret) args ->
4040
('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) args
4141

42+
(** Helper notation for [last] *)
43+
val (!!) :
44+
'a ->
45+
('a -> 'ret, 'a -> unit, 'ret) args
46+
47+
(** Helper notation for [arg] *)
48+
val (@:) :
49+
'a ->
50+
('ar -> 'row, 'ar -> 'urow, 'ret) args ->
51+
('a -> 'ar -> 'row, 'a -> 'ar -> 'urow, 'ret) args
52+
53+
(** [a @:!! l] is another notation for [a @: !! l] (with a space) *)
54+
val (@:!!) :
55+
'a -> 'b ->
56+
('a -> 'b -> 'ret, 'a -> 'b -> unit, 'ret) args
57+
4258
(** [apply f l] applies a n-ary function [f] to the arguments from [l] *)
4359
val apply :
4460
('ar -> 'row) -> ('ar -> 'row, 'ar -> 'urow, 'ret) args ->

0 commit comments

Comments
 (0)