system_lex.sa

 
---------------------------> Sather 1.1 source file <--------------------------

class SYSTEM_LEX 
class SYSTEM_LEX is

    private attr lex_state:INT; 
        -- 0 for default, 1 for in comment, 2 for in string
    private attr buf:FSTR;
	-- contents of the file being parsed
    private attr pos:INT;
	-- current read position
    private attr name:STR;
	-- Name of the file

    create(s:STR):SAME is
        res::=new;
	res.name:=s;-- SYSTEM_LEX::name
        f::=FILE::open_for_read(s);-- FILE::open_for_read
        if f.error then barf("Couldn't open system file "+s); end;-- FILE::error SYSTEM_LEX::barf STR::plus
        res.lex_state:=0;-- SYSTEM_LEX::lex_state
	res.buf:=f.fstr;-- SYSTEM_LEX::buf FILE::fstr
	res.pos:=0;-- SYSTEM_LEX::pos
        return res;
    end;

    get_str:STR is
	-- ignore comments and whitespace and read in a
	-- quote-delimited string.  When the last string has been
	-- read, this returns void.

	c:CHAR;
	tmp::=#FSTR;-- FSTR::create

	loop
	    until!(pos>=buf.size);-- SYSTEM_LEX::pos SYSTEM_LEX::buf FSTR::size BOOL::not
	    c:=buf[pos];-- SYSTEM_LEX::buf SYSTEM_LEX::pos
	    pos:=pos+1;-- SYSTEM_LEX::pos SYSTEM_LEX::pos INT::plus
	    case lex_state-- SYSTEM_LEX::lex_state
                when 0 then
		    case c
			when '-' then lex_state:=1;-- SYSTEM_LEX::lex_state
			when '\"' then lex_state:=2;-- SYSTEM_LEX::lex_state
			when '\n',' ','\t','\r','\\' then
			else barf("Illegal character "+c.pretty-- SYSTEM_LEX::barf STR::plus CHAR::pretty
				        +" in input file "+name);-- STR::plus SYSTEM_LEX::name
		    end;
		when 1 then
		    case c
			when '\n','\r' then lex_state:=0;-- SYSTEM_LEX::lex_state
			else 
		    end;
		when 2 then
		    case c 
			when '\"' then lex_state:=0; return tmp.str;-- SYSTEM_LEX::lex_state FSTR::str
			when '\\' then -- ignore backslashes
			else tmp:=tmp+c;-- FSTR::plus
		    end;
		else barf("Unknown lex state in back end");-- SYSTEM_LEX::barf
	    end;
	end;
        return void;
    end;

    elt!:STR is
        loop
            s::=get_str;-- SYSTEM_LEX::get_str
            if void(s) then quit;
            else yield s;
            end;
        end;
    end;

    private barf(msg:STR) is
	#ERR + msg + '\n';-- ERR::create ERR::plus ERR::plus
	UNIX::exit(1);-- UNIX::exit
    end;

end; -- SYSTEM_LEX