Copyright (c) 2000 California Institute of Technology
All rights reserved. See the file COPYRIGHT for a full description.
$Id: Rule.m3.html,v 1.3 2010-04-29 17:18:53 wagner Exp $
MODULE Rule;
IMPORT Prec;
IMPORT CharRange;
IMPORT CharCodes;
IMPORT Sym;
IMPORT SymList;
IMPORT SymListParse;
IMPORT TextSubs;
IMPORT TextPrecTbl;
IMPORT TextBooleanTbl;
IMPORT TextIntTbl;
IMPORT Rd, Thread;
IMPORT Wr, TextWr;
IMPORT Fmt;
IMPORT Term, Fmt;
<*FATAL Rd.Failure, Wr.Failure, Thread.Alerted*>
REVEAL
T = Public BRANDED OBJECT
subs: TextSubs.T := NIL;
END;
PROCEDURE DbgFormat(a: T): TEXT =
VAR
acc := a.name & " :";
cur := a.syms;
BEGIN
WHILE cur # NIL DO
acc := acc & " " & Sym.Format(cur.head);
cur := cur.tail;
END;
RETURN acc;
END DbgFormat;
PROCEDURE CountParams(a: T): INTEGER =
VAR
cur := a.syms;
i: INTEGER := 0;
BEGIN
WHILE cur # NIL DO
IF NOT Sym.IsConst(cur.head) THEN INC(i); END;
cur := cur.tail;
END;
RETURN i;
END CountParams;
PROCEDURE FormatParams(a: T; form: TEXT): TEXT =
VAR
cur := a.syms;
wr := TextWr.New();
i: INTEGER := 0;
stackRef := SymList.Length(cur);
name: TEXT;
subs: TextSubs.T;
BEGIN
WHILE cur # NIL DO
DEC(stackRef);
IF NOT Sym.IsConst(cur.head) THEN
INC(i);
name := Sym.GetName(cur.head);
subs := NEW(TextSubs.T).init();
subs.add("%number", Fmt.Int(i));
subs.add("%type", name);
name := "";
IF stackRef # 0 THEN
name := Fmt.Int(-stackRef);
END;
subs.add("%offset", name);
Wr.PutText(wr, subs.apply(form));
END;
cur := cur.tail;
END;
RETURN TextWr.ToText(wr);
END FormatParams;
PROCEDURE Format(a: T; form: TEXT; last: BOOLEAN := TRUE): TEXT =
VAR
optionalComma := ",";
optionalCR := "\n ";
PROCEDURE Pform(key, form: TEXT) =
BEGIN
a.subs.add(key, FormatParams(a, form));
END Pform;
BEGIN
IF a.subs = NIL THEN
IF last THEN optionalComma := "";END;
IF a.syms=NIL THEN optionalCR := "";END;
a.subs := NEW(TextSubs.T).init();
a.subs.add("%debug", CharCodes.Q(DbgFormat(a)));
a.subs.add("%name", a.name);
a.subs.add("%return", Sym.GetName(a.return));
a.subs.add("%length", Fmt.Int(a.length));
a.subs.add("%number", Fmt.Int(a.number));
a.subs.add("%codeReturn", Fmt.Int(Sym.GetCode(a.return)));
Pform("%oparams", "; p%number: Original_%type");
Pform("%sparams", "; p%number: %type");
Pform("%uparams", ";<*UNUSED*>p%number: %type");
Pform("%cparams", ", p%number");
Pform("%fromStack", "p%number:%type:=a[p%offset].value.value;");
Pform("%narrow", " n%number := NARROW(p%number, %type);\n");
a.subs.add("\\,", optionalComma);
a.subs.add("\\\n", optionalCR);
a.subs.add("\\\\\n", "");
END;
RETURN a.subs.apply(form);
END Format;
PROCEDURE FromRd(rd: Rd.T; return: Sym.T;
allowedChars: CharRange.T;
number: INTEGER): T =
VAR
self := NEW(T, return := return, prec := NIL, number := number);
<* FATAL Rd.EndOfFile *>
BEGIN
WHILE Rd.GetChar(rd) IN CharRange.WhiteSpace DO END;
self.name := SymListParse.BackGetName(rd) & "_" &
Sym.GetName(self.return);
self.syms := SymListParse.Parse(rd, allowedChars);
self.length := SymList.Length(self.syms);
RETURN self;
END FromRd;
PROCEDURE LookupSyms(self: T;
prec: TextPrecTbl.T;
start: TextBooleanTbl.T;
codes: TextIntTbl.T;
const: TextIntTbl.T;
VAR lastCode: INTEGER) =
PROCEDURE Lookup(sym: Sym.T) =
BEGIN
Sym.AllocCode(sym, codes, lastCode);
Sym.SetAttrs(sym, start, const);
END Lookup;
VAR
cur := self.syms;
highestPrec := NEW(Prec.T, kind := Prec.Kind.None);
thisPrec: Prec.T;
BEGIN
Lookup(self.return);
WHILE cur # NIL DO
Lookup(cur.head);
thisPrec := Sym.GetPrec(cur.head, prec);
IF thisPrec # NIL THEN
IF highestPrec.val < thisPrec.val THEN
highestPrec := thisPrec;
END;
END;
cur := cur.tail;
END;
IF prec.get(self.name, highestPrec) THEN
Term.WrLn(Found prec:
& self.name & Fmt.Int(highestPrec.val));
ELSE
Term.WrLn(Not finding prec:
& self.name);
END;
self.prec := highestPrec;
self.prec.used := TRUE;
Term.WrLn(Marking used:
& Fmt.Int(self.prec.val));
END LookupSyms;
PROCEDURE Equal(<*UNUSED*>a, b: T): BOOLEAN =
BEGIN <*ASSERT FALSE*> END Equal;
PROCEDURE Compare(a, b: T; assoc: BOOLEAN := FALSE): [-1 .. 1] =
BEGIN
IF b = NIL THEN
RETURN 1;
ELSIF a = NIL THEN
RETURN -1;
ELSE
VAR
aprec := a.prec.val;
bprec := b.prec.val;
BEGIN
IF aprec = 0 OR bprec = 0 THEN
RETURN 0;
ELSIF aprec > bprec THEN
RETURN 1;
ELSIF bprec > aprec THEN
RETURN -1;
ELSIF a.prec.kind = Prec.Kind.None OR NOT assoc THEN
RETURN 0;
ELSIF a.prec.kind = Prec.Kind.Left THEN
RETURN 1;
ELSE
RETURN -1;
END;
END;
END;
END Compare;
PROCEDURE Number(a: T): INTEGER =
BEGIN
IF a = NIL THEN
RETURN 0;
ELSE
RETURN a.number;
END;
END Number;
BEGIN
END Rule.