Skip to content

Commit a04d3f9

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 a7c327b commit a04d3f9

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
@@ -289,7 +289,7 @@ module type S = sig
289289
?sampler : (unit -> 'a * 'b * 'c) ->
290290
('a -> 'b -> 'c -> 'd Ty.ty -> 'd result -> Learnocaml_report.t) ->
291291
('a -> 'b -> 'c -> 'd) Ty.ty -> string -> ('a * 'b * 'c) list -> Learnocaml_report.t
292-
292+
293293
(*----------------------------------------------------------------------------*)
294294

295295
val test_function_4 :
@@ -348,16 +348,13 @@ module type S = sig
348348

349349
(*----------------------------------------------------------------------------*)
350350

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

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

@@ -374,16 +371,16 @@ module type S = sig
374371
?test_stdout: io_tester ->
375372
?test_stderr: io_tester ->
376373
?before :
377-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
374+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
378375
unit) ->
379376
?after :
380-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
377+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
381378
('ret * string * string) ->
382379
('ret * string * string) ->
383380
Learnocaml_report.t) ->
384-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
381+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
385382
('ar -> 'row) lookup ->
386-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args * (unit -> 'ret)) list ->
383+
(('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list ->
387384
Learnocaml_report.t
388385

389386
val test_function_against :
@@ -392,19 +389,19 @@ module type S = sig
392389
?test_stdout: io_tester ->
393390
?test_stderr: io_tester ->
394391
?before_reference :
395-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
392+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
396393
?before_user :
397-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
394+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
398395
?after :
399-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
396+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
400397
('ret * string * string) ->
401398
('ret * string * string) ->
402399
Learnocaml_report.t) ->
403400
?sampler:
404-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
405-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
401+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
402+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
406403
('ar -> 'row) lookup -> ('ar -> 'row) lookup ->
407-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
404+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
408405
Learnocaml_report.t
409406

410407
val test_function_against_solution :
@@ -413,19 +410,19 @@ module type S = sig
413410
?test_stdout: io_tester ->
414411
?test_stderr: io_tester ->
415412
?before_reference:
416-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
413+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
417414
?before_user:
418-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
415+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
419416
?after:
420-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
417+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
421418
'ret * string * string ->
422419
'ret * string * string ->
423420
Learnocaml_report.item list) ->
424421
?sampler:
425-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
426-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
422+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
423+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
427424
string ->
428-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
425+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
429426
Learnocaml_report.item list
430427

431428
val (==>) : 'params -> 'ret -> 'params * (unit -> 'ret)
@@ -1193,20 +1190,22 @@ module Make
11931190
11941191
(*----------------------------------------------------------------------------*)
11951192
1193+
include Fun_ty
1194+
11961195
(* The GADT [args] & [last, arg] are defined in [fun_ty.ml] *)
1196+
11971197
(* The GADT [fun_ty] &
11981198
[last_ty, arg_ty, ty_of_fun_ty, apply, get_ret_ty, print, get_sampler]
11991199
are defined in [fun_ty.ml] *)
12001200
1201-
let (!!) = Fun_ty.last
1202-
let (@:) = Fun_ty.arg
1203-
let (@:!!) a b = a @: !! b
1201+
let ty_of_prot = ty_of_fun_ty
1202+
[@@ocaml.deprecated "Use ty_of_fun_ty instead."]
12041203
12051204
module Aux = struct
12061205
let typed_printer = typed_printer
12071206
let typed_sampler = Introspection.get_sampler
12081207
end
1209-
module FunTyAux = Fun_ty.Make(Aux)
1208+
module FunTyAux = Make(Aux)
12101209
12111210
(*----------------------------------------------------------------------------*)
12121211

‎src/grader/test_lib.mli‎

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

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

11121108
(** {2 Lookup functions} *)
11131109

@@ -1135,16 +1131,16 @@ module type S = sig
11351131
?test_stdout: io_tester ->
11361132
?test_stderr: io_tester ->
11371133
?before :
1138-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1134+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11391135
unit) ->
11401136
?after :
1141-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1137+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11421138
('ret * string * string) ->
11431139
('ret * string * string) ->
11441140
Learnocaml_report.t) ->
1145-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1141+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11461142
('ar -> 'row) lookup ->
1147-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args * (unit -> 'ret)) list ->
1143+
(('ar -> 'row, 'ar -> 'urow, 'ret) args * (unit -> 'ret)) list ->
11481144
Learnocaml_report.t
11491145

11501146
(** [test_function_against ~gen ~test ~test_stdout ~test_stderr
@@ -1155,19 +1151,19 @@ module type S = sig
11551151
?test_stdout: io_tester ->
11561152
?test_stderr: io_tester ->
11571153
?before_reference :
1158-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1154+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11591155
?before_user :
1160-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1156+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11611157
?after :
1162-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1158+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11631159
('ret * string * string) ->
11641160
('ret * string * string) ->
11651161
Learnocaml_report.t) ->
11661162
?sampler:
1167-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
1168-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1163+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
1164+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11691165
('ar -> 'row) lookup -> ('ar -> 'row) lookup ->
1170-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
1166+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
11711167
Learnocaml_report.t
11721168

11731169
(** [test_function_against_solution ~gen ~test ~test_stdout ~test_stderr
@@ -1178,19 +1174,19 @@ module type S = sig
11781174
?test_stdout: io_tester ->
11791175
?test_stderr: io_tester ->
11801176
?before_reference:
1181-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1177+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11821178
?before_user:
1183-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args -> unit) ->
1179+
(('ar -> 'row, 'ar -> 'urow, 'ret) args -> unit) ->
11841180
?after:
1185-
(('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args ->
1181+
(('ar -> 'row, 'ar -> 'urow, 'ret) args ->
11861182
'ret * string * string ->
11871183
'ret * string * string ->
11881184
Learnocaml_report.item list) ->
11891185
?sampler:
1190-
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args) ->
1191-
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) Fun_ty.fun_ty ->
1186+
(unit -> ('ar -> 'row, 'ar -> 'urow, 'ret) args) ->
1187+
(('ar -> 'row) Ty.ty, 'ar -> 'urow, 'ret) fun_ty ->
11921188
string ->
1193-
('ar -> 'row, 'ar -> 'urow, 'ret) Fun_ty.args list ->
1189+
('ar -> 'row, 'ar -> 'urow, 'ret) args list ->
11941190
Learnocaml_report.item list
11951191

11961192
(** 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)