TermCapsImpl:
CEDAR
PROGRAM
IMPORTS Ascii, BasicTime, Convert, FS, IO, OrderedSymbolTableRef, Real, Rope
EXPORTS TermCaps
= {OPEN TermCaps;
cancel: PUBLIC Val ← NEW [ROPE ← "cancel"];
Bitch: SIGNAL [fmt: ROPE, v1: IO.Value ← [null[]]] = CODE;
Busted: ERROR = CODE;
termCaps: SymbolTable ← NIL;
defaultTerm: Term ← NIL;
EnumerateCaps:
PUBLIC
PROC [term: Term, consume:
PROC [cap: Cap]
RETURNS [stop:
BOOL]] = {
ExceptNone: PROC [cap: Cap] RETURNS [e: BOOL] = {e ← FALSE};
Work:
PROC [term: Term, except:
PROC [cap: Cap]
RETURNS [
BOOL]] = {
ExceptMine:
PROC [cap: Cap]
RETURNS [e:
BOOL] = {
IF term.caps.Lookup[cap] # NIL THEN RETURN [TRUE];
e ← except[cap]};
PerCap:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
cap: Cap ← NARROW[ra];
stop ← FALSE;
IF cap.val = cancel THEN RETURN;
IF except[cap] THEN RETURN;
stop ← consume[cap];
};
term.caps.EnumerateIncreasing[PerCap];
IF term.default # NIL THEN Work[term.default, ExceptMine];
};
Work[term, ExceptNone];
};
GetCap:
PUBLIC
PROC [term: Term, name:
ROPE, default: Val ←
NIL]
RETURNS [val: Val] = {
cap: Cap ← NARROW[term.caps.Lookup[name]];
IF cap # NIL THEN RETURN [IF cap.val = cancel THEN default ELSE cap.val];
IF term.default # NIL THEN val ← GetCap[term.default, name, default] ELSE val ← default;
};
GetTerm:
PUBLIC
PROC [tc: TermCap, name:
ROPE]
RETURNS [term: Term] = {
term ← AntiAlias[tc.contents.Lookup[name]];
};
TCTerm:
PROC [tc: TermCap, name:
ROPE]
RETURNS [term: Term] = {
term ← AntiAlias[tc.contents.Lookup[name]];
IF term =
NIL
THEN {
a: Alias ←
NEW [AliasRep ← [
name: name,
val: term ←
NEW [TermRep ← [
names: LIST[name],
caps: OrderedSymbolTableRef.CreateTable[CompareCaps],
default: defaultTerm]]
]];
tc.contents.Insert[a];
};
};
EnumerateTerms:
PUBLIC
PROC [tc: TermCap, consume:
PROC [term: Term]
RETURNS [stop:
BOOL]] = {
PerAlias:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL] = {
a: Alias ← NARROW[ra];
IF NOT (a.name = a.val.names.first) THEN RETURN [FALSE];
stop ← consume[a.val];
};
tc.contents.EnumerateIncreasing[PerAlias];
};
GetTermCap:
PUBLIC
PROC [fileName:
ROPE, wDir:
ROPE ←
NIL]
RETURNS [tc: TermCap] = {
gName: ROPE;
created: GMT;
exists: BOOL ← TRUE;
rfi: REF FileID;
from: IO.STREAM;
[fullFName: gName, created: created] ← FS.FileInfo[name: fileName, wDir: wDir !FS.Error => {exists ← FALSE; CONTINUE}];
IF NOT exists THEN RETURN [NIL];
rfi ← NEW [FileID ← [gName, created]];
tc ← NARROW[termCaps.Lookup[rfi]];
IF tc # NIL THEN RETURN [tc];
tc ←
NEW [TermCapRep ← [
fileID: rfi^,
contents: OrderedSymbolTableRef.CreateTable[CompareTerms]
]];
from ← FS.StreamOpen[gName];
termCaps.Insert[tc];
ParseTermCap[from, tc !
Bitch => {
tc.complaints ← tc.complaints.Cat[
IO.PutFR[
Rope.Cat["At %g[%g]: ", fmt, "\n"],
IO.rope[gName],
IO.int[from.GetIndex[]],
v1]
];
RESUME;
};
IO.EndOfStream => CONTINUE;
];
};
ParseTermCap:
PROC [from:
IO.
STREAM, tc: TermCap] = {
atStart: BOOL ← TRUE;
DO
ENABLE Busted => {Bitch["busted"]; LOOP};
term: Term ← NIL;
names: RopeList ← NIL;
nameCount: NAT ← 0;
bestName: ROPE ← NIL;
First, look for begin of entry: a line starting with alphabetic
DO
char: CHAR;
IF atStart THEN atStart ← FALSE ELSE [] ← from.GetLineRope[];
char ← from.PeekChar[];
SELECT char
FROM
IN ['a .. 'z], IN ['A .. 'Z] => EXIT;
ENDCASE;
ENDLOOP;
Next, parse names
DO
name, sep: ROPE;
namedTerm: Term;
name ← from.GetTokenRope[TermNameBuster].token;
IF name.Equal["|"] THEN {Bitch["empty name"]; LOOP};
IF name.Equal[":"] THEN {Bitch["empty name"]; EXIT};
nameCount ← nameCount + 1;
IF nameCount <= 2 THEN bestName ← name;
namedTerm ← GetTerm[tc, name];
IF namedTerm = term THEN NULL
ELSE IF term = NIL THEN term ← namedTerm
ELSE IF namedTerm # NIL THEN Bitch["term name collision on %g", IO.rope[name]];
IF namedTerm = NIL THEN names ← CONS[name, names];
sep ← from.GetTokenRope[TermNameBuster].token;
IF sep.Equal[":"] THEN EXIT;
IF NOT sep.Equal["|"] THEN ERROR;
ENDLOOP;
IF term =
NIL
THEN term ←
NEW [TermRep ← [
caps: OrderedSymbolTableRef.CreateTable[CompareCaps],
default: defaultTerm
]];
term.bestName ← bestName;
FOR names ← names, names.rest
WHILE names #
NIL
DO
a: Alias ← NEW [AliasRep ← [names.first, term]];
term.names ← CONS[names.first, term.names];
tc.contents.Insert[a !OrderedSymbolTableRef.DuplicateKey => {
CONTINUE--can only collide with same term--}];
ENDLOOP;
Finally, parse capabilities
DO
capName: ROPE;
cap: Cap;
cancelIt: BOOL ← FALSE;
char: CHAR;
Ignore end-of-line?
IF from.PeekChar[] = '\\
THEN {
char: CHAR;
IF (char ← from.GetChar[]) # '\\ THEN ERROR;
IF NOT White[from.PeekChar[]] THEN Busted[];
[] ← from.SkipWhitespace[];
IF (char ← from.GetChar[]) # ': THEN Busted[];
LOOP;
};
IF White[from.PeekChar[]] THEN EXIT--done with caps--;
capName ← from.GetTokenRope[CapNameBuster].token;
IF capName.Length[] = 1 THEN Busted[];
cap ← NEW [CapRep ← [capName, NIL]];
char ← from.GetChar[];
IF char = '@
THEN {
cancelIt ← TRUE;
char ← from.GetChar[];
};
SELECT char
FROM
': => cap.val ← NEW [BOOL ← TRUE];
'# => {
cap.val ← NEW [INT ← from.GetInt[!IO.Error => Busted[]]];
IF from.GetChar[] # ': THEN Busted[];
};
'= => cap.val ← ParseString[from];
ENDCASE => Busted[];
IF cancelIt THEN cap.val ← cancel;
IF cap.name.Equal["tc"]
THEN {
defName: String ← NIL;
default: Term;
WITH cap.val
SELECT
FROM
s: String => defName ← s;
ENDCASE => defName ← NIL;
IF defName = NIL THEN Bitch["tc not a string"]
ELSE {
default ← defaultTerm;
IF defName.str.Length[] > 0 THEN default ← TCTerm[tc, defName.str]
ELSE {
i: INT ← Real.RoundLI[defName.pad];
IF i # 0
THEN {
name: ROPE ← Convert.RopeFromInt[i];
default ← TCTerm[tc, name]
};
};
term.default ← default
};
}
ELSE {
term.caps.Insert[cap !OrderedSymbolTableRef.DuplicateKey =>
CONTINUE --left value overrides right--];
};
ENDLOOP;
ENDLOOP;
};
TermNameBuster:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ←
SELECT char
FROM
'|, ': => break,
ENDCASE => other};
CapNameBuster:
PROC [char:
CHAR]
RETURNS [cc:
IO.CharClass]
--IO.BreakProc-- = {
cc ←
SELECT char
FROM
':, '#, '=, '@ => break,
IN [0C .. Ascii.SP] => sepr,
ENDCASE => other};
White:
PROC [c:
CHAR]
RETURNS [white:
BOOL] =
{white ← c IN [0C .. Ascii.SP]};
Numeric:
PROC [c:
CHAR]
RETURNS [numeric:
BOOL] =
{numeric ← (c IN ['0 .. '9]) OR (c = '.)};
ParseString:
PROC [from:
IO.
STREAM]
RETURNS [s: String] = {
padChars, strVal: ROPE ← NIL;
char: CHAR;
dotSeen, proportional: BOOL ← FALSE;
FOR char ← from.PeekChar[], from.PeekChar[]
WHILE Numeric[char]
DO
IF from.GetChar[] # char THEN ERROR;
IF char = '. THEN dotSeen ← TRUE;
padChars ← padChars.Cat[Rope.FromChar[char]];
ENDLOOP;
IF from.PeekChar[] = '*
THEN {
IF from.GetChar[] # '* THEN ERROR;
proportional ← TRUE};
DO
char ← from.GetChar[];
IF char = ': THEN EXIT;
SELECT char
FROM
'^ => {char ← from.GetChar[];
char ← Ascii.Control[char]};
'\\ => {char ← from.GetChar[];
SELECT char
FROM
'E => char ← Ascii.ESC;
'n => char ← '\012;
'r => char ← '\015;
't => char ← '\t;
'b => char ← '\010;
'f => char ← '\014;
IN ['0 .. '7] => {
octChars: ROPE ← Rope.FromChar[char];
IF from.PeekChar[]
IN ['0 .. '7]
THEN {
octChars ← octChars.Concat[Rope.FromChar[from.GetChar[]]];
IF from.PeekChar[]
IN ['0 .. '7]
THEN {
octChars ← octChars.Concat[Rope.FromChar[from.GetChar[]]];
};
};
char ← '\000 + Convert.CardFromRope[octChars, 8];
};
'^, '\\ => char ← char;
ENDCASE => char ← char --really should Bitch, but UNIX is so sloppy, this saves a lot of headaches--;
};
ENDCASE;
strVal ← strVal.Cat[Rope.FromChar[char]];
ENDLOOP;
s ←
NEW [StringRep ← [
pad: IF padChars = NIL THEN 0.0 ELSE IF dotSeen THEN Convert.RealFromRope[padChars] ELSE REAL[Convert.IntFromRope[padChars]],
proportional: proportional,
str: strVal]];
};
CompareCaps:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [name:
ROPE] = {
WITH r
SELECT
FROM
c: Cap => name ← c.name;
r: ROPE => name ← r;
ENDCASE => ERROR};
c ← Key[r1].Compare[Key[r2]];
};
CompareTerms:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [name:
ROPE] = {
WITH r
SELECT
FROM
a: Alias => name ← a.name;
r: ROPE => name ← r;
ENDCASE => ERROR};
c ← Key[r1].Compare[Key[r2]];
};
CompareTermCaps:
PROC [r1, r2:
REF
ANY]
RETURNS [c: Basics.Comparison] = {
Key:
PROC [r:
REF
ANY]
RETURNS [fi: FileID] = {
WITH r
SELECT
FROM
tc: TermCap => fi ← tc.fileID;
rfi: REF FileID => fi ← rfi^;
ENDCASE => ERROR};
fi1: FileID ← Key[r1];
fi2: FileID ← Key[r2];
c ← fi1.gName.Compare[fi2.gName, FALSE];
IF c = equal
THEN c ←
SELECT BasicTime.Period[from: fi2.create, to: fi1.create]
FROM
<0 => less,
=0 => equal,
>0 => greater,
ENDCASE => ERROR;
};
AntiAlias:
PROC [ra:
REF
ANY]
RETURNS [t: Term] = {
IF ra = NIL THEN RETURN [NIL];
WITH ra
SELECT
FROM
a: Alias => RETURN [a.val];
ENDCASE => ERROR};
Add:
PROC [name:
ROPE, val: Val] = {
c: Cap← NEW [CapRep ← [name, val]];
defaultTerm.caps.Insert[c];
};
Start:
PROC = {
termCaps ← OrderedSymbolTableRef.CreateTable[CompareTermCaps];
defaultTerm ←
NEW [TermRep ← [
names: NIL,
caps: OrderedSymbolTableRef.CreateTable[CompareCaps]
]];
Add["cr", NEW [StringRep ← [str: "\015"]]];
Add["ff", NEW [StringRep ← [str: "\014"]]];
Add["nl", NEW [StringRep ← [str: "\012"]]];
Add["pc", NEW [StringRep ← [str: "\000"]]];
};
Start[];
}.