config.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- supertype for all entries in the configuration file.
-- Currently three different entries are known, CONFIG_FUNC
-- for builtin functions, CONFIG_ITER for builtin iters and
-- CONFIG_DEF for all other entries.
abstract class $CONFIG < $STR
abstract class $CONFIG < $STR is
name:STR;
str:STR;
end;
class CONFIG_ROUT < $CONFIG
class CONFIG_ROUT < $CONFIG is
readonly attr name:STR;
readonly attr volatile:BOOL;
readonly attr fragile:BOOL;
readonly attr no_pre:BOOL;
readonly attr no_post:BOOL;
readonly attr does_import:BOOL;
readonly attr does_export:BOOL;
readonly attr block:BOOL;
readonly attr arith:BOOL;
readonly attr use_index:BOOL;
readonly attr raises:ARRAY{STR};
readonly attr raises_any:BOOL;
raises_none:BOOL is return void(raises) and ~raises_any; end;-- CONFIG_ROUT::raises CONFIG_ROUT::raises_any BOOL::not
readonly attr reads:ARRAY{STR};
readonly attr reads_any:BOOL;
reads_none:BOOL is return void(reads) and ~reads_any; end;
readonly attr writes:ARRAY{STR};
readonly attr writes_any:BOOL;
writes_none:BOOL is return void(writes) and ~writes_any; end;
no_side_effects:BOOL is -- does not check for the arith flag.
return writes_none and reads_none and raises_none and
~fragile and ~block and ~does_import and ~does_export
and ~volatile;
end;
readonly attr declare,f_declare:ARRAY{STR};
readonly attr var,f_var:ARRAY{STR};
-- this attribute is only used for routines
readonly attr exec,f_exec:ARRAY{STR};
-- the following attributes are only used for iters
readonly attr init,f_init:ARRAY{STR};
readonly attr iter,f_iter:ARRAY{STR};
readonly attr temp,f_temp:ARRAY{STR};
readonly attr break,f_break:ARRAY{STR};
create:SAME is return new; end;
private get_attr(e:FLIST{STR}):ARRAY{STR} is
r::=#ARRAY{STR}(e.size-1);-- ARRAY{1}::create FLIST{1}::size INT::minus
loop
i::=r.ind!;-- ARRAY{1}::ind!
r[i]:=e[i+1];-- ARRAY{1}::aset FLIST{1}::aget INT::plus
end;
return r;
end;
is_rout(exprs:FLIST{FLIST{STR}}):BOOL is
loop
a::=exprs.elt![0];-- FLIST{1}::elt! FLIST{1}::aget
if a="exec" or a="reads" or a="writes" then return true; end; -- STR::is_eq STR::is_eq STR::is_eq
end;
return false;
end;
is_iter(exprs:FLIST{FLIST{STR}}):BOOL is
loop
a::=exprs.elt![0];-- FLIST{1}::elt! FLIST{1}::aget
if a="iter" or a="break" then return true; end; -- STR::is_eq STR::is_eq
end;
return false;
end;
is_iter:BOOL is
return ~void(iter) or ~void(break);
end;
is_rout:BOOL is
return ~void(exec);
end;
private pastr(e:ARRAY{STR}):STR is
r::="";
loop r:=r+" "+e.elt!.pretty; end;-- STR::plus STR::plus ARRAY{1}::elt! STR::pretty
return r;
end;
str:STR is
r::=name+":\n";-- CONFIG_ROUT::name STR::plus
if volatile then r:=r+"\tvolatile,\n"; end;-- CONFIG_ROUT::volatile STR::plus
if fragile then r:=r+"\tfragile,\n"; end;-- CONFIG_ROUT::fragile STR::plus
if no_pre then r:=r+"\tno_pre,\n"; end;-- CONFIG_ROUT::no_pre STR::plus
if no_post then r:=r+"\tno_post,\n"; end;-- CONFIG_ROUT::no_post STR::plus
if block then r:=r+"\tblock,\n"; end;-- CONFIG_ROUT::block STR::plus
if arith then r:=r+"\tarith,\n"; end;-- CONFIG_ROUT::arith STR::plus
if does_import then r:=r+"\timport,\n"; end;-- CONFIG_ROUT::does_import STR::plus
if does_export then r:=r+"\texport,\n"; end;-- CONFIG_ROUT::does_export STR::plus
if raises_any then r:=r+"\traises_any,\n"; end;-- CONFIG_ROUT::raises_any STR::plus
if reads_any then r:=r+"\treads_any,\n"; end;-- CONFIG_ROUT::reads_any STR::plus
if writes_any then r:=r+"\twrites_any,\n"; end;-- CONFIG_ROUT::writes_any STR::plus
if ~void(raises) then r:=r+"\traises"+pastr(raises)+",\n"; end;-- CONFIG_ROUT::raises BOOL::not STR::plus STR::plus CONFIG_ROUT::raises STR::plus
if ~void(reads) then r:=r+"\treads"+pastr(reads)+",\n"; end;-- CONFIG_ROUT::reads BOOL::not STR::plus STR::plus CONFIG_ROUT::reads STR::plus
if ~void(writes) then r:=r+"\twrites"+pastr(writes)+",\n"; end;-- CONFIG_ROUT::writes BOOL::not STR::plus STR::plus CONFIG_ROUT::writes STR::plus
if ~void(var) then r:=r+"\tvar"+pastr(var)+",\n"; end;-- CONFIG_ROUT::var BOOL::not STR::plus STR::plus CONFIG_ROUT::var STR::plus
if ~void(declare) then r:=r+"\tdeclare"+pastr(declare)+",\n"; end;-- CONFIG_ROUT::declare BOOL::not STR::plus STR::plus CONFIG_ROUT::declare STR::plus
if ~void(exec) then r:=r+"\texec"+pastr(exec)+";\n"; end;-- CONFIG_ROUT::exec BOOL::not STR::plus STR::plus CONFIG_ROUT::exec STR::plus
if ~void(init) then r:=r+"\tinit"+pastr(init)+",\n"; end;-- CONFIG_ROUT::init BOOL::not STR::plus STR::plus CONFIG_ROUT::init STR::plus
if ~void(temp) then r:=r+"\ttemp"+pastr(temp)+",\n"; end;-- CONFIG_ROUT::temp BOOL::not STR::plus STR::plus CONFIG_ROUT::temp STR::plus
if ~void(break) then r:=r+"\tbreak"+pastr(break)+",\n"; end;-- CONFIG_ROUT::break BOOL::not STR::plus STR::plus CONFIG_ROUT::break STR::plus
if ~void(iter) then r:=r+"\titer"+pastr(iter)+",\n"; end;-- CONFIG_ROUT::iter BOOL::not STR::plus STR::plus CONFIG_ROUT::iter STR::plus
return r;
end;
create(id:STR,exprs:FLIST{FLIST{STR}}):SAME is
r::=new;
r.name:=id;-- CONFIG_ROUT::name
loop
e::=exprs.elt!;-- FLIST{1}::elt!
l::=e[0];-- FLIST{1}::aget
if l="volatile" and e.size=1 then r.volatile:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::volatile
elsif l="fragile" and e.size=1 then r.fragile:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::fragile
elsif l="no_pre" and e.size=1 then r.no_pre:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::no_pre
elsif l="no_post" and e.size=1 then r.no_post:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::no_post
elsif l="import" and e.size=1 then r.does_import:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::does_import
elsif l="export" and e.size=1 then r.does_export:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::does_export
elsif l="block" and e.size=1 then r.block:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::block
elsif l="arith" and e.size=1 then r.arith:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::arith
elsif l="raises_any" and e.size=1 then r.raises_any:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::raises_any
elsif l="reads_any" and e.size=1 then r.reads_any:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::reads_any
elsif l="writes_any" and e.size=1 then r.writes_any:=true;-- STR::is_eq FLIST{1}::size INT::is_eq CONFIG_ROUT::writes_any
elsif l="raises" then r.raises:=get_attr(e);-- STR::is_eq CONFIG_ROUT::raises CONFIG_ROUT::get_attr
elsif l="reads" then r.reads:=get_attr(e);-- STR::is_eq CONFIG_ROUT::reads CONFIG_ROUT::get_attr
elsif l="writes" then r.writes:=get_attr(e);-- STR::is_eq CONFIG_ROUT::writes CONFIG_ROUT::get_attr
elsif l="declare" then r.declare:=get_attr(e);-- STR::is_eq CONFIG_ROUT::declare CONFIG_ROUT::get_attr
elsif l="var" then r.var:=get_attr(e);-- STR::is_eq CONFIG_ROUT::var CONFIG_ROUT::get_attr
elsif l="exec" then r.exec:=get_attr(e);-- STR::is_eq CONFIG_ROUT::exec CONFIG_ROUT::get_attr
elsif l="init" then r.init:=get_attr(e);-- STR::is_eq CONFIG_ROUT::init CONFIG_ROUT::get_attr
elsif l="temp" then r.temp:=get_attr(e);-- STR::is_eq CONFIG_ROUT::temp CONFIG_ROUT::get_attr
elsif l="break" then r.break:=get_attr(e);-- STR::is_eq CONFIG_ROUT::break CONFIG_ROUT::get_attr
elsif l="iter" then r.iter:=get_attr(e);-- STR::is_eq CONFIG_ROUT::iter CONFIG_ROUT::get_attr
elsif l="f_declare" then r.f_declare:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_declare CONFIG_ROUT::get_attr
elsif l="f_var" then r.f_var:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_var CONFIG_ROUT::get_attr
elsif l="f_exec" then r.f_exec:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_exec CONFIG_ROUT::get_attr
elsif l="f_init" then r.f_init:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_init CONFIG_ROUT::get_attr
elsif l="f_temp" then r.f_temp:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_temp CONFIG_ROUT::get_attr
elsif l="f_break" then r.f_break:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_break CONFIG_ROUT::get_attr
elsif l="f_iter" then r.f_iter:=get_attr(e);-- STR::is_eq CONFIG_ROUT::f_iter CONFIG_ROUT::get_attr
else
#OUT+"CONFIG:The definition '"+l+"' is not legal for a builtin routine/iter\n";-- OUT::create OUT::plus OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
end;
if ~void(r.break) then -- CONFIG_ROUT::break BOOL::not
r.use_index:=true;-- CONFIG_ROUT::use_index
else
if ~void(r.init) then-- CONFIG_ROUT::init BOOL::not
loop
if r.init.elt!.search("$#")>=0 then-- CONFIG_ROUT::init ARRAY{1}::elt! STR::search INT::is_lt BOOL::not
r.use_index:=true;-- CONFIG_ROUT::use_index
break!;
end;
end;
end;
if ~r.use_index and ~void(r.iter) then-- CONFIG_ROUT::use_index BOOL::not CONFIG_ROUT::iter BOOL::not
loop
if r.iter.elt!.search("$#")>=0 then-- CONFIG_ROUT::iter ARRAY{1}::elt! STR::search INT::is_lt BOOL::not
r.use_index:=true;-- CONFIG_ROUT::use_index
break!;
end;
end;
end;
if ~void(r.f_init) then-- CONFIG_ROUT::f_init BOOL::not
loop
if r.f_init.elt!.search("$#")>=0 then-- CONFIG_ROUT::f_init ARRAY{1}::elt! STR::search INT::is_lt BOOL::not
r.use_index:=true;-- CONFIG_ROUT::use_index
break!;
end;
end;
end;
if ~r.use_index and ~void(r.f_iter) then-- CONFIG_ROUT::use_index BOOL::not CONFIG_ROUT::f_iter BOOL::not
loop
if r.f_iter.elt!.search("$#")>=0 then-- CONFIG_ROUT::f_iter ARRAY{1}::elt! STR::search INT::is_lt BOOL::not
r.use_index:=true;-- CONFIG_ROUT::use_index
break!;
end;
end;
end;
end;
if void(r.f_iter) then r.f_iter:=r.iter; end;-- CONFIG_ROUT::f_iter CONFIG_ROUT::f_iter CONFIG_ROUT::iter
if void(r.f_break) then r.f_break:=r.break; end;-- CONFIG_ROUT::f_break CONFIG_ROUT::f_break CONFIG_ROUT::break
if void(r.f_var) then r.f_var:=r.var; end;-- CONFIG_ROUT::f_var CONFIG_ROUT::f_var CONFIG_ROUT::var
if void(r.f_exec) then r.f_exec:=r.exec; end;-- CONFIG_ROUT::f_exec CONFIG_ROUT::f_exec CONFIG_ROUT::exec
if void(r.f_declare) then r.f_declare:=r.declare; end;-- CONFIG_ROUT::f_declare CONFIG_ROUT::f_declare CONFIG_ROUT::declare
if void(r.f_temp) then r.f_temp:=r.temp; end;-- CONFIG_ROUT::f_temp CONFIG_ROUT::f_temp CONFIG_ROUT::temp
if void(r.f_init) then r.f_init:=r.init; end;-- CONFIG_ROUT::f_init CONFIG_ROUT::f_init CONFIG_ROUT::init
return r;
end;
end;
-- used for all definitions in the config file with the exception
-- of iters and functions.
class CONFIG_DEF < $CONFIG
class CONFIG_DEF < $CONFIG is
readonly attr name:STR;
readonly attr expr:ARRAY{ARRAY{STR}};
create(n:STR):SAME is
r::=new;
r.name:=n;-- CONFIG_DEF::name
return r;
end;
create(n:STR,e:FLIST{FLIST{STR}}):SAME is
r::=create(n);-- CONFIG_DEF::create
r.expr:=#(e.size);-- CONFIG_DEF::expr ARRAY{1}::create FLIST{1}::size
loop
i::=r.expr.ind!;-- CONFIG_DEF::expr ARRAY{1}::ind!
r.expr[i]:=#(e[i].size);-- CONFIG_DEF::expr ARRAY{1}::aset ARRAY{1}::create FLIST{1}::aget FLIST{1}::size
loop r.expr[i].set!(e[i].elt!); end;-- CONFIG_DEF::expr ARRAY{1}::aget ARRAY{1}::set! FLIST{1}::aget FLIST{1}::elt!
end;
return r;
end;
aget(i:INT):ARRAY{STR} is return expr[i]; end;-- CONFIG_DEF::expr ARRAY{1}::aget
elt!:ARRAY{STR} is loop yield expr.elt!; end; end;-- CONFIG_DEF::expr ARRAY{1}::elt!
size:INT is return expr.size; end;-- CONFIG_DEF::expr ARRAY{1}::size
str:STR is
r::=name+":\n";-- CONFIG_DEF::name STR::plus
first::=true;
loop
l::=expr.elt!;-- CONFIG_DEF::expr ARRAY{1}::elt!
if ~first then r:=r+",\n"; else first:=false; end;-- BOOL::not STR::plus
r:=r+'\t'+l[0].pretty;-- STR::plus STR::plus ARRAY{1}::aget STR::pretty
if l.size>1 then-- ARRAY{1}::size INT::is_lt
loop
r:=r+' '+l[1.upto!(l.size-1)].pretty;-- STR::plus STR::plus ARRAY{1}::aget INT::upto! ARRAY{1}::size INT::minus STR::pretty
end;
end;
end;
return r+";\n";-- STR::plus
end;
end;
class CONFIG_SCANNER
class CONFIG_SCANNER is
private attr fstr:FSTR;
private attr next:INT;
private attr file:STR;
private attr line:INT;
create(filename:STR):SAME is
f::=FILE::open_for_read(filename);-- FILE::open_for_read
if f.error then-- FILE::error
#OUT+"cannot open the config file "+filename+" for reading\n";-- OUT::create OUT::plus OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
r::=new;
r.fstr:=f.fstr;-- CONFIG_SCANNER::fstr FILE::fstr
r.file:=filename;-- CONFIG_SCANNER::file
f.close;-- FILE::close
return r;
end;
private eof:BOOL is return next>=fstr.size; end;-- CONFIG_SCANNER::next CONFIG_SCANNER::fstr FSTR::size BOOL::not
private is_comment:BOOL is
return ~eof and fstr[next]='-' and next+1<fstr.asize and fstr[next+1]='-';-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::next INT::plus CONFIG_SCANNER::fstr FSTR::asize CONFIG_SCANNER::fstr CONFIG_SCANNER::next INT::plus CHAR::is_eq
end;
private skip_comment is
if is_comment then-- CONFIG_SCANNER::is_comment
loop while!(~eof and fstr[next]/='\n');-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
line:=line+1;-- CONFIG_SCANNER::line CONFIG_SCANNER::line INT::plus
end;
end;
private is_white_space:BOOL is
return ~eof and (fstr[next]=' ' or fstr[next]='\t' or fstr[next]='\n' or fstr[next]='\r');-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
end;
private skip_white_space is
loop
loop while!(is_white_space);-- CONFIG_SCANNER::is_white_space
if fstr[next]='\n' then line:=line+1;end;-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::line CONFIG_SCANNER::line INT::plus
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
if is_comment then skip_comment;-- CONFIG_SCANNER::is_comment CONFIG_SCANNER::skip_comment
else break!;
end;
end;
end;
private get_uid!:STR is
loop
skip_white_space;-- CONFIG_SCANNER::skip_white_space
if eof then quit; end;-- CONFIG_SCANNER::eof
start::=next;-- CONFIG_SCANNER::next
if is_uletter or fstr[next]='_' then-- CONFIG_SCANNER::is_uletter CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
loop
while!(is_uletter or is_digit or fstr[next]='_');-- CONFIG_SCANNER::is_uletter CONFIG_SCANNER::is_digit CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
end;
if fstr[next]/=':' or next=start then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not CONFIG_SCANNER::next INT::is_eq
#OUT+file+":"+line+":error, expected an UID followed by a \':\'\n";-- OUT::create CONFIG_SCANNER::file OUT::plus CONFIG_SCANNER::line OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
uid::=fstr.substring(start,next-start).str;-- CONFIG_SCANNER::fstr FSTR::substring CONFIG_SCANNER::next INT::minus FSTR::str
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
yield uid;
end;
end;
private is_digit:BOOL is
return ~eof and fstr[next]>='0' and fstr[next]<='9';-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt
end;
private is_uletter:BOOL is
return ~eof and fstr[next]>='A' and fstr[next]<='Z';-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt
end;
private is_letter:BOOL is
return ~eof and is_uletter or (fstr[next]>='a' and fstr[next]<='z');-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::is_uletter CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_lt BOOL::not
end;
private is_string:BOOL is return fstr[next]='"'; end;-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
private get_digit:STR is
start::=next;-- CONFIG_SCANNER::next
next:=next+1; -- first character has already been tested;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
loop
while!(is_digit);-- CONFIG_SCANNER::is_digit
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
r::=fstr.substring(start,next-start).str;-- CONFIG_SCANNER::fstr FSTR::substring CONFIG_SCANNER::next INT::minus FSTR::str
return r;
end;
private get_string:STR is -- return a string, removes '"' and converts
-- any special characters
start::=next;-- CONFIG_SCANNER::next
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
loop
while!(~eof and fstr[next]/='"' or fstr[next-1]='\\');-- CONFIG_SCANNER::eof BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next INT::minus CHAR::is_eq
if fstr[next]='\n' then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
#OUT+file+":"+line+": runaway string\n";-- OUT::create CONFIG_SCANNER::file OUT::plus CONFIG_SCANNER::line OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
if eof or fstr[next]/='"' then-- CONFIG_SCANNER::eof CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not
#OUT+file+":"+line+": runaway string\n";-- OUT::create CONFIG_SCANNER::file OUT::plus CONFIG_SCANNER::line OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
r::=fstr.substring(start,next-start).str;-- CONFIG_SCANNER::fstr FSTR::substring CONFIG_SCANNER::next INT::minus FSTR::str
if r="\"\"" then return "";-- STR::is_eq
else return r.as_literal;-- STR::as_literal
end;
end;
private get_id:STR is
start::=next;-- CONFIG_SCANNER::next
if is_letter then-- CONFIG_SCANNER::is_letter
loop
while!(is_letter or is_digit or fstr[next]='_');-- CONFIG_SCANNER::is_letter CONFIG_SCANNER::is_digit CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
end;
end;
return fstr.substring(start,next-start).str;-- CONFIG_SCANNER::fstr FSTR::substring CONFIG_SCANNER::next INT::minus FSTR::str
end;
private get_expr:FLIST{STR} is
skip_white_space;-- CONFIG_SCANNER::skip_white_space
r:FLIST{STR};
if fstr[next]=';' then -- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
return void;
elsif fstr[next]='+' or fstr[next]='-' or is_digit then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::is_digit
r:=r.push(get_digit);-- FLIST{1}::push CONFIG_SCANNER::get_digit
elsif is_string then -- CONFIG_SCANNER::is_string
r:=r.push(get_string);-- FLIST{1}::push CONFIG_SCANNER::get_string
else
r:=r.push(get_id);-- FLIST{1}::push CONFIG_SCANNER::get_id
skip_white_space;-- CONFIG_SCANNER::skip_white_space
-- if fstr[next]='(' then
-- next:=next+1;
-- loop
-- skip_white_space;
-- while!(fstr[next]/=')');
-- if fstr[next]='+' or fstr[next]='-' or is_digit then
-- r:=r.push(get_digit);
-- elsif is_string then
-- r:=r.push(get_string);
-- else
-- r:=r.push(get_id);
-- end;
-- skip_white_space;
-- if fstr[next]=',' then
-- next:=next+1;
-- elsif fstr[next]=')' then
-- next:=next+1;
-- break!;
-- else
-- #OUT+file+":"+line+":expected a ',' or ')', but got a "+fstr[next]+"\n";
-- UNIX::exit(1);
-- end;
-- end;
-- els
if fstr[next]/=',' and fstr[next]/=';' then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not
loop
if fstr[next]='+' or fstr[next]='-' or is_digit then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::is_digit
r:=r.push(get_digit);-- FLIST{1}::push CONFIG_SCANNER::get_digit
elsif is_string then -- CONFIG_SCANNER::is_string
r:=r.push(get_string);-- FLIST{1}::push CONFIG_SCANNER::get_string
else
r:=r.push(get_id);-- FLIST{1}::push CONFIG_SCANNER::get_id
end;
skip_white_space;-- CONFIG_SCANNER::skip_white_space
if fstr[next]=',' or fstr[next]=';' then break!; end;-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
end;
end;
end;
skip_white_space;-- CONFIG_SCANNER::skip_white_space
if fstr[next]=',' then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
elsif fstr[next]/=';' then-- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq BOOL::not
#OUT+file+":"+line+":expected a ',' or a ';', but got a "+fstr[next]+"\n";-- OUT::create CONFIG_SCANNER::file OUT::plus CONFIG_SCANNER::line OUT::plus CONFIG_SCANNER::fstr CONFIG_SCANNER::next OUT::plus
UNIX::exit (1);-- UNIX::exit
end;
return r;
end;
private get_expr!:FLIST{STR} is
r:STR;
loop
skip_white_space;-- CONFIG_SCANNER::skip_white_space
if fstr[next]=';' then -- CONFIG_SCANNER::fstr CONFIG_SCANNER::next CHAR::is_eq
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
quit;
end;
yield get_expr;-- CONFIG_SCANNER::get_expr
end;
next:=next+1;-- CONFIG_SCANNER::next CONFIG_SCANNER::next INT::plus
skip_white_space;-- CONFIG_SCANNER::skip_white_space
end;
get_def!:$CONFIG is
next:=0;-- CONFIG_SCANNER::next
line:=1;-- CONFIG_SCANNER::line
loop
id::=get_uid!;-- CONFIG_SCANNER::get_uid!
exprs:FLIST{FLIST{STR}};
exprs:=void;
loop
exprs:=exprs.push(get_expr!);-- FLIST{1}::push CONFIG_SCANNER::get_expr!
end;
if CONFIG_ROUT::is_iter(exprs) then yield #CONFIG_ROUT(id,exprs);-- CONFIG_ROUT::is_iter CONFIG_ROUT::create
elsif CONFIG_ROUT::is_rout(exprs) then yield #CONFIG_ROUT(id,exprs);-- CONFIG_ROUT::is_rout CONFIG_ROUT::create
else yield #CONFIG_DEF(id,exprs); end;-- CONFIG_DEF::create
end;
end;
end;
-- reads the CONFIG file and stores it in RAM for easy and
-- fast retrieval.
class CONFIG_TBL < $STR
class CONFIG_TBL < $STR is
private attr tbl:FMAP{STR,$CONFIG};
private check_for_strings(s:STR) is
r::=get(s);-- CONFIG_TBL::get
if void(r) then
#OUT+s+" is missing in the config file (should be some string[s])\n";-- OUT::create OUT::plus OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
typecase r when CONFIG_DEF then
if r.size=0 then-- CONFIG_DEF::size INT::is_eq
#OUT+s+" should be defined as some strings in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(-1);-- UNIX::exit
end;
loop
i::=0.upto!(r.size-1);-- INT::upto! CONFIG_DEF::size INT::minus
if r[i].size/=1 then-- CONFIG_DEF::aget ARRAY{1}::size INT::is_eq BOOL::not
#OUT+s+" should be defined as some strings in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(-1);-- UNIX::exit
end;
end;
else
#OUT+s+" should be defined as some string[s] in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
end;
private check_for_string(s:STR,n:INT) is
r::=get(s);-- CONFIG_TBL::get
if void(r) then
#OUT+s+" is missing in the config file (should be "+n+" string[s])\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
typecase r when CONFIG_DEF then
if r.size/=n then-- CONFIG_DEF::size INT::is_eq BOOL::not
#OUT+s+" should be defined as "+n+" strings in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(-1);-- UNIX::exit
end;
loop
i::=0.upto!(n-1);-- INT::upto! INT::minus
if r[i].size/=1 then-- CONFIG_DEF::aget ARRAY{1}::size INT::is_eq BOOL::not
#OUT+s+" should be defined as "+n+" strings in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(-1);-- UNIX::exit
end;
end;
else
#OUT+s+" should be defined as "+n+" string[s] in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
end;
private check_for_bool(s:STR) is
r::=get(s);-- CONFIG_TBL::get
if void(r) then
#OUT+s+" is missing in the config file (should be true or false)\n";-- OUT::create OUT::plus OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
typecase r when CONFIG_DEF then
if r.size/=1 or r[0].size/=1 or (r[0][0]/="true" and r[0][0]/="false") then-- CONFIG_DEF::size INT::is_eq BOOL::not CONFIG_DEF::aget ARRAY{1}::size INT::is_eq BOOL::not CONFIG_DEF::aget ARRAY{1}::aget STR::is_eq BOOL::not CONFIG_DEF::aget ARRAY{1}::aget STR::is_eq BOOL::not
#OUT+s+" should be defined as 'true' or 'false' in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(-1);-- UNIX::exit
end;
else
#OUT+s+" should be defined as 'true' or 'false' in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
end;
private check_for_int(s:STR) is
r::=get(s);-- CONFIG_TBL::get
if void(r) then
#OUT+s+" is missing in the config file (should be an INT)\n";-- OUT::create OUT::plus OUT::plus
UNIX::exit(1);-- UNIX::exit
end;
typecase r when CONFIG_DEF then
if r.size/=1 or r[0].size/=1 then-- CONFIG_DEF::size INT::is_eq BOOL::not CONFIG_DEF::aget ARRAY{1}::size INT::is_eq BOOL::not
#OUT+s+" should be defined as an INT in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(1);-- UNIX::exit
end;
a::=r[0][0];-- CONFIG_DEF::aget ARRAY{1}::aget
loop
i::=0.upto!(a.size-1);-- INT::upto! STR::size INT::minus
if ~((i=0 and (a[i]='+' or a[i]='-')) or (a[i]>='0' and a[i]<='9')) then-- INT::is_eq STR::aget CHAR::is_eq STR::aget CHAR::is_eq STR::aget CHAR::is_lt BOOL::not STR::aget CHAR::is_lt BOOL::not BOOL::not
#OUT+s+" should be defined as an INT in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus CONFIG_DEF::str
UNIX::exit(1);-- UNIX::exit
end;
end;
else
#OUT+s+" should be defined as an INT in the CONFIG file.\n";-- OUT::create OUT::plus OUT::plus
#OUT+"it is defined as\n"+r.str;-- OUT::create OUT::plus OUT::plus
UNIX::exit(-1);-- UNIX::exit
end;
end;
private defined(s:STR):BOOL is return ~void(get(s)); end;
private check is
check_for_string("C_COMPILER",1);-- CONFIG_TBL::check_for_string
check_for_string("MAKE_COMMAND",1);-- CONFIG_TBL::check_for_string
check_for_string("OBJECT_EXT",1);-- CONFIG_TBL::check_for_string
check_for_string("LIB_EXT",1);-- CONFIG_TBL::check_for_string
check_for_string("C_EXT",1);-- CONFIG_TBL::check_for_string
check_for_string("SHELL_SEP",1);-- CONFIG_TBL::check_for_string
check_for_string("EXEC_OPTION",1);-- CONFIG_TBL::check_for_string
check_for_string("CC_DEBUG_FLAG",2);-- CONFIG_TBL::check_for_string
check_for_string("CC_OPTIMIZE_FLAG",2);-- CONFIG_TBL::check_for_string
check_for_string("MAKE_VERBOSE_FLAG",2);-- CONFIG_TBL::check_for_string
check_for_string("CC_PROLIX_FLAG",2);-- CONFIG_TBL::check_for_string
check_for_strings("BUILTIN_CLASSES");-- CONFIG_TBL::check_for_strings
check_for_strings("REFERENCE_FREE");-- CONFIG_TBL::check_for_strings
check_for_strings("PLATFORMS");-- CONFIG_TBL::check_for_strings
check_for_strings("DEFAULT_PLATFORM");-- CONFIG_TBL::check_for_strings
check_for_bool("NULL_SEGFAULTS");-- CONFIG_TBL::check_for_bool
check_for_bool("SEPARATE_POINTERS");-- CONFIG_TBL::check_for_bool
check_for_bool("THREADS");-- CONFIG_TBL::check_for_bool
check_for_bool("DISTRIBUTED");-- CONFIG_TBL::check_for_bool
check_for_bool("ZONES");-- CONFIG_TBL::check_for_bool
check_for_bool("TRACE");-- CONFIG_TBL::check_for_bool
check_for_string("LIBRARY",2);-- CONFIG_TBL::check_for_string
check_for_strings("ATOMIC_CLASSES");-- CONFIG_TBL::check_for_strings
check_for_int("POLLING");-- CONFIG_TBL::check_for_int
end;
create:SAME is return new; end;
create(filename:STR):SAME is
r::=new;
r.read(filename);-- CONFIG_TBL::read
return r;
end;
read(filename:STR) is
s::=#CONFIG_SCANNER(filename);-- CONFIG_SCANNER::create
loop
e::=s.get_def!;-- CONFIG_SCANNER::get_def!
tbl:=tbl.insert(e.name,e);-- CONFIG_TBL::tbl CONFIG_TBL::tbl FMAP{2}::insert
end;
check;-- CONFIG_TBL::check
end;
get(s:STR):$CONFIG is
return tbl.get(s);-- CONFIG_TBL::tbl FMAP{2}::get
end;
get_rout(s:STR):CONFIG_ROUT is
r::=tbl.get(s);-- CONFIG_TBL::tbl FMAP{2}::get
typecase r when CONFIG_ROUT then
return r;
else return void;
end;
end;
get_def(s:STR):CONFIG_DEF is
r::=tbl.get(s);-- CONFIG_TBL::tbl FMAP{2}::get
typecase r when CONFIG_DEF then return r;
else return void;
end;
end;
get_str(s:STR,i:INT):STR is
r::=get_def(s);-- CONFIG_TBL::get_def
if void(r) or i>=r.size then return ""; end;-- INT::is_lt CONFIG_DEF::size BOOL::not
return r[i][0];-- CONFIG_DEF::aget ARRAY{1}::aget
end;
get_bool(s:STR):BOOL is
r::=get_def(s);-- CONFIG_TBL::get_def
return ~void(r) and r[0][0]="true";-- BOOL::not CONFIG_DEF::aget ARRAY{1}::aget STR::is_eq
end;
str:STR is
r::="";
loop r:=r+tbl.targets!; end;-- CONFIG_TBL::tbl FMAP{2}::targets!
return r;
end;
end;
class TEST_CONFIG
class TEST_CONFIG is
main is
t::=#CONFIG_TBL("CONFIG");
#OUT+t.str+"\n";
#OUT+"\n";
#OUT+t.get("MAKE");
#OUT+t.get_def("PSATHER_FLAG");
#OUT+t.get_rout("INT_UPTO");
#OUT+t.get_rout("INT_PLUS");
#OUT+t.get_rout("xxx");
end;
end;
-- vim:sw=3:nosmartindent