Commits

Anonymous committed aea48b8

Cadastr.Cd_list -> Cd_List.List.Assoc

Comments (0)

Files changed (2)

  =
   struct
 
-    value map_rwm_assoc_stack_limit = 1000
-    ;
-
-    value list_assoc_index_opt ~keq lst k =
-      loop 0 lst
-      where rec loop i lst =
-        match lst with
-        [ [] -> None
-        | [(hk, _hv) :: tl] ->
-            if keq k hk
-            then Some i
-            else loop (i + 1) tl
-        ]
-    ;
-
-    value list_remove_nth_fast lst i =
-      if i < 0
-      then invalid_arg "list_remove_nth_fast: i<0"
-      else
-        inner lst i
-        where rec inner lst i =
-          match (i, lst) with
-          [ (_, []) -> invalid_arg "list_remove_nth_fast: i>=len"
-          | (0, [_h :: t]) -> t
-          | (i, [h :: t]) -> [h :: inner t (i - 1)]
-          ]
-    ;
-
-    value list_remove_nth_tailrec lst i =
-      let rec inner ~rev_acc lst i =
-        match (i, lst) with
-        [ (_, []) -> invalid_arg "list_remove_nth_tailrec: i>=len"
-        | (0, [_h :: t]) -> (rev_acc, t)
-        | (i, [h :: t]) -> inner ~rev_acc:[h :: rev_acc] t (i - 1)
-        ]
-      in
-      if i < 0
-      then invalid_arg "list_remove_nth_tailrec: i<0"
-      else
-        let (rev_heads, tail) = inner ~rev_acc:[] lst i in
-        List.rev_append rev_heads tail
-    ;
-
-    value list_assoc_get_exn ~keq cur k =
-      let rec loop lst =
-        match lst with
-        [ [] -> raise Not_found
-        | [(hk, hv) :: tl] ->
-            if keq k hk
-            then hv
-            else loop tl
-        ]
-      in
-        loop cur
-    ;
-
-    value list_assoc_get_all ~keq cur k =
-      let rec loop rev_acc lst =
-        match lst with
-        [ [] -> List.rev rev_acc
-        | [(hk, hv) :: tl] ->
-            loop (if keq k hk then [hv :: rev_acc] else rev_acc) tl
-        ]
-      in
-        loop [] cur
-    ;
-
-    value list_assoc_get_opt ~keq cur k =
-      try Some (list_assoc_get_exn ~keq cur k)
-      with [Not_found -> None]
-    ;
-
-    value list_assoc_mem ~keq cur k =
-          let rec loop lst =
-            match lst with
-            [ [] -> False
-            | [(hk, _hv) :: tl] ->
-                if keq k hk then True else loop tl
-            ]
-          in
-            loop cur
-    ;
-
-    value map_rwm_assoc_add cur k v =
-      [(k, v) :: cur]
-    ;
-
-    value map_rwm_assoc_remove ~keq cur k =
-      match list_assoc_index_opt ~keq cur k with
-      [ None -> cur
-      | Some i ->
-          let res_list =
-            if i < map_rwm_assoc_stack_limit
-            then list_remove_nth_fast cur i
-            else list_remove_nth_tailrec cur i
-          in
-            res_list
-      ]
-    ;
 
   end
 ;
  =
   struct
 
+    module A = Cd_List.List.Assoc;
+
     class map_ro_assoc ['k, 'v] ~keq cur : T.map_ro ['k, 'v]
     =
       object (_self)
-        method get_exn k = Cd_list.list_assoc_get_exn ~keq cur k;
-        method get_opt k = Cd_list.list_assoc_get_opt ~keq cur k;
-        method get_all k = Cd_list.list_assoc_get_all ~keq cur k;
-        method mem k = Cd_list.list_assoc_mem ~keq cur k;
+        method get_exn k = A.get_exn ~keq cur k;
+        method get_opt k = A.get_opt ~keq cur k;
+        method get_all k = A.get_all ~keq cur k;
+        method mem k = A.mem ~keq cur k;
         method fold
         : !'a. ('a -> 'k -> 'v -> 'a) -> 'a -> 'a
         = fun f a ->
       object (self)
         inherit map_ro_assoc ['k, 'v] ~keq cur;
         method add k v = new map_rwm_assoc ~keq
