Re-implement in terms of parse_term

No need for Ignore since it's desugared to some gensym'd variable

1 files changed, 35 insertions, 25 deletions

diff --git a/rego-proofs/compiler-rewrite/bin/main.ml b/rego-proofs/compiler-rewrite/bin/main.ml
index 6d36fc7..d97bb55 100644
--- a/rego-proofs/compiler-rewrite/bin/main.ml
+++ b/rego-proofs/compiler-rewrite/bin/main.ml
@@ -31,19 +31,18 @@ and reference = ref_target * (ref_arg list)
 [@@deriving show]
 and ref_target = Var of string
                | Array of term list
-               | Object of (object_key * object_key)
+               | Object of (object_key * term) list
                | Set of term list
                | ArrayComprehension of term * query
-               | ObjectComprehension of ((object_key * term) * query)
+               | ObjectComprehension of (object_key * term) * query
                | SetComprehension of term * query
-               | Call of (string list) * (term list)
+               | Call of reference * (term list)
 [@@deriving show]
 and ref_arg = Scalar of scalar
             | Var of string
             | Array of term list
-            | Object of (object_key * object_key)
+            | Object of (object_key * term) list
             | Set of term list
-            | Ignore
 [@@deriving show]
 and object_key = Scalar of scalar
                | Ref of reference
@@ -94,25 +93,6 @@ let to_list_or_empty : Yojson.Basic.t -> Yojson.Basic.t list = function
   | `List xs -> xs
   | _ -> failwith "Not a list or null"
 
-(* --- *)
-
-let parse_ref_target tree : ref_target =
-  match (tree |> member "type" |> to_string) with
-  | "var" -> Var (tree |> member "value" |> to_string)
-  | _ -> failwith "unimplemented"
-
-let parse_ref_arg tree : ref_arg =
-  match (tree |> member "type" |> to_string) with
-  | "string" -> Scalar (String (tree |> member "value" |> to_string))
-  | _ -> failwith "unimplemented"
-
-let parse_ref tree =
-  match tree with
-  | target :: args -> (parse_ref_target target, List.map ~f:parse_ref_arg args)
-  | _ -> failwith "empty reference"
-
-(* --- *)
-
 let object_key_of_term : term -> object_key = function
   | Scalar s -> Scalar s
   | Ref r -> Ref r
@@ -154,7 +134,6 @@ let rec parse_term (tree : Yojson.Basic.t) : term =
   | _ -> failwith ("unsupported term type " ^ term_type)
 
 and parse_expr tree : expr =
-  print_endline (Yojson.Basic.to_string tree);
   match tree |> member "terms" with
   | `List (func :: args) ->
      Call (func |> member "value" |> to_list |> parse_ref,
@@ -162,6 +141,37 @@ and parse_expr tree : expr =
   | `List _ -> failwith "todo"
   | 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))
+
+and parse_ref_arg tree : ref_arg =
+  let term = parse_term tree in
+  match term with
+  | Scalar x -> Scalar x
+  | Var x -> Var x
+  | Array x -> Array x
+  | Object x -> Object x
+  | Set x -> Set x
+  | _ -> failwith ("unsupported ref_arg " ^ (show_term term))
+
+and parse_ref tree =
+  match tree with
+  | target :: args -> (parse_ref_target target, List.map ~f:parse_ref_arg args)
+  | _ -> failwith "empty reference"
+
 let parse_head tree =
   (* Variables are desugared to empty references. *)
   let lhs = tree |> member "ref" |> to_list |> parse_ref in