kext/derived/ExtFormBundle.m3


MODULE ExtFormBundle;
Generated by m3bundle; see its manpage.

IMPORT Bundle, BundleRep, Text;

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
        RETURN Elements[i];
      END;
    END;
    RETURN NIL;
  END LookUp;

CONST Names = ARRAY [0..4] OF TEXT {
  "extform.tokimport.i3",
  "extform.t.m3",
  "extform.y.m3",
  "extform.l.m3",
  NIL
};

CONST Elements = ARRAY [0..4] OF TEXT {
  E0,
  E1,
  E2,
  E3,
  NIL
};

CONST E0 =
   "\n  (* Make this interface as good as any token interface *)\n  Token ="
 & " %tok.Token;\n  ConstToken = %tok.ConstToken;\n  ParseType = %tok.Parse"
 & "Type;\n  Allocator = %tok.Allocator;\n  Lexer = %tok.Lexer;\n  RdLexer "
 & "= %tok.RdLexer;\nCONST\n  NewPT = %tok.NewPT;\n  Purge = %tok.Purge;\n "
 & " NewConstToken = %tok.NewConstToken;\n";

CONST E1 =
   "%interface %module\n~\\\nINTERFACE %name;\n%gen\n(* extended token defi"
 & "nition *)\n%import\\\n%interface\\\nTYPE\n%gnTypes\\\n%tkimp\\\nEND %na"
 & "me.\n~\\\n(* procedure format *)\n~\\\nMODULE %name;\n%gen\n%module\\\n"
 & "BEGIN\nEND %name.\n";

CONST E2 =
   "%interface %module %public %private %overrides\n~\\\nINTERFACE %name;\n"
 & "%gen\n(* extended parser definition *)\n%import\\\n%interface\\\nTYPE\n"
 & "%gnTypes\\\n\n  T <: Public;\n  Public = %meth.T OBJECT\n%public\\\n  E"
 & "ND;\n\n  (* And now, for a hack to allow compatible methods *)\n  (* .."
 & ". without importing the original parser *)\n  Original_Parser = %meth.O"
 & "riginal_Parser;\n%orig\\\n  (* ... and without importing the original t"
 & "oken *)\n%tokOrig\\\n%tkimp\\\nEND %name.\n~\\\\\nPROCEDURE Proc_%name("
 & "self: T;\n VAR p0: Original_%return%oparams) =\n  VAR\n    result: %ret"
 & "urn;\n%narrow\\\\\n  BEGIN\n    IF p0 = NIL THEN\n      p0 := NewPT(sel"
 & "f.allocate_%return, TYPECODE(%return));\n    END;\n    result := NARROW"
 & "(p0, %return);(*%TYPEINIT%%return%*)\n    %yaccName.T.%name(self, p0%cp"
 & "arams);\n    result := NARROW(p0, %return);\n    BEGIN (* user code *)\n"
 & "      %body\n    END;\n    p0 := result;\n  END Proc_%name;\n\n~\\\nMOD"
 & "ULE %name;\n%gen\nIMPORT %meth;\n%module\\\n\nREVEAL\n  T = Public BRAN"
 & "DED \"%name\" OBJECT\n%alloc\\\n%private\\\n  OVERRIDES\n    purge := P"
 & "roc_Purge;\n%overrides\\\n%ovr\\\n  END;\n\nPROCEDURE Proc_Purge(self: "
 & "T): INTEGER =\n  BEGIN\n    RETURN %meth.T.purge(self)%purge;\n  END Pr"
 & "oc_Purge;\n\n(* rule procedures *)\n%gnProcs\\\nBEGIN\nEND %name.\n";

CONST E3 =
   "%interface %module %public %private %overrides\n~\\\nINTERFACE %name;\n"
 & "%gen\n(* extended lexer definition *)\n%import\\\n%interface\\\nTYPE\n%"
 & "gnTypes\\\n\n  T <: Public;\n  Public = %meth.T OBJECT\n%public\\\n  EN"
 & "D;\n%tkimp\\\nEND %name.\n~\\\nPROCEDURE Proc_%name(self: T): Token =\n"
 & "  BEGIN (* user code *)\n   %body\n  END Proc_%name;\n\n~\\\nMODULE %na"
 & "me;\n%gen\nIMPORT %meth;\n%module\\\n\nREVEAL\n  T = Public BRANDED \"%"
 & "name\" OBJECT\n%alloc\\\n%private\\\n  OVERRIDES\n    purge := Proc_Pur"
 & "ge;\n%overrides\\\n%ovr\\\n  END;\n\nPROCEDURE Proc_Purge(self: T): INT"
 & "EGER =\n  BEGIN\n    RETURN %meth.T.purge(self)%purge;\n  END Proc_Purg"
 & "e;\n\n(* expression procedures *)\n%gnProcs\\\nBEGIN\nEND %name.\n";

BEGIN
END ExtFormBundle.