Accessing Cedar from Misp:
EvalCedarExpr:
PROC [args:
LORA, environment: Misp.Environment, data:
REF
ANY ←
NIL, stack: Misp.Stack]
RETURNS [cooked:
REF
ANY]
--Misp.EvalProc-- = {
cedarExpression: ROPE ← NARROW[args.first];
symTab: SymTab.Ref ← Symtabize[environment];
result: TV;
errorRope: ROPE;
noResult: BOOL;
[result, errorRope, noResult] ← Interpreter.Evaluate[
rope: cedarExpression,
symTab: symTab,
abort: Misp.EnvStop[environment]
];
IF errorRope.Length[] # 0 THEN ERROR Misp.Error[environment, stack, errorRope];
cooked ← IF NOT noResult THEN CedarToMisp[result] ELSE NIL;
};
EvalCedarStmt:
PROC [args:
LORA, environment: Misp.Environment, data:
REF
ANY ←
NIL, stack: Misp.Stack]
RETURNS [cooked:
REF
ANY]
--Misp.EvalProc-- = {
cedarStatement: ROPE ← NARROW[args.first];
symTab: SymTab.Ref ← Symtabize[environment];
errorRope: ROPE;
cooked ← NIL;
errorRope ← StatementInterpreter.InterpretStatement[
blockAsRope: cedarStatement,
symTab: symTab,
abort: Misp.EnvStop[environment]
!Yield => {
cooked ← CedarToMisp[value];
CONTINUE
}
];
IF errorRope.Length[] # 0 THEN ERROR Misp.Error[environment, stack, errorRope];
};
Yield: ERROR [value: TV] = CODE;
EvalYield:
PROC [head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: AMTypes.Type ← AMTypes.nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
--EvalQuote.EvalQuoteProc-- = {
argTree: InterpreterOps.Tree ← InterpreterOps.GetArg[tree, 1];
argTV: TV ← InterpreterOps.Eval[tree: argTree, head: head, target: target];
BackStop.SuspendBackStop[];
ERROR Yield[argTV];
};
Symtabize:
PROC [env: Misp.Environment]
RETURNS [symTab: SymTab.Ref] = {
size: NAT ← 0;
FOR e: Misp.Environment ← env, e.parent
WHILE e #
NIL
DO
size ← size + e.class.Size[e];
ENDLOOP;
size ← size*2 + 1;
symTab ← SymTab.Create[size];
FOR e: Misp.Environment ← env, e.parent
WHILE e #
NIL
DO
Per:
PROC [key:
ATOM, binding:
REF
ANY] = {
name: ROPE ← Atom.GetPName[key];
[] ← symTab.Insert[name, MispToCedar[binding]];
};
e.class.Enumerate[e, Per];
ENDLOOP;
};
DefineCedar:
PROC [environment: Misp.Environment] = {
environment.Defun[$cedarExpr, EvalCedarExpr];
environment.Defun[$cedarStmt, EvalCedarStmt];
};
Accessing Misp from Cedar:
EvalMisp:
PROC [head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: AMTypes.Type ← AMTypes.nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
--EvalQuote.EvalQuoteProc-- = {
argTree: InterpreterOps.Tree ← InterpreterOps.GetArg[tree, 1];
argTV: TV ← InterpreterOps.Eval[tree: argTree, head: head];
argRef, raw, cooked: REF ANY;
env: Misp.Environment ← Environmentize[head];
TRUSTED {argRef ← CedarToMisp[argTV]};
WITH argRef
SELECT
FROM
rope: ROPE => raw ← GetStreamRefAny[IO.RIS[rope]];
text: REF TEXT => raw ← GetStreamRefAny[IO.TIS[text]];
ENDCASE => raw ← argRef;
BackStop.SuspendBackStop[];
cooked ← Misp.Eval[raw: raw, environment: env, stack:
NIL !
Misp.Error => {
BackStop.ResumeBackStop[];
BBUrpEval.UrpFatal[head, tree, IO.PutFR["Misp: %g, stack = %g", IO.rope[msg], IO.rope[Misp.PrintValRope[stack]]]];
ERROR;
};
UNWIND => BackStop.ResumeBackStop[]
];
BackStop.ResumeBackStop[];
return ← MispToCedar[cooked];
};
GetStreamRefAny:
PROC [s:
IO.
STREAM]
RETURNS [ra:
REF
ANY] = {
ra ← s.GetRefAny[];
[] ← s.SkipWhitespace[];
IF NOT s.EndOf[] THEN ERROR;
s.Close[];
};
Environmentize:
PROC [head: InterpreterOps.EvalHead]
RETURNS [env: Misp.Environment] = {
cc: AMModel.Class;
DoRecord:
PROC [tv:
TV, name:
ROPE] =
{IF tv # NIL THEN env ← Misp.NewEnvironment[name: name, parent: env, class: recordClass, initData: tv]};
in, out: IO.STREAM ← NIL;
WITH List.Assoc[$CommanderHandle, ProcessProps.GetPropList[]]
SELECT
FROM
cmd: Commander.Handle => {in ← cmd.in; out ← cmd.out};
ENDCASE;
env ← Misp.NewEnvironment[name: "Standard Misp stuff for a Cedar evaluation", in: in, out: out, sizeGuess: 200, stop: head.abortClosure];
Misp.DefinePrimitives[env];
TRUSTED {cc ← AMModel.ContextClass[head.context]};
SELECT cc
FROM
world => NULL --don't define the Cedar world for Misp ... it can't use it--;
model => ERROR --don't know how to break down a CONFIG--;
statement => ERROR --don't know how to break down a statement--;
interface =>
TRUSTED {
DoRecord[
AMModelBridge.IRFromContext[head.context],
AMModel.ContextName[head.context]];
};
prog =>
TRUSTED {
DoRecord[
AMTypes.Globals[AMModelBridge.FrameFromContext[head.context]],
AMModel.ContextName[head.context]];
};
proc =>
TRUSTED {
context: TV ← AMModelBridge.FrameFromContext[head.context];
Work:
UNSAFE
PROC [tv:
TV] = {
IF tv #
NIL
THEN {
Work[AMTypes.EnclosingBody[tv]];
DoRecord[
AMTypes.Locals[tv],
AMTypes.TVToName[AMTypes.Procedure[tv]]
];
}
ELSE DoRecord[
AMTypes.Globals[AMTypes.GlobalParent[context]],
AMModel.ContextName[AMModel.ParentContext[context]]
];
};
Work[context];
};
ENDCASE => ERROR;
env ← Misp.NewEnvironment[name: "Cedar specials", parent: env, class: symtabClass, initData: head.specials];
};
recordClass: Misp.EnvironmentClass ←
NEW [Misp.EnvironmentClassRep ← [
Init: InitRecord,
GetBinding: GetRecordBinding,
SetBinding: SetRecordBinding,
Enumerate: EnumerateRecord,
Size: RecordSize]];
InitRecord:
PROC [env: Misp.Environment, sizeGuess:
NAT, initData:
REF
ANY] = {
env.rep ← initData;
};
GetRecordBinding:
PROC [env: Misp.Environment, key:
ATOM]
RETURNS [found:
BOOL, binding:
REF
ANY] = {
name: ROPE ← Atom.GetPName[key];
record: TV ← NARROW[env.rep];
type: AMTypes.Type ← AMTypes.TVType[record];
index: CARDINAL;
valTV: TV;
found ← TRUE;
index ← AMTypes.NameToIndex[type, name !AMTypes.Error => {IF reason = badName THEN {found ← FALSE; CONTINUE}};];
IF NOT found THEN RETURN;
valTV ← AMTypes.IndexToTV[record, index];
binding ← CedarToMisp[valTV];
};
SetRecordBinding:
PROC [env: Misp.Environment, key:
ATOM, binding:
REF
ANY, overwriteOld:
BOOL] = {
name: ROPE ← Atom.GetPName[key];
record: TV ← NARROW[env.rep];
type: AMTypes.Type ← AMTypes.TVType[record];
index: CARDINAL;
varTV, valTV: TV;
found: BOOL ← TRUE;
index ← AMTypes.NameToIndex[type, name !AMTypes.Error => {IF reason = badName THEN {found ← FALSE; CONTINUE}};];
IF NOT found THEN ERROR Misp.Error[env, NIL, "Can't add fields to a Cedar frame"];
varTV ← AMTypes.IndexToTV[record, index];
SELECT AMTypes.TVStatus[varTV]
FROM
mutable => NULL;
readOnly, const => ERROR Misp.Error[env, NIL, Rope.Cat["Can't update ", name]];
ENDCASE => ERROR;
valTV ← MispToCedar[binding];
AMTypes.Assign[varTV, valTV];
};
EnumerateRecord:
PROC [env: Misp.Environment, consume:
PROC [key:
ATOM, binding:
REF
ANY]] = {
record: TV ← NARROW[env.rep];
type: AMTypes.Type ← AMTypes.TVType[record];
n: NAT ← AMTypes.NComponents[type];
FOR i:
NAT
IN [1 .. n]
DO
name: ROPE ← AMTypes.IndexToName[type, i];
key: ATOM ← Atom.MakeAtom[name];
valTV: TV ← AMTypes.IndexToTV[record, i];
valRef: REF ANY ← CedarToMisp[valTV];
consume[key, valRef];
ENDLOOP;
n ← n;
};
RecordSize:
PROC [env: Misp.Environment]
RETURNS [
NAT] = {
record: TV ← NARROW[env.rep];
type: AMTypes.Type ← AMTypes.TVType[record];
n: NAT ← AMTypes.NComponents[type];
RETURN [n];
};
symtabClass: Misp.EnvironmentClass ←
NEW [Misp.EnvironmentClassRep ← [
Init: InitSymtab,
GetBinding: GetSymtabBinding,
SetBinding: SetSymtabBinding,
Enumerate: EnumerateSymtab,
Size: SymtabSize]];
InitSymtab:
PROC [env: Misp.Environment, sizeGuess:
NAT, initData:
REF
ANY] = {
env.rep ← initData;
};
GetSymtabBinding:
PROC [env: Misp.Environment, key:
ATOM]
RETURNS [found:
BOOL, binding:
REF
ANY] = {
name: ROPE ← Atom.GetPName[key];
symtab: SymTab.Ref ← NARROW[env.rep];
tv: TV;
[found, tv] ← symtab.Fetch[name];
IF NOT (found AND ISTYPE[tv, ReallyTV]) THEN RETURN [FALSE, NIL];
binding ← CedarToMisp[tv];
};
SetSymtabBinding:
PROC [env: Misp.Environment, key:
ATOM, binding:
REF
ANY, overwriteOld:
BOOL] = {
name: ROPE ← Atom.GetPName[key];
symtab: SymTab.Ref ← NARROW[env.rep];
tv: TV;
tv ← MispToCedar[binding];
[] ← (IF overwriteOld THEN SymTab.Store ELSE SymTab.Insert)[symtab, name, tv];
};
EnumerateSymtab:
PROC [env: Misp.Environment, consume:
PROC [key:
ATOM, binding:
REF
ANY]] = {
symtab: SymTab.Ref ← NARROW[env.rep];
PerPair:
PROC [key:
ROPE, val:
REF
ANY]
RETURNS [quit:
BOOL]
--SymTab.EachPairAction-- = {
atom: ATOM ← Atom.MakeAtom[key];
WITH val
SELECT
FROM
tv: ReallyTV => {
binding: REF ANY ← CedarToMisp[tv];
consume[atom, binding];
};
ENDCASE;
quit ← FALSE;
};
[] ← symtab.Pairs[PerPair];
symtab ← symtab};
SymtabSize:
PROC [env: Misp.Environment]
RETURNS [
NAT] = {
symtab: SymTab.Ref ← NARROW[env.rep];
RETURN [symtab.GetSize[]];
};
A different way to Environmentize:
Environmentize: PROC [head: InterpreterOps.EvalHead] RETURNS [env: Misp.Environment] = {
top: Misp.Environment ← Misp.NewEnvironment[name: "Standard Misp stuff for a Cedar evaluation", sizeGuess: 200, stop: head.abortClosure];
fromCedar: Misp.Environment ← Misp.NewEnvironment[name: "stuff from Cedar", parent: top, class: fromCedarClass, initData: head];
Misp.DefinePrimitives[top];
};
fromCedarClass: Misp.EnvironmentClass ← NEW [Misp.EnvironmentClassRep ← [
Init: InitFromCedar,
GetBinding: GetCedarBinding,
SetBinding: SetCedarBinding,
Enumerate: EnumerateCedar,
Size: CedarSize]];
InitFromCedar: PROC [env: Misp.Environment, sizeGuess: NAT, initData: REF ANY] = {
env.rep ← initData;
};
GetCedarBinding: PROC [env: Misp.Environment, key: ATOM] RETURNS [found: BOOL, binding: REF ANY] = {
name: ROPE ← Atom.GetPName[key];
head: InterpreterOps.EvalHead ← NARROW[env.rep];
valTV: TV;
errorRope: ROPE;
noResult: BOOL;
[valTV, errorRope, noResult] ← Interpreter.Evaluate[
rope: name,
context: head.context,
symTab: head.specials,
abort: head.abortClosure];
IF found ← NOT (errorRope.Length[] # 0 OR noResult) THEN binding ← CedarToMisp[valTV];
};
SetCedarBinding: PROC [env: Misp.Environment, key: ATOM, binding: REF ANY, overwriteOld: BOOL] = {
name: ROPE ← Atom.GetPName[key];
head: InterpreterOps.EvalHead ← NARROW[env.rep];
varTV, valTV: TV;
errorRope: ROPE;
noResult: BOOL;
[varTV, errorRope, noResult] ← Interpreter.Evaluate[
rope: name,
context: head.context,
symTab: head.specials,
abort: head.abortClosure];
IF errorRope.Length[] # 0 THEN Misp.Error[env, NIL, errorRope];
IF noResult THEN Misp.Error[env, NIL, name.Cat[" has no value"]];
valTV ← MispToCedar[binding];
AMTypes.Assign[varTV, valTV];
};
EnumerateCedar: PROC [env: Misp.Environment, consume: PROC [key: ATOM, binding: REF ANY]] = {
head: InterpreterOps.EvalHead ← NARROW[env.rep];
cc: AMModel.Class;
FromRecord: PROC [record: TV] = {
type: AMTypes.Type ← AMTypes.TVType[record];
n: NAT ← AMTypes.NComponents[type];
FOR i: NAT IN [1 .. n] DO
name: ROPE ← AMTypes.IndexToName[type, i];
key: ATOM ← Atom.MakeAtom[name];
valTV: TV ← AMTypes.IndexToTV[record, i];
valRef: REF ANY ← CedarToMisp[valTV];
consume[key, valRef];
ENDLOOP;
};
PerSpecial: PROC [name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL] = {
WITH tv SELECT FROM
reallyTV: ReallyTV => {
key: ATOM ← Atom.MakeAtom[name];
valRef: REF ANY ← CedarToMisp[tv];
consume[key, valRef];
};
ENDCASE;
stop ← FALSE;
};
TRUSTED {cc ← AMModel.ContextClass[head.context]};
[] ← InterpreterOps.EnumerateSymbols[PerSpecial, NIL, head.specials];
SELECT cc FROM
world => NULL --don't define the Cedar world for Misp ... it can't use it--;
model => ERROR --don't know how to break down a CONFIG--;
statement => ERROR --don't know how to break down a statement--;
interface => FromRecord[AMModelBridge.IRFromContext[head.context]];
prog => FromRecord[AMTypes.Globals[AMModelBridge.FrameFromContext[head.context]]];
proc => {
context: TV ← AMModelBridge.FrameFromContext[head.context];
FOR tv: TV ← context, AMTypes.EnclosingBody[tv] WHILE tv # NIL DO
FromRecord[AMTypes.Locals[tv]];
ENDLOOP;
FromRecord[AMTypes.Globals[AMTypes.GlobalParent[context]]];
};
ENDCASE => ERROR;
};
CedarSize: PROC [env: Environment] RETURNS [NAT] = {
head: InterpreterOps.EvalHead ← NARROW[env.rep];
size: NAT ← 0;
Per: PROC [key: ATOM, binding: REF ANY] = {size ← size + 1};
env.class.Enumerate[env, Per];
RETURN [size];
};
Yet another way to Environmentize:
Environmentize: PROC [head: InterpreterOps.EvalHead] RETURNS [env: Misp.Environment] = {
size: NAT ← head.specials.GetSize[];
cc: AMModel.Class;
context: TV ← NIL;
contextType: AMTypes.Type;
FromRecord: PROC [record: TV] = {
type: AMTypes.Type ← AMTypes.TVType[record];
n: NAT ← AMTypes.NComponents[type];
FOR i: NAT IN [1 .. n] DO
name: ROPE ← AMTypes.IndexToName[type, i];
key: ATOM ← Atom.MakeAtom[name];
valTV: TV ← AMTypes.IndexToTV[record, i];
valRef: REF ANY ← CedarToMisp[valTV];
env.class.SetBinding[env, key, valRef, FALSE];
ENDLOOP;
};
PerSpecial: PROC [name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL] = {
key: ATOM ← Atom.MakeAtom[name];
valRef: REF ANY ← CedarToMisp[tv];
env.class.SetBinding[env, key, valRef, FALSE];
stop ← FALSE;
};
TRUSTED {cc ← AMModel.ContextClass[head.context]};
SELECT cc FROM
world => NULL --don't define the Cedar world for Misp ... it can't use it--;
model => ERROR --don't know how to break down a CONFIG--;
statement => ERROR --don't know how to break down a statement--;
interface => TRUSTED {
context ← AMModelBridge.IRFromContext[head.context];
contextType ← AMTypes.TVType[context];
size ← size + AMTypes.NComponents[contextType];
};
prog => TRUSTED {
context ← AMTypes.Globals[ AMModelBridge.FrameFromContext[head.context]];
contextType ← AMTypes.TVType[context];
size ← size + AMTypes.NComponents[contextType];
};
proc => TRUSTED {
context ← AMModelBridge.FrameFromContext[head.context];
contextType ← AMTypes.TVType[context];
FOR tv: TV ← context, AMTypes.EnclosingBody[tv] WHILE tv # NIL DO
size ← size + AMTypes.NComponents[AMTypes.TVType[AMTypes.Locals[tv]]];
ENDLOOP;
size ← size + AMTypes.NComponents[AMTypes.TVType[AMTypes.Globals[context]]];
};
ENDCASE => ERROR;
size ← size*2 + 201;
env ← Misp.NewEnvironment[name: "Cedar values", sizeGuess: size, stop: head.abortClosure];
Misp.DefinePrimitives[env];
[] ← InterpreterOps.EnumerateSymbols[PerSpecial, NIL, head.specials];
SELECT cc FROM
world => NULL --don't define the Cedar world for Misp ... it can't use it--;
model => ERROR --don't know how to break down a CONFIG--;
statement => ERROR --don't know how to break down a statement--;
interface => FromRecord[context];
prog => FromRecord[context];
proc => {
FOR tv: TV ← context, AMTypes.EnclosingBody[tv] WHILE tv # NIL DO
FromRecord[AMTypes.Locals[tv]];
ENDLOOP;
FromRecord[AMTypes.Globals[context]];
};
ENDCASE => ERROR;
};