Category : Miscellaneous Language Source Code
Archive   : EUPHOR10.ZIP
Filename : GET.E

---------------------------------------------------------
-- 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

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

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

positive_int 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 1 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
positive_int 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()
sequence text
char c

text = ""
while 1 do
c = get_char()
if c = GET_EOF or c = '\n' then
return {GET_FAIL, 0}
end if
if c = '"' then
c = get_char()
if c != '"' then
exit
end if
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
unget_char(c)
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
positive_int ndigits
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()
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()
if find(c, "0123456789") then
e_mag = e_mag * 10 + c - '0'
else
unget_char(c)
end if
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 1 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(positive_int file_no)
-- main routine, sets input_file
input_file = file_no
return Get()
end function