PreviousUpNext

15.4.901  src/lib/src/int-list-map.pkg

## int-list-map.pkg

# Compiled by:
#     src/lib/std/standard.lib

# An implementation of finite maps on integer keys
# which uses a sorted list representation. Normally
#     src/lib/src/int-red-black-map.pkg
# is preferred.


package int_list_map
:
Map                                                                     # Map   is from   src/lib/src/map.api
where
    key::Key == int::Int
=
package {
    package key {
        Key = Int;
        compare = int::compare;
    };

    Map(X) = List ((Int, X)); 

    empty = [];

    fun is_empty [] =>  TRUE;
        is_empty _  =>  FALSE;
    end;


    # Return the first item in the
    # map, or NULL if it is empty:
    #
    fun first_val_else_null []               =>  NULL;
        first_val_else_null ((_, value) ! _) =>  THE value;
    end;

    # Return the first item in the map
    # and its key, or NULL if it is empty:
    #
    fun first_keyval_else_null []                 =>  NULL;
        first_keyval_else_null ((key, value) ! _) =>  THE (key, value);
    end;


    # Return the last item in the
    # map, or NULL if it is empty:
    #
    fun last_val_else_null []                =>  NULL;
        last_val_else_null ((_, value) ! []) =>  THE value;
        last_val_else_null (_ ! rest)        =>  last_val_else_null  rest;
    end;

    # Return the last item in the map
    # and its key, or NULL if it is empty:
    #
    fun last_keyval_else_null []                  =>  NULL;
        last_keyval_else_null ((key, value) ! []) =>  THE (key, value);
        last_keyval_else_null (_ ! rest)          =>  last_keyval_else_null  rest;
    end;


    fun singleton (key, item)
        =
        [(key, item)];

    fun debug_print   (map, print_key, print_val) = 0;                  # Placeholder
    fun all_invariants_hold map = TRUE;                                 # Placeholder

    fun set (l, key, item)
        =
        f l
        where
            fun f []
                    =>
                    [(key, item)];

                f ((elem as (key', _)) ! r)
                    =>
                    case (key::compare (key, key'))
                      
                         LESS    => (key, item) ! elem ! r;
                         EQUAL   => (key, item) ! r;
                         GREATER => elem ! (f r);
                    esac;
            end;
        end;

    fun m $ (x, v)
        =
        set (m, x, v);

    fun set' ((k, x), m)
        =
        set (m, k, x);


    # Return TRUE if the key is in the map's domain 
    #
    fun contains_key (l, key)
        =
        f l
        where
            fun f []                =>   FALSE;
                f ((key', x) ! r)   =>   (key' <= key) and ((key' == key) or f r);
            end;
        end;

    fun preceding_key (l, key)
        =
        f (l, NULL)
        where
            fun f  ((key', x) ! r,  result)
                    =>
                    case (int::compare (key, key'))
                        #
                        LESS    => result;
                        EQUAL   => result;
                        GREATER => f (r, THE key');
                    esac;

                f ([], result) => result;
            end;
        end;
    fun following_key (l, key)
        =
        f l
        where
            fun f  ((key', x) ! r)
                    =>
                    case (int::compare (key, key'))
                        #
                        LESS    => THE key';
                        EQUAL   => f r;
                        GREATER => f r;
                    esac;

                f [] => NULL;
            end;
        end;

    # Search on a key, return (THE value) if found,
    # else return NULL.
    #
    fun get (l, key)
        =
        f l
        where
            fun f [] =>  NULL;

                f ((key', x) ! r)
                    =>
                    if    (key <  key')  NULL;
                    elif  (key == key')  THE x;
                    else                 f r;
                    fi;
            end;
        end;

    # Search on a key, return value if found,
    # else raise lib_base::NOT_FOUND
    #
    fun get_or_raise_exception_not_found (l, key)
        =
        f l
        where
            fun f [] =>  raise exception lib_base::NOT_FOUND;

                f ((key', x) ! r)
                    =>
                    if    (key <  key')  raise exception lib_base::NOT_FOUND;
                    elif  (key == key')  x;
                    else                 f r;
                    fi;
            end;
        end;

    stipulate
        # Remove an item, returning new map and value removed.
        # Raise excaption lib_base::NOT_FOUND if not found.
        #
        fun drop' (l, key)
            =
            f ([], l)
            where

                fun f (_, []) =>   raise exception lib_base::NOT_FOUND;

                    f (prefix, (elem as (key', x)) ! r)
                        =>
                        case (key::compare (key, key'))

                             LESS    =>  raise exception lib_base::NOT_FOUND;
                             EQUAL   =>  (list::reverse_and_prepend (prefix, r), x);
                             GREATER =>  f (elem ! prefix, r);
                        esac;
                end;
            end;
    herein
        fun drop (old_map, key_to_drop)                         # Return new_map, or old_map if key_to_drop was not found.
            =
            #1 (drop' (old_map, key_to_drop))
            except
                lib_base::NOT_FOUND = old_map;

        fun get_and_drop (old_map, key_to_drop)                         # Return (new_map, THE value)  or (old_map, NULL) if key_to_drop was not found.
            =
            {   (drop' (old_map, key_to_drop))
                    ->
                    (new_map, val);

                (new_map, THE val);
            }
            except
                lib_base::NOT_FOUND = (old_map, NULL);
    end;

    # Return the number of items in the map 
    #
    fun vals_count l
        =
        list::length l;


    # Return a list of the items
    # (and their keys) in the map 
    #
    fun vals_list (l:  Map(X))
        =
        list::map #2 l;

    fun keyvals_list l
        =
        l;

    fun keys_list (l:  Map(X))
        =
        list::map #1 l;

    fun compare_sequences compare_rng
        =
        compare
        where
            fun compare ([], []) =>  EQUAL;
                compare ([], _)  =>  LESS;
                compare (_, [])  =>  GREATER;

                compare ((x1, y1) ! r1, (x2, y2) ! r2)
                    =>
                    case (key::compare (x1, x2))
                      
                         EQUAL
                             =>
                             case (compare_rng (y1, y2))
                               
                                   EQUAL =>  compare (r1, r2);
                                   order =>  order;
                             esac;

                         order => order;
                    esac;
            end;
        end;


    # Return a map whose domain is the
    # union of the domains of the two
    # input maps, using the supplied
    # function to define the map on
    # elements that are in both domains.
    #
    fun union_with f (m1:  Map(X), m2:  Map(X))
        =
        merge (m1, m2, [])
        where
            fun merge ([], [], l) =>  list::reverse l;
                merge ([], m2, l) =>  list::reverse_and_prepend (l, m2);
                merge (m1, [], l) =>  list::reverse_and_prepend (l, m1);

                merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    case (key::compare (k1, k2))
                      
                        LESS    => merge (r1, m2, (k1, x1) ! l);
                        EQUAL   => merge (r1, r2, (k1, f (x1, x2)) ! l);
                        GREATER => merge (m1, r2, (k2, x2) ! l);
                    esac;
            end;
        end;

    fun keyed_union_with f (m1:  Map(X), m2:  Map(X))
        =
        merge (m1, m2, [])
        where

            fun merge ([], [], l) =>  list::reverse l;
                merge ([], m2, l) =>  list::reverse_and_prepend (l, m2);
                merge (m1, [], l) =>  list::reverse_and_prepend (l, m1);

                merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    case (key::compare (k1, k2))
                      
                         LESS    =>  merge (r1, m2, (k1, x1) ! l);
                         EQUAL   =>  merge (r1, r2, (k1, f (k1, x1, x2)) ! l);
                         GREATER =>  merge (m1, r2, (k2, x2) ! l);
                    esac;
            end;
        end;

    fun difference_with (m1, m2)
        =
        {   keys_to_remove =  keys_list  m2;
            #
            remove (m1, keys_to_remove)
            where
                fun remove (m1, [])
                        =>
                        m1;

                    remove (m1, key ! rest)
                        =>
                        remove (drop (m1, key), rest);
                end;
            end;
        };

    fun from_list (pairs: List((key::Key, X)))
        =
        {   tree = empty;
            #
            add (tree, pairs)
            where
                fun add (tree, [])
                        =>
                        tree;

                    add (tree, (key,val) ! rest)
                        =>
                        add (set (tree, key, val), rest);
                end;
            end;
        };

    # Return a map whose domain is the intersection of the domains of the
    # two input maps, using the supplied function to define the range.
    #
    fun intersect_with f (m1:  Map(X), m2:  Map(Y))
        =
        merge (m1, m2, [])
        where
            fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    case (key::compare (k1, k2))
                      
                         LESS    =>  merge (r1, m2, l);
                         EQUAL   =>  merge (r1, r2, (k1, f (x1, x2)) ! l);
                         GREATER =>  merge (m1, r2, l);
                    esac;

                merge (_, _, l)
                    =>
                    list::reverse l;
            end;
        end;

    fun keyed_intersect_with f (m1:  Map(X), m2:  Map(Y))
        =
        merge (m1, m2, [])
        where
            fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    case (key::compare (k1, k2))
                      
                         LESS    =>  merge (r1, m2, l);
                         EQUAL   =>  merge (r1, r2, (k1, f (k1, x1, x2)) ! l);
                         GREATER =>  merge (m1, r2, l);
                    esac;

                merge (_, _, l)
                    =>
                    list::reverse l;
            end;
        end;

    fun merge_with f (m1:  Map(X), m2:  Map(Y))
        =
        merge (m1, m2, [])
        where

            fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    if   (k1 < k2)

                         mergef (k1, THE x1, NULL, r1, m2, l);
                    else
                        if   (k1 == k2)
                         mergef (k1, THE x1, THE x2, r1, r2, l);
                        else mergef (k2, NULL, THE x2, m1, r2, l);    fi;
                    fi;

                merge ([], [], l)            =>  list::reverse l;
                merge ((k1, x1) ! r1, [], l) =>  mergef (k1, THE x1, NULL, r1, [], l);
                merge ([], (k2, x2) ! r2, l) =>  mergef (k2, NULL, THE x2, [], r2, l);
            end 

            also
            fun mergef (k, x1, x2, r1, r2, l)
                =
                case (f (x1, x2))
                  
                     NULL  =>  merge (r1, r2, l);
                     THE y =>  merge (r1, r2, (k, y) ! l);
                esac;
        end;

    fun keyed_merge_with f (m1:  Map(X), m2:  Map(Y))
        =
        merge (m1, m2, [])
        where
            fun merge (m1 as ((k1, x1) ! r1), m2 as ((k2, x2) ! r2), l)
                    =>
                    if   (k1 < k2)

                         mergef (k1, THE x1, NULL, r1, m2, l);
                    else
                         if   (k1 == k2)   mergef (k1, THE x1, THE x2, r1, r2, l);
                         else              mergef (k2, NULL,   THE x2, m1, r2, l);   fi;
                    fi;

                merge ([], [], l)            =>  list::reverse l;
                merge ((k1, x1) ! r1, [], l) =>  mergef (k1, THE x1, NULL, r1, [], l);
                merge ([], (k2, x2) ! r2, l) =>  mergef (k2, NULL, THE x2, [], r2, l);
            end 

            also
            fun mergef (k, x1, x2, r1, r2, l)
                =
                case (f (k, x1, x2))
                  
                     NULL  =>  merge (r1, r2, l);
                     THE y =>  merge (r1, r2, (k, y) ! l);
                esac;
        end;


    # Apply a function to the
    # entries of the map in map order. 
    #
    keyed_apply =  list::apply;

    fun apply f l
        =
        keyed_apply   (\\ (_, item) =  f item)   l;


    # Create a new table by applying
    # a map function to the name/value
    # pairs in the table.
    #
    fun keyed_map f l
        =
        list::map   (\\ (key, item) =  (key, f (key, item)))   l;

    fun map f l
        =
        list::map   (\\ (key, item) =  (key, f item))   l;


    # Apply a folding function
    # to the entries of the map
    # in increasing map order.
    #
    fun keyed_fold_forward f init l
        =
        list::fold_forward   (\\ ((key, item), accum) =  f (key, item, accum))   init   l;

    fun fold_forward f init l
        =
        list::fold_forward   (\\ ((_, item), accum) =  f (item, accum))   init   l;


    # Apply a folding function
    # to the entries of the map
    # in decreasing map order.
    #
    fun keyed_fold_backward f init l
        =
        list::fold_backward   (\\ ((key, item), accum) =  f (key, item, accum))   init   l;

    fun fold_backward f init l
        =
        list::fold_backward   (\\ ((_, item), accum) =  f (item, accum))   init   l;

    fun filter prior l
        =
        list::filter   (\\ (_, item) =  prior item)   l;

    fun keyed_filter prior l
        =
        list::filter prior l;

    fun keyed_map' f l
        =
        list::map_partial_fn   f'   l
        where
            fun f' (key, item)
                =
                case (f (key, item))
                  
                     NULL  =>  NULL;
                     THE y =>  THE (key, y);
                esac;
        end;

    fun map' f l
        =
        keyed_map'   (\\ (_, item) =  f item)   l;


};      #  int_list_map 



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext