Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

AST check: add PPX for AST checker #14

Merged
merged 1 commit into from
Apr 20, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 15 additions & 5 deletions src/ast-check/ast_check.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,23 +14,34 @@ module Messages = struct
let tail_mod_cons =
"This is a use of the 'Tail Modulo Constructor' \
program transformation, which is not permitted"
let other = "The use of this feature is not permitted"
end

module Feature = struct
type t =
Array | Mutable_member | Object | Loop
| Primitive | Internal_name | Tail_mod_cons | Other
| Primitive | Internal_name | Tail_mod_cons

let identifiers = [
Array, "array";
Mutable_member, "mutable_member";
Object, "object";
Loop, "loop";
Primitive, "primitive";
Internal_name, "internal_name";
Tail_mod_cons, "tail_mod_cons";
]

let to_identifier feature = List.assoc feature identifiers
let of_identifier ident = List.find (fun (_, id) -> ident = id) identifiers |> fst

(* TODO: add TMC to AST-checker tests (needs executable to support flags) *)
(* TODO: remove Other? *)

module Set = Set.Make (struct type nonrec t = t let compare = compare end)

let all =
Set.of_list
[ Array; Mutable_member; Object; Loop;
Primitive; Internal_name; Tail_mod_cons; Other ]
Primitive; Internal_name; Tail_mod_cons ]

let minimum = Set.of_list [ Primitive; Internal_name ]
let default = Set.remove Tail_mod_cons all
Expand All @@ -45,7 +56,6 @@ module Feature = struct
| Primitive -> primitive
| Internal_name -> internal_name
| Tail_mod_cons -> tail_mod_cons
| Other -> other
end

type violation = {
Expand Down
9 changes: 8 additions & 1 deletion src/ast-check/ast_check.mli
Original file line number Diff line number Diff line change
Expand Up @@ -32,9 +32,16 @@ module Feature :
sig
type t =
Array | Mutable_member | Object | Loop
| Primitive | Internal_name | Tail_mod_cons | Other
| Primitive | Internal_name | Tail_mod_cons
module Set : Set.S with type elt = t

val to_identifier : t -> string
(** Unique identifier for this feature. *)

val of_identifier : string -> t
(** Provides the feature corresponding to a unique identifier
returned by {!to_identifier}. *)

val minimum : Set.t
(** {!Primitive} and {!Internal_name}, required to
prevent circumventing restrictions. *)
Expand Down
58 changes: 58 additions & 0 deletions src/ast-check/ast_check_ppx.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,58 @@
(** Use the AST check as a PPX rewriter, with arguments.
If further customization is needed, it's best to define a PPX
directly in the given exercise's repository instead. *)

open Ppxlib.Driver
open Ppxlib.Driver.V2
open Ast_check

let feature_identifiers =
Feature.all |> Feature.Set.to_list |> List.map Feature.to_identifier

let prohibited_features = ref Feature.default

let update_feature ~prohibit ident =
let open Feature in
prohibited_features :=
(if prohibit then Set.add else Set.remove)
(of_identifier ident) !prohibited_features

let feature_spec ~prohibit =
Arg.Symbol (feature_identifiers, update_feature ~prohibit)

let violation_limit = ref None

let strip_signatures = ref false

let () =
add_arg "-prohibit-feature"
(feature_spec ~prohibit:true)
~doc:" Prohibit the given feature";
add_arg "-allow-feature"
(feature_spec ~prohibit:false)
~doc:" Allow the given feature";
add_arg "-violation-limit"
(Arg.Int (fun l -> violation_limit := Some l))
~doc:" Maximum number of violations to report";
add_arg "-no-violation-limit"
(Arg.Unit (fun () -> violation_limit := None))
~doc:" Do not limit the number of reported violations (default)";

(* While the generated PPX has an argument to disable transformations,
there is no way to disable a transformation by default.
Therefore, we implement our own disabled-by-default behaviour. *)
add_arg "-strip-signatures"
(Arg.Set strip_signatures)
~doc:"Enable the signature stripping transformation";
add_arg "-no-strip-signatures"
(Arg.Clear strip_signatures)
~doc:"Disable the signature stripping transformation (default)";

register_transformation "ast_check"
~impl:(fun ctx ->
Ast_check.ast_violations_transformation
~prohibited:!prohibited_features ?limit:!violation_limit ctx);

register_transformation "strip_signatures"
~impl:(fun ctx ast ->
if !strip_signatures then Ast_check.strip_signatures ctx ast else ast)
10 changes: 8 additions & 2 deletions src/ast-check/dune
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
(library
(name ast_check)
(public_name less-power.ast-check)
(modules
(:standard \ ast_check_bin))
(modules ast_check)
(libraries
common
fmt
Expand All @@ -20,3 +19,10 @@
(package less-power)
(modules ast_check_bin)
(libraries common ast_check fmt))

(library
(name ast_check_ppx)
(public_name less-power.ast-check-ppx)
(kind ppx_rewriter)
(modules ast_check_ppx)
(libraries ppxlib ast_check))
Loading