Last commit before allowing calls as expressions

This flies in the face of the grammar [1] but is accepted by the reference implementation...

[1]: https://www.openpolicyagent.org/docs/latest/policy-reference/#grammar

1 files changed, 28 insertions, 14 deletions

diff --git a/rego-proofs/compiler-rewrite/bin/main.ml b/rego-proofs/compiler-rewrite/bin/main.ml
index d97bb55..2d4811c 100644
--- a/rego-proofs/compiler-rewrite/bin/main.ml
+++ b/rego-proofs/compiler-rewrite/bin/main.ml
@@ -100,6 +100,7 @@ let object_key_of_term : term -> object_key = function
   | _ -> failwith "failed to convert term to object_key"
 
 let rec parse_term (tree : Yojson.Basic.t) : term =
+  Printf.printf "%s: %s\n" "parse_term" (Yojson.Basic.to_string tree);
   let term_type = tree |> member "type" |> to_string in
   match term_type with
   | "var" -> Var (tree |> member "value" |> to_string)
@@ -134,6 +135,7 @@ let rec parse_term (tree : Yojson.Basic.t) : term =
   | _ -> failwith ("unsupported term type " ^ term_type)
 
 and parse_expr tree : expr =
+  Printf.printf "%s: %s\n" "parse_expr" (Yojson.Basic.to_string tree);
   match tree |> member "terms" with
   | `List (func :: args) ->
      Call (func |> member "value" |> to_list |> parse_ref,
@@ -142,22 +144,27 @@ and parse_expr tree : expr =
   | x -> Term (parse_term x)
 
 and parse_ref_target tree : ref_target =
-  let expr = parse_expr tree in
-  match expr with
-  | Call (x, y) -> Call (x, y)
-  | Term x ->
-     (match x with
-      | Var x -> Var x
-      | Array x -> Array x
-      | Object x -> Object x
-      | Set x -> Set x
-      | ArrayComprehension (x, y) -> ArrayComprehension (x, y)
-      | ObjectComprehension (x, y) -> ObjectComprehension (x, y)
-      | SetComprehension (x, y) -> SetComprehension (x, y)
-      | _ -> failwith ("unsupported ref_target " ^ (show_term x)))
-   | _ -> failwith ("unsupported ref_target " ^ (show_expr expr))
+  Printf.printf "%s: %s\n" "parse_ref_target" (Yojson.Basic.to_string tree);
+  if String.equal (tree |> member "type" |> to_string) "call" then
+    match tree |> member "value" |> to_list with
+    | func :: args ->
+       Call (func |> member "value" |> to_list |> parse_ref,
+             List.map ~f:parse_term args)
+    | _ -> failwith "ill_formed call"
+  else
+     let term = parse_term tree in
+     match term with
+     | Var term -> Var term
+     | Array term -> Array term
+     | Object term -> Object term
+     | Set term -> Set term
+     | ArrayComprehension (term, y) -> ArrayComprehension (term, y)
+     | ObjectComprehension (term, y) -> ObjectComprehension (term, y)
+     | SetComprehension (term, y) -> SetComprehension (term, y)
+     | _ -> failwith ("unsupported ref_target " ^ (show_term term))
 
 and parse_ref_arg tree : ref_arg =
+  Printf.printf "%s: %s\n" "parse_ref_arg" (Yojson.Basic.to_string tree);
   let term = parse_term tree in
   match term with
   | Scalar x -> Scalar x
@@ -168,11 +175,13 @@ and parse_ref_arg tree : ref_arg =
   | _ -> failwith ("unsupported ref_arg " ^ (show_term term))
 
 and parse_ref tree =
+  Printf.printf "%s: %s\n" "parse_ref" (String.concat (List.map ~f:Yojson.Basic.to_string tree));
   match tree with
   | target :: args -> (parse_ref_target target, List.map ~f:parse_ref_arg args)
   | _ -> failwith "empty reference"
 
 let parse_head tree =
+  Printf.printf "%s: %s\n" "parse_head" (Yojson.Basic.to_string tree);
   (* Variables are desugared to empty references. *)
   let lhs = tree |> member "ref" |> to_list |> parse_ref in
   let rhs =
@@ -184,6 +193,7 @@ let parse_head tree =
   in (lhs, rhs)
 
 let rec parse_rule tree =
+  Printf.printf "%s: %s\n" "rec parse_rule tree" (Yojson.Basic.to_string tree);
   { default = tree |> member "default" |> to_bool_or_false;
     head = tree |> member "head" |> parse_head;
     body = List.map ~f:(fun x -> ((parse_expr x, None) : literal)) (tree |> member "body" |> to_list_or_empty);
@@ -196,11 +206,13 @@ let rec parse_rule tree =
 (* --- *)
 
 let parse_import_path tree =
+  Printf.printf "%s: %s\n" "parse_import_path" (Yojson.Basic.to_string tree);
   match (tree |> member "type" |> to_string) with
   | "ref" -> tree |> member "value" |> to_list |> parse_ref
   | _ -> failwith "unimplemented"
 
 let parse_import tree =
+  Printf.printf "%s: %s\n" "parse_import" (Yojson.Basic.to_string tree);
   { alias = tree |> member "alias" |> to_string_option;
     path = tree |> member "path" |> parse_import_path
   }
@@ -208,11 +220,13 @@ let parse_import tree =
 (* --- *)
 
 let parse_package tree =
+  Printf.printf "%s: %s\n" "parse_package" (Yojson.Basic.to_string tree);
   tree |> member "path" |> to_list |> parse_ref
 
 (* --- *)
 
 let parse_tree tree =
+  Printf.printf "%s: %s\n" "parse_tree" (Yojson.Basic.to_string tree);
   { path = tree |> member "package" |> parse_package;
     imports = List.map ~f:parse_import (tree |> member "imports" |> to_list_or_empty);
     policy = List.map ~f:parse_rule (tree |> member "rules" |> to_list_or_empty)