Refactor equality

1 files changed, 33 insertions, 24 deletions

diff --git a/xacml-proofs/compiler/bin/main.ml b/xacml-proofs/compiler/bin/main.ml
index a4661b9..d797e47 100644
--- a/xacml-proofs/compiler/bin/main.ml
+++ b/xacml-proofs/compiler/bin/main.ml
@@ -73,7 +73,7 @@ let get_exn opt message =
   | _ -> failwith message
 
 let rec get_attr (needle : string) : (string * string) list -> string option = function
-  | (k, v) :: xs -> if String.equal k needle then Some v else get_attr needle xs
+  | (k, v) :: xs -> if String.(k = needle) then Some v else get_attr needle xs
   | _ -> None
 
 let get_attr_exn needle attrs : string =
@@ -81,7 +81,7 @@ let get_attr_exn needle attrs : string =
 
 let rec get_children (kind : string) : Xml.xml list -> xml_element list = function
   | (Element ((tag_name, _, _) as x)) :: xs ->
-     if String.equal tag_name kind
+     if String.(tag_name = kind)
      then x :: get_children kind xs
      else get_children kind xs
   | PCData s :: xs -> get_children kind xs
@@ -180,7 +180,7 @@ let compile_primitive kind value : lean_expression =
 
 let compile_attribute_value (elt : xml_element) : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "AttributeValue");
+  assert (String.(tag_name = "AttributeValue"));
   let kind = get_attr_exn "DataType" attrs in
   match List.nth_exn children 0 with
   | PCData value -> compile_primitive kind value
@@ -188,7 +188,7 @@ let compile_attribute_value (elt : xml_element) : lean_expression =
 
 let compile_attribute_designator (elt : xml_element) : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "AttributeDesignator");
+  assert (String.(tag_name = "AttributeDesignator"));
   let category = get_attr_exn "Category" attrs in
   let identifier = get_attr_exn "AttributeId" attrs in
   let kind = get_attr_exn "DataType" attrs in
@@ -207,7 +207,7 @@ let compile_attribute_designator (elt : xml_element) : lean_expression =
 
 let compile_match (elt : xml_element) : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "Match");
+  assert (String.(tag_name = "Match"));
   let alg_id = get_attr_exn "MatchId" attrs in
   let value = get_child_exn "AttributeValue" children in
   let designator = get_child_exn "AttributeDesignator" children in
@@ -219,19 +219,19 @@ let compile_match (elt : xml_element) : lean_expression =
 
 let compile_all_of (elt : xml_element) : lean_expression =
   let (tag_name, _, children) = elt in
-  assert (String.equal tag_name "AllOf");
-  assert (not @@ phys_equal (List.length children) 0); (* "empty <AllOf>" *)
+  assert (String.(tag_name = "AllOf"));
+  assert (not Int.((List.length children) = 0)); (* "empty <AllOf>" *)
   List (List.map ~f:compile_match (get_children "Match" children))
 
 let compile_any_of (elt : xml_element) : lean_expression =
   let (tag_name, _, children) = elt in
-  assert (String.equal tag_name "AnyOf");
-  assert (not @@ phys_equal (List.length children) 0); (* "empty <AnyOf>" *)
+  assert (String.(tag_name = "AnyOf"));
+  assert (not Int.((List.length children) = 0)); (* "empty <AnyOf>" *)
   List (List.map ~f:compile_all_of (get_children "AllOf" children))
 
 let compile_target (elt : xml_element) : lean_expression =
   let (tag_name, _, children) = elt in
-  assert (String.equal tag_name "Target");
+  assert (String.(tag_name = "Target"));
   List (List.map ~f:compile_any_of (xml_element_of_children children))
 
 
@@ -271,7 +271,7 @@ let compile_condition
       (elt : xml_element)
     : lean_expression =
   let (tag_name, _, children) = elt in
-  assert (String.equal tag_name "Condition");
+  assert (String.(tag_name = "Condition"));
   match children with
   | [Element elt] -> compile_expression env elt
   | _ -> failwith "invalid <Condition> form"
@@ -281,7 +281,7 @@ let compile_attribute_assignment_expression
       (elt : xml_element)
     : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "AdviceExpression");
+  assert (String.(tag_name = "AdviceExpression"));
   let category = get_attr_exn "Category" attrs in
   let identifier = get_attr_exn "Identifier" attrs in
   let expression = get_child_exn "Expression" children in
@@ -300,7 +300,7 @@ let compile_obligation_expression
       (elt : xml_element)
     : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "ObligationExpression");
