Complete parse_term

No need for membership since it's just sugar for internal.member_2

1 files changed, 46 insertions, 13 deletions

diff --git a/rego-proofs/compiler-rewrite/bin/main.ml b/rego-proofs/compiler-rewrite/bin/main.ml
index 609d608..ca6fa62 100644
--- a/rego-proofs/compiler-rewrite/bin/main.ml
+++ b/rego-proofs/compiler-rewrite/bin/main.ml
@@ -17,28 +17,28 @@ and reference = ref_target * (ref_arg list)
 [@@deriving show]
 and ref_target = Var of string
                 | Array of term list
-                | Object of (object_item * object_item)
+                | Object of (object_key * object_key)
                 | Set of term list
                 | ArrayComprehension of term * query
-                | ObjectComprehension of object_item * query
+                | ObjectComprehension of ((object_key * term) * query)
                 | SetComprehension of term * query
                 | Call of (string list) * (term list)
 [@@deriving show]
 and ref_arg = Scalar of scalar
              | Var of string
              | Array of term list
-             | Object of (object_item * object_item)
+             | Object of (object_key * object_key)
              | Set of term list
              | Ignore
 [@@deriving show]
-and object_item = Scalar of scalar | Ref of reference | Var
+and object_key = Scalar of scalar | Ref of reference | Var of string
 [@@deriving show]
 and ref_item = Var of string
               | Array of term list
-              | Object of (object_item * object_item) list
+              | Object of (object_key * object_key) list
               | Set of term list
               | ArrayComprehension of term * query
-              | ObjectComprehension of object_item * query
+              | ObjectComprehension of (object_key * term) * query
               | SetComprehension of term * query
               | Call of (string list) * (term list)
 [@@deriving show]
@@ -46,11 +46,10 @@ and term = Ref of reference
           | Var of string
           | Scalar of scalar
           | Array of term list
-          | Object of (object_item * object_item) list
+          | Object of (object_key * object_key) list
           | Set of term list
-          | Membership of (term list) * term
           | ArrayComprehension of term * query
-          | ObjectComprehension of object_item * query
+          | ObjectComprehension of (object_key * term) * query
           | SetComprehension of term * query
 [@@deriving show]
 and infix_operator = BoolEq
@@ -144,13 +143,47 @@ let parse_ref tree =
 
 (* --- *)
 
-let parse_term (tree : Yojson.Basic.t) : term =
-  match tree |> member "type" |> to_string with
+let object_key_of_term : term -> object_key = function
+  | Scalar s -> Scalar s
+  | Ref r -> Ref r
+  | Var v -> Var v
+  | _ -> failwith "failed to convert term to object_key"
+
+let rec parse_term (tree : Yojson.Basic.t) : term =
+  let term_type = tree |> member "type" |> to_string in
+  match term_type with
+  | "var" -> Var (tree |> member "value" |> to_string)
+  | "ref" -> Ref (tree |> member "value" |> to_list |> parse_ref)
   | "boolean" -> Scalar (Bool (tree |> member "value" |> to_bool))
   | "number" -> Scalar (Number (tree |> member "value" |> to_number))
-  | _ -> failwith "unimplemented"
+  | "string" -> Scalar (String (tree |> member "value" |> to_string))
+  | "array" -> Array (tree |> member "value" |> to_list |> List.map ~f:parse_term)
+  | "set" -> Set (tree |> member "value" |> to_list |> List.map ~f:parse_term)
+  | "object" ->
+     Object
+       (tree
+        |> member "value"
+        |> to_list
+        |> List.map ~f:(function | `List [x; y] ->
+                                    (x |> parse_term |> object_key_of_term,
+                                     y |> parse_term |> object_key_of_term)
+                                 | _ -> failwith "ill-formed object"))
+  | "arraycomprehension" ->
+     ArrayComprehension
+       (tree |> member "value" |> member "term" |> parse_term,
+        tree |> member "value" |> member "body" |> to_list |> List.map ~f:(fun x -> (parse_expr x, None)))
+  | "setcomprehension" ->
+     SetComprehension
+       (tree |> member "value" |> member "term" |> parse_term,
+        tree |> member "value" |> member "body" |> to_list |> List.map ~f:(fun x -> (parse_expr x, None)))
+  | "objectcomprehension" ->
+     ObjectComprehension
+       ((tree |> member "value" |> member "key" |> parse_term |> object_key_of_term,
+         tree |> member "value" |> member "value" |> parse_term),
+        tree |> member "value" |> member "body" |> to_list |> List.map ~f:(fun x -> (parse_expr x, None)))
+  | _ -> failwith ("unsupported term type " ^ term_type)
 
-let parse_expr tree : expr =
+and parse_expr tree : expr =
   print_endline (Yojson.Basic.to_string tree);
   match tree |> member "terms" with
   | `List (func :: args) ->