OpenEuphoria

2. More usefuls for Euphoria

• Posted by JEFF ZEITLIN <jeff.zeitlin at EXECNET.COM> Mar 09, 1997
• 1165 views

... as promised ...

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

-- associative lists

-- an associative list is implemented as a sequence that contains sequences;
-- each sequence is a key/value pair: {{key,value},{key,value},...}.
-- keys and values may be any valid Euphoria object.

include stddefs.e           -- need errorexit function

constant alist_key = 1
constant alist_value = 2

-- an associative list is either an empty sequence, or one where each element
-- other than the first is a {key,value} pair.  The first element is a
-- sequence with one member, the default value

-- the following types and procedures are supplied:

-- the type assoc_list
-- alist = alist_set(assoc_list alist, object key, object value)
--      returns an association list with the indicated {key,value} pair.
--      Adds a new pair if the key value isn't already in the list; changes
--      the value of an existing pair if it is.  If no default is set, sets
--      the default to an empty sequence.
-- obj = alist_reference(assoc_list alist, object key)
--      returns the value stored in the association list pair with the
--      supplied key.  If the key is not in the list, returns the default
--      value for the list.  If no default has ever been set, the default is
--      an empty sequence.
-- alist = alist_default(assoc_list list, object default)
--      sets the default value for alist_reference to return for non-existent
--      keys.

global type assoc_list(sequence s)
    if length(s) = 0 then           -- empty list
        return 1                    -- yes, it is - and therefore valid
    end if
    if length(s[1]) != 1 then       -- default value properly stored?
        return 0                    -- no, fail type check.
    end if
    if length(s) > 1 then
        for i = 2 to length(s) do
            if length(s[i]) != 2 then   -- is it a {key, value}?
                return 0                -- no, it's not, so fail type-check
            end if
        end for
    end if
    return 1                        -- yes, it's a valid alist.
end type

global function alist_default(assoc_list list, object defval)
    assoc_list newlist

    if length(list) = 0 then
        newlist = {{defval}}
    else
        newlist[1] = {defval}
    end if
    return newlist
end function

global function alist_set(assoc_list list, object key, object val)
-- sets a {key,value} pair.
-- changes an existing value, or adds a new pair for a nonexistent key
-- stored in sorted order by key to improve retrieval time.
-- Also sets the default value to null if the default is not already set.
    assoc_list newlist
    integer index
    integer len

    index = 1
    newlist = list
    len = length(newlist)
    if len = 0 then
        newlist = {{{}}} -- equivalent to alist_default({},{})
    elsif length(newlist[1]) = 2 then
        newlist = prepend(newlist,{{}})
    end if
    while compare(list[index][alist_key], key) = -1 do
        index = index + 1                       -- bypass all "lesser" keys
    end while
    if compare(list[index][alist_key],key) = 0 then
        newlist[index][alist_value] = val       -- change val for existing key
    else                                        -- add a new key
        newlist = append(newlist[1..index-1],{key,value}) & newlist[index..len]
    end if
    return newlist
end function

global function alist_reference(assoc_list list, object key)
-- search the association list via a binary search.
-- if we end up checking element 1 of the list, then the key value is
-- not found, and we return the default value.
    integer index
    integer interval
    integer comp

    if length(list) = 0 then
        return {}
    end if
    interval = floor(length(list)/2)
    index = interval
    while interval > 0 do
        interval = floor(interval / 2)
        comp = compare(list[index][alist_key],key)
        if comp = 0 then            -- found the key
            return list[index][alist_value]
        else
            index = index - (comp * interval)
                    -- comp is -1 if the viewed key is less than the desired
                    -- key, so we have to *increase* the index to look farther
                    -- "down" the array.  Subtracting a negative number is
                    -- equivalent to adding.  Comp is 1 if the viewed key is
                    -- greater than the desired key.
            if index = 1 then -- the desired key is less than any key in list
                return list[1][1] -- the default value
            end if
        end if
    end while
    return list[1][1] -- we haven't ended up on index 1, but we still
                      -- haven't found the key, and we can't search any more,
                      -- so return the default.
end function
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
-- stack.e
-- by Jeff Zeitlin (jeff.zeitlin at execnet.com)

-- implements a stack type for Euphoria with proper syntax.

-- stack s
--      declares the type stack, and checks to see if it is initialized

-- stack s
-- s = init()
--      creates a new stack, returns a "handle" to be used to refer to this
--      stack hereafter.

-- push(stack s, object o)
--      puts object o on the top of stack s

-- object o
-- o = pop(stack s)
--      takes object off top of stack s, and returns it.

-- boolean/integer b
-- b = empty(stack s)
--      returns TRUE (1) if there are no objects on stack s, FALSE (0) otherwise

-- clear(stack s)
--      makes existing stack s empty, discarding all information on it.


-- private procedures and variables

procedure errorexit(integer code, sequence message)
    printf(2,"%s",{message})
    abort(code)
end procedure

sequence stacks
stacks = {}

-- public interface

global type stack(integer s)
    return s <= length(stacks)
end type

global function init()
    stacks = append(stacks,{})
    return length(stacks)
end function

global procedure push(stack s, object o)
    stack[s] = append(stack[s], o)
end procedure

global function empty(stack s)
    return length(stacks[s]) = 0
end function

global function pop(stack s)
    object val

    if empty(s) then
        errorexit(1,"stack underflow error\n")
    end if
    val = stacks[s][length(stacks[s])]
    stacks[s] = stacks[s][1..length(stacks[s])-1]
    return val
end function

global procedure clear(stack s)
    stacks[s] = {}
end procedure
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=

(Continued to next message)

---
 ~ OLXWin 1.00b ~ I hate this tagline.  I really do.  LOATHE!