+  assert (String.(tag_name = "ObligationExpression"));
   let identifier = get_attr_exn "ObligationId" attrs in
   let assignments = get_children "AttributeAssignmentExpression" children in
   let fulfill_on = match get_attr_exn "FullfillOn" attrs with
@@ -319,7 +319,7 @@ let compile_advice_expression
       (elt : xml_element)
     : lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "AdviceExpression");
+  assert (String.(tag_name = "AdviceExpression"));
   let identifier = get_attr_exn "AdviceId" attrs in
   let assignments = get_children "AttributeAssignmentExpression" children in
   let applies_to = match get_attr_exn "AppliesTo" attrs with
@@ -363,7 +363,7 @@ let compile_rule
       (elt : xml_element)
     : compilation_intermediate =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "Rule");
+  assert (String.(tag_name = "Rule"));
   let identifier = get_attr_exn "RuleId" attrs in
   let obligation_expressions = get_children "ObligationExpression" children in
   let advice_expressions = get_children "AdviceExpression"children  in
@@ -410,7 +410,7 @@ let compile_variable_definition
       (elt : xml_element)
     : string * lean_expression =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "VariableDefinition");
+  assert (String.(tag_name = "VariableDefinition"));
   let identifier = get_attr_exn "VariableId" attrs in
   let value = get_child_exn "Expression" children in
   (identifier, compile_expression env value)
@@ -430,7 +430,8 @@ let order_variable_definitions elts =
   let nodes =
     List.map
       ~f:(function
-        | ("VariableDefinition", attrs, _) -> get_attr_exn "VariableId" attrs)
+        | ("VariableDefinition", attrs, _) -> get_attr_exn "VariableId" attrs
+        | _ -> failwith "unreachable")
       elts in
   let edges =
     List.map
@@ -447,13 +448,21 @@ let order_variable_definitions elts =
 
 let compile_policy (elt : xml_element) : compilation_intermediate =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "Policy");
+  assert (String.(tag_name = "Policy"));
   let identifier = get_attr_exn "PolicyId" attrs in
   let version = get_attr_exn "Version" attrs in
   assert (Str.string_match version_regex version 0);
+  let variables = get_children "VariableDefinition" children in
   let variables =
-    match order_variable_definitions (get_children "VariableDefinition" children) with
-    | Ok variables -> variables
+    match order_variable_definitions variables with
+    | Ok ordering ->
+       List.map ordering
+         ~f:(fun needle ->
+           List.find_exn ~f:(function
+               | ("VariableDefinition", attrs, _) ->
+                  String.(needle = (get_attr_exn "VariableId" attrs))
+               | _ -> false)
+             variables)
     | _ -> failwith "failed to order variable definitions"
   in
   let variables =
@@ -501,7 +510,7 @@ let compile_policy (elt : xml_element) : compilation_intermediate =
 let rec match_policy_reference elements identifier =
   match elements with
   | `Policy (identifier', version) :: xs ->
-     if String.equal identifier identifier'
+     if String.(identifier = identifier')
      then Some (canonicalize_identifier ~version:(Some version) identifier)
      else match_policy_reference xs identifier
   | `PolicySet (_, _) :: xs -> match_policy_reference xs identifier
@@ -510,7 +519,7 @@ let rec match_policy_reference elements identifier =
 let rec match_policyset_reference elements identifier regexes =
   match elements with
   | `PolicySet (identifier', version) :: xs ->
-     if String.equal identifier identifier' &&
+     if String.(identifier = identifier') &&
         List.for_all ~f:(fun regex -> Str.string_match regex version 0) regexes
      then Some (canonicalize_identifier ~version:(Some version) identifier)
      else match_policyset_reference xs identifier regexes
@@ -522,7 +531,7 @@ let rec compile_policyset
           (elt : xml_element)
         : compilation_intermediate =
   let (tag_name, attrs, children) = elt in
-  assert (String.equal tag_name "Rule");
+  assert (String.(tag_name = "Rule"));
   let identifier = get_attr_exn "PolicySetId" attrs in
   let version = get_attr_exn "Version" attrs in
   assert (Str.string_match version_regex version 0);
@@ -652,7 +661,7 @@ let compile : Xml.xml -> lean_expression list = function
            List.map ordering
              ~f:(fun needle ->
                List.find_exn ~f:(function
-                   | Define (identifier, _) -> String.equal identifier needle
+                   | Define (identifier, _) -> String.(identifier = needle)
                    | _ -> false)
                  element_definitions)
         | _ -> failwith "failed to order definitions")