-          (Cd_list.map_rwm_assoc_add cur k v);
+          (A.add cur k v);
         method remove k =
-          let new_cur = Cd_list.map_rwm_assoc_remove ~keq cur k in
+          let new_cur = A.remove ~keq cur k in
           if cur == new_cur
           then (self :> map_rwm_assoc _ _)
           else new map_rwm_assoc ~keq new_cur
         ;
         method replace k v =
-          let removed = Cd_list.map_rwm_assoc_remove ~keq cur k in
-          let added = Cd_list.map_rwm_assoc_add removed k v in
+          let removed = A.remove ~keq cur k in
+          let added = A.add removed k v in
           new map_rwm_assoc ~keq added
         ;
         method empty = new map_rwm_assoc ~keq [];
           lst
     ;
 
+
+
+    value remove_nth_fast lst i =
+      if i < 0
+      then invalid_arg "list_remove_nth_fast: i<0"
+      else
+        inner lst i
+        where rec inner lst i =
+          match (i, lst) with
+          [ (_, []) -> invalid_arg "list_remove_nth_fast: i>=len"
+          | (0, [_h :: t]) -> t
+          | (i, [h :: t]) -> [h :: inner t (i - 1)]
+          ]
+    ;
+
+
+    value remove_nth_tailrec lst i =
+      let rec inner ~rev_acc lst i =
+        match (i, lst) with
+        [ (_, []) -> invalid_arg "list_remove_nth_tailrec: i>=len"
+        | (0, [_h :: t]) -> (rev_acc, t)
+        | (i, [h :: t]) -> inner ~rev_acc:[h :: rev_acc] t (i - 1)
+        ]
+      in
+      if i < 0
+      then invalid_arg "list_remove_nth_tailrec: i<0"
+      else
+        let (rev_heads, tail) = inner ~rev_acc:[] lst i in
+        List.rev_append rev_heads tail
+    ;
+
+
+    module Assoc
+     =
+      struct
+
+        value map_rwm_assoc_stack_limit = 1000
+        ;
+
+        value index_opt ~keq lst k =
+          loop 0 lst
+          where rec loop i lst =
+            match lst with
+            [ [] -> None
+            | [(hk, _hv) :: tl] ->
+                if keq k hk
+                then Some i
+                else loop (i + 1) tl
+            ]
+        ;
+
+        value get_exn ~keq cur k =
+          let rec loop lst =
+            match lst with
+            [ [] -> raise Not_found
+            | [(hk, hv) :: tl] ->
+                if keq k hk
+                then hv
+                else loop tl
+            ]
+          in
+            loop cur
+        ;
+
+        value get_all ~keq cur k =
+          let rec loop rev_acc lst =
+            match lst with
+            [ [] -> List.rev rev_acc
+            | [(hk, hv) :: tl] ->
+                loop (if keq k hk then [hv :: rev_acc] else rev_acc) tl
+            ]
+          in
+            loop [] cur
+        ;
+
+        value get_opt ~keq cur k =
+          try Some (get_exn ~keq cur k)
+          with [Not_found -> None]
+        ;
+
+        value mem ~keq cur k =
+          let rec loop lst =
+            match lst with
+            [ [] -> False
+            | [(hk, _hv) :: tl] ->
+                if keq k hk then True else loop tl
+            ]
+          in
+            loop cur
+        ;
+
+        value add cur k v =
+          [(k, v) :: cur]
+        ;
+
+        value remove ~keq cur k =
+          match index_opt ~keq cur k with
+          [ None -> cur
+          | Some i ->
+              let res_list =
+                if i < map_rwm_assoc_stack_limit
+                then remove_nth_fast cur i
+                else remove_nth_tailrec cur i
+              in
+                res_list
+          ]
+        ;
+
+      end
+    ;
+
   end
 ;