src/Pure/term_items.ML
changeset 77828 6fae9f5157b5
parent 74278 a123db647573
child 77835 c18c0dbefd55
equal deleted inserted replaced
77827:cd5d56abda10 77828:6fae9f5157b5
     6   - set with order of addition, e.g. occurrences within term
     6   - set with order of addition, e.g. occurrences within term
     7 *)
     7 *)
     8 
     8 
     9 signature TERM_ITEMS =
     9 signature TERM_ITEMS =
    10 sig
    10 sig
       
    11   structure Key: KEY
    11   type key
    12   type key
    12   type 'a table
    13   type 'a table
    13   val empty: 'a table
    14   val empty: 'a table
    14   val build: ('a table -> 'a table) -> 'a table
    15   val build: ('a table -> 'a table) -> 'a table
    15   val size: 'a table -> int
    16   val size: 'a table -> int
    36 end;
    37 end;
    37 
    38 
    38 functor Term_Items(Key: KEY): TERM_ITEMS =
    39 functor Term_Items(Key: KEY): TERM_ITEMS =
    39 struct
    40 struct
    40 
    41 
       
    42 (* keys *)
       
    43 
       
    44 structure Key = Key;
       
    45 type key = Key.key;
       
    46 
       
    47 
    41 (* table with length *)
    48 (* table with length *)
    42 
    49 
    43 structure Table = Table(Key);
    50 structure Table = Table(Key);
    44 
    51 
    45 type key = Table.key;
    52 datatype 'a table = Table of 'a Table.table;
    46 datatype 'a table = Items of int * 'a Table.table;
       
    47 
    53 
    48 fun size (Items (n, _)) = n;
    54 val empty = Table Table.empty;
    49 fun table (Items (_, tab)) = tab;
    55 fun build (f: 'a table -> 'a table) = f empty;
       
    56 fun is_empty (Table tab) = Table.is_empty tab;
    50 
    57 
    51 val empty = Items (0, Table.empty);
    58 fun size (Table tab) = Table.size tab;
    52 fun build (f: 'a table -> 'a table) = f empty;
    59 fun dest (Table tab) = Table.dest tab;
    53 fun is_empty items = size items = 0;
    60 fun keys (Table tab) = Table.keys tab;
       
    61 fun exists pred (Table tab) = Table.exists pred tab;
       
    62 fun forall pred (Table tab) = Table.forall pred tab;
       
    63 fun get_first get (Table tab) = Table.get_first get tab;
       
    64 fun lookup (Table tab) = Table.lookup tab;
       
    65 fun defined (Table tab) = Table.defined tab;
    54 
    66 
    55 fun dest items = Table.dest (table items);
    67 fun add entry (Table tab) = Table (Table.default entry tab);
    56 fun keys items = Table.keys (table items);
       
    57 fun exists pred = Table.exists pred o table;
       
    58 fun forall pred = Table.forall pred o table;
       
    59 fun get_first get = Table.get_first get o table;
       
    60 fun lookup items = Table.lookup (table items);
       
    61 fun defined items = Table.defined (table items);
       
    62 
       
    63 fun add (key, x) (items as Items (n, tab)) =
       
    64   if Table.defined tab key then items
       
    65   else Items (n + 1, Table.update_new (key, x) tab);
       
    66 
       
    67 fun make entries = build (fold add entries);
    68 fun make entries = build (fold add entries);
    68 
    69 
    69 
    70 
    70 (* set with order of addition *)
    71 (* set with order of addition *)
    71 
    72 
    72 type set = int table;
    73 type set = int table;
    73 
    74 
    74 fun add_set x (items as Items (n, tab)) =
    75 fun add_set x (Table tab) =
    75   if Table.defined tab x then items
    76   Table (if Table.defined tab x then tab else Table.update_new (x, Table.size tab + 1) tab);
    76   else Items (n + 1, Table.update_new (x, n) tab);
       
    77 
    77 
    78 fun make_set xs = build (fold add_set xs);
    78 fun make_set xs = build (fold add_set xs);
    79 
    79 
    80 fun subset (A: set, B: set) = forall (defined B o #1) A;
    80 fun subset (A: set, B: set) = forall (defined B o #1) A;
    81 fun eq_set (A: set, B: set) = size A = size B andalso subset (A, B);
    81 fun eq_set (A: set, B: set) = size A = size B andalso subset (A, B);
    82 
    82 
    83 fun list_set_ord ord items = Table.dest (table items) |> sort (ord o apply2 #2) |> map #1
    83 fun list_set_ord ord (Table tab) = tab |> Table.dest |> sort (ord o apply2 #2) |> map #1;
    84 val list_set = list_set_ord int_ord;
    84 val list_set = list_set_ord int_ord;
    85 val list_set_rev = list_set_ord (rev_order o int_ord);
    85 val list_set_rev = list_set_ord (rev_order o int_ord);
    86 
    86 
    87 fun map f (Items (n, tab)) = Items (n, Table.map f tab);
    87 fun map f (Table tab) = Table (Table.map f tab);
    88 fun fold f = Table.fold f o table;
    88 fun fold f (Table tab) = Table.fold f tab;
    89 fun fold_rev f = Table.fold_rev f o table;
    89 fun fold_rev f (Table tab) = Table.fold_rev f tab;
    90 
    90 
    91 end;
    91 end;
    92 
    92 
    93 
    93 
    94 structure TFrees:
    94 structure TFrees: