DIRECTORY Atom, BasicTime, EDIFDataStructure, EDIFfing, EDIFGrammar, EDIFSemantics, HashTable, IO, Rope; 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}; }. NEDIFSemanticsProgging.Mesa Spreitzer, February 25, 1986 0:03:35 am PST ‌ت @– "cedar" styleکcode™K™+—KکKڑدk œV‌œکhKکڑذbxœ‌œ‌ک$Kڑ‌œ.‌ک7Kڑœ‌œ9ک@Kکڑدnœ‌œکKڑœ‌œ ‌œ,کDڑ‌œ‌œ ‌œ8کKKک!—Kڑœ‌œ‌œ#ک