MODULE; IMPORT Rd; IMPORT CharRange; IMPORT CharCodes; IMPORT Text; IMPORT TextSubs; IMPORT TextList; IMPORT TextIntTbl; IMPORT IntTextTbl; IMPORT Thread; IMPORT FileRdErr; IMPORT TextReader; IMPORT Pragma, PragmaRead; IMPORT Wr, TextWr; TokSpec
IMPORT Stdio;
<* FATAL Rd.EndOfFile, Rd.Failure, Wr.Failure, Thread.Alerted *> REVEAL T = Public BRANDED OBJECT OVERRIDES init := Init; read := Read; error := Error; fmtVar := FmtVar; fmtOrig := FmtOrig; END; PROCEDUREInit (self: T): T = BEGIN self.tokens := NIL; self.varTokens := NIL; self.charTokens := CharRange.NoChars; self.lastConstCode := ORD(LAST(CHAR)); self.constTokens := NEW(TextIntTbl.Default).init(); self.constTokensR := NEW(IntTextTbl.Default).init(); RETURN self; END Init; TYPE TokPragma = Pragma.T OBJECT spec: T; END; PROCEDUREParseCharToken (p: TokPragma; rd: Rd.T) = VAR self := p.spec; line := Rd.GetLine(rd); r1 := Text.FindChar(line, '['); r2 := Text.FindCharR(line, ']'); BEGIN IF r1 = -1 THEN self.error(rd, "%char: enclose in []"); END; IF r2 = -1 THEN self.error(rd, "%char: missing `]'"); END; self.charTokens := self.charTokens + CharRange.FromText(Text.Sub(line, r1, r2-r1+1)); END ParseCharToken; PROCEDUREShatterLine (rd: Rd.T): TextList.T = VAR line := Rd.GetLine(rd); tr := NEW(TextReader.T).init(line); BEGIN
Wr.PutText(Stdio.stderr, line & \n
);
RETURN tr.shatter(" ,", "", TRUE); END ShatterLine; PROCEDUREParseConstToken (p: TokPragma; rd: Rd.T) = VAR self := p.spec; cur := ShatterLine(rd); BEGIN (* DebugPrintList(cur, "Const"); *) self.tokens := TextList.Append(self.tokens, cur); WHILE cur # NIL DO INC(self.lastConstCode); EVAL self.constTokens.put(cur.head, self.lastConstCode); EVAL self.constTokensR.put(self.lastConstCode, cur.head); cur := cur.tail; END; END ParseConstToken; PROCEDUREMakeCharConsts (self: T) = VAR name: TEXT; code: INTEGER; BEGIN FOR c := FIRST(CHAR) TO LAST(CHAR) DO IF c IN self.charTokens THEN code := ORD(c); name := CharCodes.QC(c); EVAL self.constTokens.put(name, code); EVAL self.constTokensR.put(code, name); END; END; END MakeCharConsts;
PROCEDURE DebugPrintList(a: TextList.T; m: TEXT) =
VAR
cur := a;
BEGIN
WHILE cur # NIL DO
Wr.PutText(Stdio.stderr, m & :
& cur.head & \n
);
cur := cur.tail;
END;
END DebugPrintList;
PROCEDUREParseToken (p: TokPragma; rd: Rd.T) = VAR self := p.spec; newTokens := ShatterLine(rd); BEGIN (* DebugPrintList(newTokens, "VAR"); *) self.tokens := TextList.Append(self.tokens, newTokens); self.varTokens := TextList.Append(self.varTokens, newTokens); END ParseToken; PROCEDURECheckDuplicates (self: T) = VAR cur := self.tokens; check := NEW(TextIntTbl.Default).init(); dummy: INTEGER; BEGIN WHILE cur # NIL DO IF check.get(cur.head, dummy) THEN self.error(NIL, "duplicate token: " & CharCodes.Q(cur.head)); ELSE EVAL check.put(cur.head, dummy); END; cur := cur.tail; END; END CheckDuplicates; PROCEDURERead (self: T; from: Rd.T) = VAR charToken := NEW(TokPragma, spec := self, do := ParseCharToken); const := NEW(TokPragma, spec := self, do := ParseConstToken); token := NEW(TokPragma, spec := self, do := ParseToken); prag := NEW(PragmaRead.T).init(); BEGIN prag.add(charToken, "%char"); prag.add(const, "%const"); prag.add(token, "%token"); prag.add(token, ""); prag.apply(from); MakeCharConsts(self); CheckDuplicates(self); END Read; PROCEDUREError (<*UNUSED*>self: T; rd: Rd.T; message: TEXT) = BEGIN FileRdErr.E(rd, message); END Error; PROCEDUREFmtVar (self: T; form: TEXT): TEXT = VAR cur := self.varTokens; wr := TextWr.New(); subs: TextSubs.T; BEGIN WHILE cur # NIL DO subs := NEW(TextSubs.T).init(); subs.add("%name", cur.head); Wr.PutText(wr, subs.apply(form)); cur := cur.tail; END; RETURN TextWr.ToText(wr); END FmtVar; PROCEDUREFmtOrig (self: T; tokMN: TEXT): TEXT = VAR tokMNa: TEXT; BEGIN IF tokMN = NIL THEN tokMNa := ""; ELSE tokMNa := tokMN & ".Original_"; END; RETURN self.fmtVar(" Original_%name = " &tokMNa& "%name;\n"); END FmtOrig; BEGIN END TokSpec.