klex/derived/lexformBundle.m3


MODULE lexformBundle;
Generated by m3bundle; see its manpage.

IMPORT Bundle, BundleRep, Text;
IMPORT Thread, Wr, TextWr;

TYPE T = Bundle.T OBJECT OVERRIDES
           get      := LookUp;
           getNames := GetNames;
         END;

TYPE Texts = REF ARRAY OF TEXT;

VAR
  bundle: T     := NIL;
  names : Texts := NIL;

PROCEDURE Get(): Bundle.T =
  BEGIN
    IF (bundle = NIL) THEN bundle := NEW (T) END;
    RETURN bundle;
  END Get;

PROCEDURE GetNames (<*UNUSED*> self: T): Texts =
  BEGIN
    IF names = NIL THEN
      names := NEW (Texts, NUMBER (Names));
      names^ := Names;
    END;
    RETURN names;
  END GetNames;

PROCEDURE LookUp (<*UNUSED*> self: T;  element: TEXT): TEXT =
  BEGIN
    FOR i := 0 TO LAST (Names)-1 DO
      IF Text.Equal (Names[i], element) THEN
        IF Elements[i] = NIL THEN Elements[i] := GetElt (i) END;
        RETURN Elements[i];
      END;
    END;
    RETURN NIL;
  END LookUp;

CONST Names = ARRAY [0..3] OF TEXT {
  "lexform.i3",
  "lexform.proc.m3",
  "lexform.m3",
  NIL
};

VAR Elements := ARRAY [0..3] OF TEXT {
  E0,
  E1,
  NIL (* E2 .. E2_1 *),
  NIL
};

PROCEDURE GetElt (n: INTEGER): TEXT =
  <*FATAL Thread.Alerted, Wr.Failure *>
  VAR wr := TextWr.New ();
  BEGIN
    CASE n OF
    | 2 =>
        Wr.PutText (wr, E2);
        Wr.PutText (wr, E2_0);
        Wr.PutText (wr, E2_1);
    ELSE (*skip*)
    END;
    RETURN TextWr.ToText (wr);
  END GetElt;

CONST E0 =
   "INTERFACE %lex;\n%gen\n(* original lexer definition *)\nIMPORT %tok;\nF"
 & "ROM %tok IMPORT Token;\nTYPE\n  T <: Public;\n  Public = %tok.RdLexer O"
 & "BJECT\n  METHODS\n    (* return Token for a regexp type *)\n%methods\\\n"
 & "  END;\nEND %lex.\n";

CONST E1 =
   "PROCEDURE %name(self: T): Token = BEGIN\n %default;END %name;\n\n";

CONST E2 =
   "MODULE %lex;\n%gen\nIMPORT %tok;\nIMPORT TextRd;\nIMPORT Rd, Thread;\nI"
 & "MPORT SeekRd;\nFROM %tok IMPORT Token;\n<* FATAL Rd.Failure, Thread.Ale"
 & "rted *>\n\nREVEAL\n  T = Public BRANDED \"%lex\" OBJECT\n    textCache:"
 & " TEXT;\n    charCache: CHAR;\n    posBeforeToken: INTEGER;\n    rd: Rd."
 & "T;\n%alloc\\\n  OVERRIDES\n    setRd := SetRd;\n    get := Get;\n    un"
 & "get := Unget;\n    error := Error;\n    rewind := Rewind;\n    fromText"
 & " := FromText;\n    getRd := GetRd;\n    getText := GetText;\n    purge "
 & ":= Purge;\n%ovr\\\n  END;\n\nTYPE\n  Byte = BITS 8 FOR [0..255];\n  Sta"
 & "teRef = BITS %lastStateRefBits FOR [0..%lastStateRefVal];\n  TransRef ="
 & " BITS %lastTransRefBits FOR [0..%lastTransRefVal];\n  OutCode = BITS %l"
 & "astOutBits FOR [0..%lastOutVal];\n\n  S = RECORD\n    keyBegin, keyEnd:"
 & " Byte;\n    target: StateRef;\n    next: TransRef;\n    output: OutCode"
 & ";\n  END;\n  X = RECORD\n    keyBegin, keyEnd: Byte;\n    target: State"
 & "Ref;\n    next: TransRef;\n  END;\n\nCONST\n  First = ARRAY CHAR OF [0."
 & ".%lastStateRefVal] {\n%First};\n\n  States = ARRAY [1..%lastStateRefVal"
 & "] OF S {\n%States};\n\n  Trans = ARRAY [1..%lastTransRefVal] OF X {\n%T"
 & "rans};\n\nPROCEDURE SetRd(self: T; rd: Rd.T): %tok.RdLexer =\n  BEGIN\n"
 & "    self.textCache := \"\";\n    self.charCache := \'\\000\';\n    self"
 & ".posBeforeToken := -1;\n    self.rd := rd;\n    RETURN self;\n  END Set"
 & "Rd; \n\nPROCEDURE NextCode(self: T): OutCode RAISES {Rd.EndOfFile} =\n "
 & " VAR\n    rd := self.rd;\n    lastAcceptingOutput: INTEGER := 0;\n    l"
 & "astAcceptingPos: INTEGER := Rd.Index(rd);\n    firstChar := Rd.GetChar("
 & "rd);\n    curState := First[firstChar];\n    curTrans: INTEGER;\n    c:"
 & " Byte;\n  BEGIN\n    self.charCache := firstChar;\n    self.posBeforeTo"
 & "ken := lastAcceptingPos;\n    TRY\n      WHILE curState # 0 DO\n       "
 & " WITH state = States[curState] DO\n          IF state.output # 0 THEN\n"
 & "            lastAcceptingOutput := state.output;\n            lastAccep"
 & "tingPos := Rd.Index(rd);\n          END;\n          IF state.keyBegin ="
 & " 1 AND state.keyEnd = 255 THEN\n            curState := state.target;\n"
 & "          ELSE\n            c := ORD(R";

