EDIFSemanticsProgging:
CEDAR
PROGRAM
IMPORTS Atom, EDIFGrammar, EDIFSemantics, HashTable, IO
= {OPEN EDIFfing, EDIFDataStructure, EDIFGrammar, EDIFSemantics;
DefineEm:
PROC = {
[] ← DC[$Level1Ctl, LIST[$Repeat, $Constraint, $Assign, $Print], 1];
SS[
DL[$Repeat,
LIST[NameDef[], $Integer, $Integer, $Integer, Star[$Form]]],
[HandleSpecially: HandleRepeat]];
[] ← DL[$Constraint, LIST[Star[$Boolean], Star[$Property]]];
[] ← DL[$Assign, LIST[NameRef[], Star[$Expression]]];
SS[
DL[$Print,
LIST[Star[$Expression]]],
[HandleSpecially: HandlePrint]];
[] ← DC[$Level2Ctl, LIST[$Block, $Escape, $Iterate, $Redo], 2];
SS[
DL[$Iterate,
LIST[Star[$Form]]],
[HandleSpecially: HandleIterate]];
SS[
DL[$Block,
LIST[Star[$Form]]],
[HandleSpecially: HandleBlock]];
SS[
DL[$Redo,
LIST[$Boolean, Star[$Form]]],
[HandleSpecially: HandleRedo]];
SS[
DL[$Escape,
LIST[$Boolean, Star[$Form]]],
[HandleSpecially: HandleEscape]];
SS[
DC[$Expression,
LIST[$Primitive, NameRef[], $FunctionApplication]],
[FilterResult: FilterExpressionResult]];
SS[
DLU[$FunctionApplication,
LIST[Star[$Expression]]],
[HandleSpecially: HandleFunctionApplication]];
[] ← DC[$FunctionName, LIST["+", "-", "*", "/", "abs", "floor", "fix", "ceiling", "xcoord", "ycoord", "point", "concat", "and", "or", "xor", "not", "false", "true", "andnot", "<", "=", ">"]];
[] ← DC[$Primitive, LIST[$String, $Integer, $ScaledInteger]];
[] ← DL2[$ScaledInteger, LIST[$e, $Integer, $Integer]];
[] ← DC[$Number, LIST[$Integer, $ScaledInteger], 0, 0];
[] ← DC[$Number, LIST[$Expression], 1];
[] ← DC[$Boolean, LIST[$True, $False], 0, 0];
[] ← DC[$Boolean, LIST[$Expression], 1];
SS[
DL[$True,
LIST[]],
[NIL, AfterTrue]];
SS[
DL[$False,
LIST[]],
[NIL, AfterFalse]];
DF["true", EvalTrue];
DF["false", EvalFalse];
};
idRule: Rule ← MakeRule[$Identifier];
intRule: Rule ← MakeRule[$Integer];
exprRule: Rule ← MakeRule[$Expression];
boolRule: Rule ← MakeRule[$Boolean];
HandleRepeat: SpecialHandler = {
ra: REF ANY;
id: ATOM;
start, stop, step: REF INT;
val: INT;
subNC: NamingContext = CreateHashTableNamingContext[nc];
ptail ← ptl;
[match, ptail, ra] ← TreeWork[ptail, parentTree, idRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN RETURN;
id ← NARROW[ra];
[match, ptail, ra] ← TreeWork[ptail, parentTree, intRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN RETURN;
start ← NARROW[ra];
[match, ptail, ra] ← TreeWork[ptail, parentTree, intRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN RETURN;
stop ← NARROW[ra];
[match, ptail, ra] ← TreeWork[ptail, parentTree, intRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN RETURN;
step ← NARROW[ra];
IF step^ = 0 THEN ERROR;
FOR val ← start^, val+step^
WHILE (stop^ - val) * step^ >= 0
DO
refVal: REF INT = NEW [INT ← val];
forms: ParseTreeList ← ptail;
subNC.Define[id, refVal, TRUE];
WHILE forms #
NIL
DO
[match, forms,] ← TreeWork[forms, parentTree, repeatSub, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, subNC];
IF NOT match THEN RETURN;
ENDLOOP;
ENDLOOP;
ptail ← NIL;
};
HandlePrint: SpecialHandler = {
ptail ← ptl;
WHILE ptail #
NIL
DO
result: REF ANY;
[match, ptail, result] ← TreeWork[ptail, parentTree, exprRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN EXIT;
IF result #
NIL
THEN
WITH result
SELECT
FROM
x: ROPE => log.PutRope[x];
x: REF INT => log.Put[[integer[x^]]];
x: REF BOOL => log.Put[[boolean[x^]]];
x: REF REAL => log.Put[[real[x^]]];
ENDCASE => log.Put[[refAny[result]]];
ENDLOOP;
log.PutRope["\n"];
};
log: IO.STREAM ← IO.noWhereStream;
Escape: SIGNAL = CODE;
Redo: SIGNAL = CODE;
HandleBlock: SpecialHandler = {
subNC: NamingContext = CreateHashTableNamingContext[nc];
trapped: BOOL ← FALSE;
match ← TRUE;
ptail ← ptl;
lastWasStar ← FALSE;
WHILE match
AND ptail #
NIL
DO
escape, redo: BOOL ← FALSE;
[match, ptail, ] ← TreeWork[ptail, parentTree, repeatSub, repeatSub, level, onces,
FALSE, description, sem, context, SetLevel, macros, ConsumeResult, subNC !
Escape => IF NOT trapped THEN {trapped ← escape ← TRUE; RESUME};
Redo => IF NOT trapped THEN {trapped ← redo ← TRUE; RESUME}];
IF escape THEN EXIT;
IF redo THEN ptail ← ptl;
ENDLOOP;
ptail ← NIL
};
HandleIterate: SpecialHandler = {
subNC: NamingContext = CreateHashTableNamingContext[nc];
trapped: BOOL ← FALSE;
match ← TRUE;
ptail ← ptl;
lastWasStar ← FALSE;
WHILE match
AND ptail #
NIL
DO
escape, redo: BOOL ← FALSE;
[match, ptail, ] ← TreeWork[ptail, parentTree, repeatSub, repeatSub, level, onces,
FALSE, description, sem, context, SetLevel, macros, ConsumeResult, subNC !
Escape => IF NOT trapped THEN {trapped ← escape ← TRUE; RESUME};
Redo => IF NOT trapped THEN {trapped ← redo ← TRUE; RESUME}];
IF escape THEN EXIT;
IF redo OR ptail = NIL THEN ptail ← ptl;
ENDLOOP;
ptail ← NIL
};
HandleRedo: SpecialHandler = {
rb: REF ANY;
redo: BOOL;
[match, ptail, rb] ← TreeWork[ptl, parentTree, boolRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
WITH rb
SELECT
FROM
x: REF BOOL => redo ← x^;
ENDCASE => ERROR;
IF redo
THEN {
abort: BOOL ← FALSE;
SIGNAL Redo[];
WHILE ptail #
NIL
DO
[match, ptail, ] ← TreeWork[ptail, parentTree, repeatSub, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, ConsumeResult, nc !Redo, Escape => abort ← TRUE];
IF abort OR NOT match THEN EXIT;
ENDLOOP;
};
ptail ← NIL
};
HandleEscape: SpecialHandler = {
rb: REF ANY;
escape: BOOL;
[match, ptail, rb] ← TreeWork[ptl, parentTree, boolRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
WITH rb
SELECT
FROM
x: REF BOOL => escape ← x^;
ENDCASE => ERROR;
IF escape
THEN {
abort: BOOL ← FALSE;
SIGNAL Escape[];
WHILE ptail #
NIL
DO
[match, ptail, ] ← TreeWork[ptail, parentTree, repeatSub, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, ConsumeResult, nc !Redo, Escape => abort ← TRUE];
IF abort OR NOT match THEN EXIT;
ENDLOOP;
};
ptail ← NIL
};
FilterExpressionResult: ResultFilter = {
SELECT GetCategory[subRule]
FROM
$Identifier => result ← nc.Lookup[NARROW[subResult]].value;
ENDCASE => result ← subResult;
};
true: REF BOOL = NEW [BOOL ← TRUE];
false: REF BOOL = NEW [BOOL ← FALSE];
AfterTrue: Afterer = {result ← true};
AfterFalse: Afterer = {result ← false};
Function: TYPE = REF FunctionPrivate;
FunctionPrivate:
TYPE =
RECORD [
Eval: Evaluator,
data: REF ANY];
fns: HashTable.Table = MakeAtomDict[];
Evaluator: TYPE = PROC [data: REF ANY, args: LORA] RETURNS [result: REF ANY];
DF:
PROC [name:
ROPE, Eval: Evaluator, data:
REF
ANY ←
NIL] = {
atom: ATOM = Atom.MakeAtom[name];
fn: Function = NEW [FunctionPrivate ← [Eval, data]];
IF NOT fns.Insert[atom, fn] THEN ERROR;
};
LookupFn:
PROC [name:
ATOM]
RETURNS [fn: Function] = {
fn ← NARROW[fns.Fetch[name].value];
};
HandleFunctionApplication: SpecialHandler = {
args, argsTail: LORA ← NIL;
fnName: ATOM = keyword;
fn: Function ← LookupFn[fnName];
ptail ← ptl;
WHILE ptail #
NIL
DO
result: REF ANY;
tail: LORA;
[match, ptail, result] ← TreeWork[ptail, parentTree, exprRule, repeatSub, level, onces, FALSE, description, sem, context, SetLevel, macros, DiscardResult, nc];
IF NOT match THEN EXIT;
tail ← LIST[result];
IF argsTail = NIL THEN args ← tail ELSE argsTail.rest ← tail;
argsTail ← tail;
ENDLOOP;
result ← fn.Eval[fn.data, args];
};
EvalTrue: Evaluator = {result ← true};
EvalFalse: Evaluator = {result ← false};
}.