package acgtk

  1. Overview
  2. Docs
Abstract Categorial Grammar development toolkit

Install 

dune-project
 Dependency

acg.loria.fr Readme Changelog CeCILL-1.0+ License Edit opam file Versions (3)

Authors

  1. S
    Sylvain Pogodalla

Maintainers

  1. S
    sylvain.pogodalla@inria.fr

Sources

acg-2.2.0-20251107.tar.gz
sha512=07f391d052090bb70c10ec511fdc53af764954cbe1c30093778984c5ed41a4327573fdac0890c6fd619ff9827725572eb7b8a7545bd8ccb7f5bddb84d2d7f7cc

doc/src/acgtk.utilsLib/table.ml.html

Source file table.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
(**************************************************************************)
(*                                                                        *)
(*                 ACG development toolkit                                *)
(*                                                                        *)
(*                  Copyright 2008-2024 INRIA                             *)
(*                                                                        *)
(*  More information on "https://acg.loria.fr/"                     *)
(*  License: CeCILL, see the LICENSE file or "http://www.cecill.info"     *)
(*  Authors: see the AUTHORS file                                         *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(**************************************************************************)

module type BASE = sig
  val b : int
end

module type TABLE = sig
  type 'a t
  type key

  val empty : 'a t
  val add : ?overwrite:bool -> key -> 'a -> 'a t -> ('a t) option
  val find : key -> 'a t -> 'a option
  val fold : (key -> 'a -> 'b -> 'b) -> 'b -> 'a t -> 'b
  val iter : (key -> 'a -> unit) -> 'a t -> unit

  val pp :
    ?sep:
      ( (Format.formatter -> key * 'a -> unit) -> key * 'a -> unit,
        Format.formatter,
        unit,
        unit,
        unit,
        (Format.formatter -> key * 'a -> unit) -> key * 'a -> unit )
      format6 ->
    (Format.formatter -> key -> 'a -> unit) ->
    Format.formatter ->
    'a t ->
    unit
end

module Make_table (Base : BASE) = struct
  type 'a t = Nil | T of ('a option * 'a t) array
  type key = int

  let create () = T (Array.make Base.b (None, Nil))
  let empty = Nil

  let add ?(overwrite = false) n attr table =
    let rec insert1 n table =
      match table with
      | Nil -> insert1 n (create ())
      | T ar ->
          let r, i = (n / Base.b, n mod Base.b) in
          let a, tb = ar.(i) in
          if r = 0 then (
            match (a, overwrite) with
            | None, _ ->
                ar.(i) <- (Some attr, tb);
                Some (T ar)
            | Some _, false -> None
            | Some _, true ->
                ar.(i) <- (Some attr, tb);
                Some (T ar))
          else (
            Option.map
              (fun o ->
                ar.(i) <- (a, o);
                T ar)
              (insert1 r tb))
    in
    insert1 n table

  let rec find n table =
    match table with
    | Nil -> None
    | T ar ->
        let r, i = (n / Base.b, n mod Base.b) in
        let a, tb = ar.(i) in
        if r = 0 then a
        else find r tb

  let fold f acc table =
    let rec fold_aux q acc = function
      | Nil -> acc
      | T ar ->
          let _, new_acc =
            Array.fold_left
              (fun (i, acc) -> function
                | Some v, _ -> (i + 1, f ((q * Base.b) + i) v acc)
                | None, _ -> (i + 1, acc))
              (0, acc) ar
          in
          snd
            (Array.fold_left
               (fun (i, acc) (_, t) -> (i + 1, fold_aux (q + 1) acc t))
               (0, new_acc) ar)
    in
    fold_aux 0 acc table

  let iter f table =
    let rec iteri_aux q f table =
      match table with
      | Nil -> ()
      | T ar ->
          let () =
            Array.iteri
              (fun i (value, _t) ->
                match value with Some v -> f ((q * Base.b) + i) v | None -> ())
              ar
          in
          Array.iteri (fun q (_value, t) -> iteri_aux (q + 1) f t) ar
    in
    iteri_aux 0 f table

  let pp ?(sep = format_of_string "@,") ppf m t =
    let l_pp m (k, v) = ppf m k v in
    let first = ref true in
    iter
      (fun i v ->
        if !first then
          let () = first := false in
          ppf m i v
        else Format.fprintf m (sep ^^ "%a") l_pp (i, v))
      t
end