CONST E2_0 =
   "d.GetChar(rd));\n            IF c >= state.keyBegin AND c <= state.keyE"
 & "nd THEN\n              curState := state.target;\n            ELSE\n   "
 & "           curTrans := state.next;\n              WHILE curTrans # 0 DO"
 & "\n                WITH trans = Trans[curTrans] DO\n                  IF"
 & " c >= trans.keyBegin AND c <= trans.keyEnd THEN\n                    cu"
 & "rState := trans.target;\n                    curTrans := 0;\n          "
 & "        ELSE\n                    curTrans := trans.next;\n            "
 & "      END;\n                END;\n              END;\n            END;\n"
 & "          END;\n        END;\n      END;\n    EXCEPT\n    | Rd.EndOfFil"
 & "e =>\n      IF lastAcceptingOutput = 0 THEN\n        Rd.Seek(rd, lastAc"
 & "ceptingPos);\n        RAISE Rd.EndOfFile;\n      END;\n    END;\n    Rd"
 & ".Seek(rd, lastAcceptingPos);\n    RETURN lastAcceptingOutput;\n  END Ne"
 & "xtCode;\n\nPROCEDURE Get(self: T): Token RAISES {Rd.EndOfFile} =\n  VAR"
 & "\n    result: Token;\n  BEGIN\n    SeekRd.DiscardPrevious(self.rd);\n  "
 & "  REPEAT\n      self.textCache := NIL;\n      CASE NextCode(self) OF\n "
 & "     | 0 => <* ASSERT FALSE *> (* unmatched *)\n%case\\\n      END;\n  "
 & "  UNTIL result # NIL;\n    RETURN result;\n  END Get; \n\nPROCEDURE Ung"
 & "et(self: T) =\n  BEGIN     \n    <* ASSERT self.posBeforeToken # -1 *>\n"
 & "    Rd.Seek(self.rd, self.posBeforeToken);\n    self.posBeforeToken := "
 & "-1;\n  END Unget;\n\nPROCEDURE GetText(self: T): TEXT =\n  VAR\n    len"
 & ": INTEGER;\n  BEGIN\n    IF self.textCache = NIL THEN\n      <* ASSERT "
 & "self.posBeforeToken # -1 *>\n      len := Rd.Index(self.rd) - self.posB"
 & "eforeToken;\n      Rd.Seek(self.rd, self.posBeforeToken);\n      self.t"
 & "extCache := Rd.GetText(self.rd, len);\n    END;\n    RETURN self.textCa"
 & "che;\n  END GetText;\n\nPROCEDURE Purge(self: T): INTEGER =\n  BEGIN\n "
 & "   RETURN 0%purge;\n  END Purge;\n\nPROCEDURE GetRd(self: T): Rd.T =\n "
 & " BEGIN RETURN self.rd; END GetRd;\n\nPROCEDURE Rewind(self: T) =\n  BEG"
 & "IN Rd.Seek(self.rd, 0); EVAL self.setRd(self.rd); END Rewind;\n\nPROCED"
 & "URE FromText(self: T; t: TEXT): %tok.RdLexer =\n  BEGIN RETURN self.set"
 & "Rd(TextRd.New(t))";

CONST E2_1 =
   "; END FromText;\n\nPROCEDURE Error(self: T; message: TEXT) =\n  BEGIN S"
 & "eekRd.E(self.rd, message); END Error;\n\n(* default token methods *)\n%"
 & "default\\\nPROCEDURE char(self: T): Token =\n  BEGIN RETURN %tok.NewCon"
 & "stToken(ORD(self.charCache)); END char;\n\nBEGIN\nEND %lex.\n";

BEGIN
END lexformBundle.