From b454420d19ebf7b948da558ca6cd845988ec2d7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Sylvestre?= Date: Sat, 10 Jul 2021 21:51:52 +0200 Subject: [PATCH 1/3] embed compiler-libs/pprintast into the grading environment --- src/grader/build.ocp | 1 + src/grader/dune | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/grader/build.ocp b/src/grader/build.ocp index 160e195f8..35f02dcc1 100644 --- a/src/grader/build.ocp +++ b/src/grader/build.ocp @@ -38,6 +38,7 @@ embedded_grading_cmis = [ "%{compiler-libs_FULL_DST_DIR}%/parsetree.cmi" "%{compiler-libs_FULL_DST_DIR}%/location.cmi" "%{compiler-libs_FULL_DST_DIR}%/parse.cmi" + "%{compiler-libs_FULL_DST_DIR}%/pprintast.cmi" "%{ty_FULL_DST_DIR}%/ty.cmi" "%{testing_FULL_DST_DIR}%/introspection_intf.cmi" "%{learnocaml-report_FULL_DST_DIR}%/learnocaml_report.cmi" diff --git a/src/grader/dune b/src/grader/dune index 587a1ede7..dab921da4 100644 --- a/src/grader/dune +++ b/src/grader/dune @@ -123,7 +123,8 @@ %{ocaml-config:standard_library}/compiler-libs/ast_mapper.cmi %{ocaml-config:standard_library}/compiler-libs/parsetree.cmi %{ocaml-config:standard_library}/compiler-libs/location.cmi - %{ocaml-config:standard_library}/compiler-libs/parse.cmi) + %{ocaml-config:standard_library}/compiler-libs/parse.cmi + %{ocaml-config:standard_library}/compiler-libs/pprintast.cmi) (:generated-cmis ../ppx-metaquot/.ty.objs/byte/ty.cmi ../ppx-metaquot/.fun_ty.objs/byte/fun_ty.cmi From 4f19e87134be344637bf8f788873a473324e1a6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Sylvestre?= Date: Sun, 11 Jul 2021 00:27:20 +0200 Subject: [PATCH 2/3] add a ppx shortcut to avoid code duplication for printable_fun (cf. issue #379) --- src/ppx-metaquot/ppx_metaquot.ml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/ppx-metaquot/ppx_metaquot.ml b/src/ppx-metaquot/ppx_metaquot.ml index 0be96060c..d932c35d2 100644 --- a/src/ppx-metaquot/ppx_metaquot.ml +++ b/src/ppx-metaquot/ppx_metaquot.ml @@ -253,6 +253,13 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct fun_ty_next (Typ.constr fun_ty_id [glob_cty_ty; ucty; ret]) | _ -> invalid_arg "fun_ty_of: not an arrow type" + + let printable_of this e = + (* [%printable e] is a shortcut for + (Test_lib.printable_fun e (Pprintast.string_of_expression [%expr e])) *) + app (evar "Test_lib.printable_fun") + [app (evar "Pprintast.string_of_expression") + [(exp_lifter !loc this) # lift_Parsetree_expression e]; e] (* ------ ------ *) let expander _args = @@ -278,6 +285,8 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct ty_of this ty | Pexp_extension({txt="funty";loc=l}, e) -> fun_ty_of this l e + | Pexp_extension({txt="printable";loc=l}, e) -> + printable_of this (get_exp l e) (* ------ ------ *) | _ -> super.expr this e From 04c0f62f2cdd2ec50f2b5d392cb02a4a4ddd38db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lo=C3=AFc=20Sylvestre?= Date: Sun, 11 Jul 2021 00:29:31 +0200 Subject: [PATCH 3/3] add a ppx shortcut [%code e] to build the tuple (Code.(e), Solution.(e), [%expr e]) --- src/ppx-metaquot/ppx_metaquot.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/ppx-metaquot/ppx_metaquot.ml b/src/ppx-metaquot/ppx_metaquot.ml index d932c35d2..e8209a674 100644 --- a/src/ppx-metaquot/ppx_metaquot.ml +++ b/src/ppx-metaquot/ppx_metaquot.ml @@ -260,6 +260,16 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct app (evar "Test_lib.printable_fun") [app (evar "Pprintast.string_of_expression") [(exp_lifter !loc this) # lift_Parsetree_expression e]; e] + + let code_of this e = + (* [%code e] is a shortcut for (Code.(e), Solution.(e), [%expr e]) *) + let open_module name e = + Exp.open_ Fresh (lid name) e + (* since 4.08, use (Exp.open_ (Opn.mk (Mod.ident (lid name))) e) instead *) + in + tuple [open_module "Code" e; + open_module "Solution" e; + (exp_lifter !loc this) # lift_Parsetree_expression e] (* ------ ------ *) let expander _args = @@ -287,6 +297,8 @@ module Main : sig val expander: string list -> Ast_mapper.mapper end = struct fun_ty_of this l e | Pexp_extension({txt="printable";loc=l}, e) -> printable_of this (get_exp l e) + | Pexp_extension({txt="code";loc=l}, e) -> + code_of this (get_exp l e) (* ------ ------ *) | _ -> super.expr this e