POINT Software Programming/PPROG1.ISO/misc/euphoria/get.e

Text File | 1994-01-31 | 5.3 KB | 289 lines

        ---------------------
        -- Input an Object --
        ---------------------

-- Read a Euphoria object from an input stream.
-- get(filenumber) returns {error_status, input_value}

-- error status values returned:
global constant GET_SUCCESS = 0,
        GET_EOF = -1,
        GET_FAIL = 1

constant UNDEFINED_CHAR = -2

constant TRUE = 1

type natural(integer x)
    return x >= 0
end type

type char(integer x)
    return x >= UNDEFINED_CHAR and x <= 255
end type

natural input_file

char ungot_char
ungot_char = UNDEFINED_CHAR


function get_char()
-- read next logical char in input stream
    char temp

    if ungot_char = UNDEFINED_CHAR then
    return getc(input_file)
    else
    temp = ungot_char
    ungot_char = UNDEFINED_CHAR
    return temp
    end if
end function


procedure unget_char(char c)
-- "unget" a character - push it back on the input stream
    ungot_char = c
end procedure


procedure skip_blanks()
-- skip white space
    char c

    while TRUE do
    c = get_char()
    if not find(c, " \t\n") then
        exit
    end if
    end while
    unget_char(c)
end procedure

constant ESCAPE_CHARS = "nt'\"\\r",
     ESCAPED_CHARS = "\n\t'\"\\\r"

function escape_char(char c)
-- return escape character
    natural i

    i = find(c, ESCAPE_CHARS)
    if i = 0 then
    return GET_FAIL
    else
    return ESCAPED_CHARS[i]
    end if
end function


function get_qchar()
-- get a single-quoted character

    char c

    c = get_char()
    if c = '\\' then
    c = escape_char(get_char())
    if c = GET_FAIL then
        return {GET_FAIL, 0}
    end if
    end if
    if get_char() != '\'' then
    return {GET_FAIL, 0}
    else
    return {GET_SUCCESS, c}
    end if
end function


function get_string()
-- get a double-quoted character string
    sequence text
    char c

    text = ""
    while TRUE do
    c = get_char()
    if c = GET_EOF or c = '\n' then
        return {GET_FAIL, 0}
    end if
    if c = '"' then
        exit
    elsif c = '\\' then
        c = escape_char(get_char())
        if c = GET_FAIL then
        return {GET_FAIL, 0}
        end if
    end if
    text = text & c
    end while
    return {GET_SUCCESS, text}
end function

type plus_or_minus(integer x)
    return x = -1 or x = +1
end type

function get_number()
-- read a number
    char c
    plus_or_minus sign, e_sign
    natural ndigits
    integer hex_digit
    atom mantissa, dec, e_mag, exponent

    sign = +1
    mantissa = 0
    e_sign = +1
    e_mag = 0
    ndigits = 0

    c = get_char()

    -- process sign
    if c = '-' then
    sign = -1
    elsif c != '+' then
    unget_char(c)
    end if

    -- get mantissa
    c = get_char()
    if c = '#' then
    -- process hex integer and return
    while TRUE do
        c = get_char()
        hex_digit = find(c, "0123456789ABCDEF")-1
        if hex_digit >= 0 then
        ndigits = ndigits + 1
        mantissa = mantissa * 16 + hex_digit
        else
        unget_char(c)
        if ndigits > 0 then
            return {GET_SUCCESS, sign * mantissa}
        else
            return {GET_FAIL, 0}
        end if
        end if
    end while
    end if
    -- decimal integer or floating point
    while find(c, "0123456789") do
    ndigits = ndigits + 1
    mantissa = mantissa * 10 + (c - '0')
    c = get_char()
    end while
    if c = '.' then
    -- get fraction
    c = get_char()
    dec = 10
    while find(c, "0123456789") do
        ndigits = ndigits + 1
        mantissa = mantissa + (c - '0') / dec
        dec = dec * 10
        c = get_char()
    end while
    end if
    if ndigits = 0 then
    return {GET_FAIL, 0}
    end if
    if c = 'e' or c = 'E' then
    -- get exponent sign
    c = get_char()
    if c = '-' then
        e_sign = -1
    elsif c != '+' then
        unget_char(c)
    end if
    -- get exponent magnitude
    c = get_char()
    if find(c, "0123456789") then
        e_mag = c - '0'
        c = get_char()
        while find(c, "0123456789") do
        e_mag = e_mag * 10 + c - '0'
        c = get_char()
        end while
        unget_char(c)
    else
        return {GET_FAIL, 0} -- no exponent
    end if
    else
    unget_char(c)
    end if
    exponent = 1
    if e_sign >= 0 then
    for i = 1 to e_mag do
        exponent = exponent * 10
    end for
    else
    for i = 1 to e_mag do
        exponent = exponent * 0.1
    end for
    end if
    return {GET_SUCCESS, sign * mantissa * exponent}
end function


function Get()
-- read a Euphoria data object as a string of characters
-- and return {error_flag, value}
    char c
    sequence s, e

    skip_blanks()
    c = get_char()

    if find(c, "-+.0123456789#") then
    unget_char(c)
    return get_number()

    elsif c = '{' then
    -- process a sequence
    s = {}
    while TRUE do
        skip_blanks()
        c = get_char()
        if c = '}' then
        return {GET_SUCCESS, s}
        else
        unget_char(c)
        end if
        e = Get()
        if e[1] != GET_SUCCESS then
        return e
        end if
        s = append(s, e[2])
        skip_blanks()
        c = get_char()
        if c = '}' then
        return {GET_SUCCESS, s}
        elsif c != ',' then
        return {GET_FAIL, 0}
        end if
    end while

    elsif c = '\"' then
    return get_string()

    elsif c = '\'' then
    return get_qchar()

    elsif c = -1 then
    return {GET_EOF, 0}

    else
    return {GET_FAIL, 0}

    end if
end function


global function get(natural file_no)
-- main routine, sets input_file
    input_file = file_no
    return Get()
end function