RoseFunctions.Mesa
Last Edited by: Spreitzer, July 8, 1983 4:11 pm
DIRECTORY
AMTypes, AMBridge, BBEval, BBEvalQuote, BBEvalUtil, Commander, IO, List, OrderedSymbolTableRef, ProcessProps, PPTreeOps, Rope, Rosemary;
RoseFunctions:
CEDAR
MONITOR
IMPORTS AMTypes, AMBridge, BBEval, BBEvalQuote, BBEvalUtil, List, OSTR: OrderedSymbolTableRef, ProcessProps, PPTreeOps, Rosemary =
BEGIN
ROPE: TYPE = Rope.ROPE;
Cell: TYPE = Rosemary.Cell;
Node: TYPE = Rosemary.Node;
Test: TYPE = REF TestRep;
TestRep:
TYPE =
RECORD [
testProc: Rosemary.TestProc ← NIL,
testData: REF ANY ← NIL];
Some procedures for calling directly from the interpreter:
Assign:
PROC [n: Node, value:
ROPE]
RETURNS [success:
BOOLEAN] =
BEGIN
ModifyIt: Rosemary.ModifyProc
--PROC [cell: Cell] RETURNS [subtle: BOOLEAN ← FALSE]-- =
TRUSTED
BEGIN
wp: Rosemary.WordPtr ← n.visible.SocketToWP[];
success ← n.type.fromRope[rope: value, where: wp, typeData: n.type.typeData];
END;
IF n.visible.cell = NIL THEN ERROR;
Rosemary.AllowToModify[cell: n.visible.cell, modifier: ModifyIt];
END;
CompileTest:
PROC [type: Rosemary.SignalType, asRope:
ROPE]
RETURNS [test: Test] =
BEGIN
success: BOOLEAN;
test ← NEW [TestRep ← []];
[success, test.testProc, test.testData] ← type.parseTest[rope: asRope, typeData: type.typeData];
IF NOT success THEN test ← NIL;
END;
ApplyTest:
PROC [n: Node, test: Test]
RETURNS [
BOOLEAN] =
BEGIN
wp: Rosemary.WordPtr;
IF n.visible.cell = NIL THEN ERROR;
wp ← n.visible.SocketToWP[];
RETURN[test.testProc[testData: test.testData, where: wp, typeData: n.type.typeData]];
END;
TestNode:
PROC [n: Node, testAsRope:
ROPE]
RETURNS [
BOOLEAN] =
BEGIN
test: Test ← CompileTest[n.type, testAsRope];
IF test = NIL THEN ERROR ELSE RETURN[ApplyTest[n, test]];
END;
the following (and Rosemary.LookupCell) have EvalQuote alternates:
LookupInternalNode:
PROC [path:
LIST
OF
ROPE, from: Cell ←
NIL]
RETURNS [n: Node] =
BEGIN
prefix: LIST OF ROPE;
nodeName: ROPE;
IF path = NIL THEN ERROR;
[prefix, nodeName] ← PrefixAndTail[path];
IF from = NIL AND prefix = NIL THEN ERROR;
from ← Rosemary.LookupCell[path: prefix, from: from];
n ← NARROW[from.internalNodes.Lookup[nodeName]];
END;
LookupInterfaceNode:
PROC [path:
LIST
OF
ROPE, from: Cell ←
NIL]
RETURNS [n: Node] =
BEGIN
prefix: LIST OF ROPE;
nodeName: ROPE;
index: CARDINAL;
IF path = NIL THEN ERROR;
[prefix, nodeName] ← PrefixAndTail[path];
IF from = NIL AND prefix = NIL THEN ERROR;
from ← Rosemary.LookupCell[path: prefix, from: from];
IF (index ← Rosemary.GetIndex[from.class.ports, nodeName]) # Rosemary.notFound THEN RETURN [from.interfaceNodes[index]];
n ← NIL;
END;
Some internal procedures:
PrefixAndTail:
PROC [whole:
LIST
OF
ROPE]
RETURNS [prefix:
LIST
OF
ROPE, tail:
ROPE] =
BEGIN
IF whole = NIL THEN ERROR;
IF whole.rest = NIL THEN RETURN[NIL, whole.first];
prefix ← whole;
FOR whole ← whole, whole.rest WHILE whole.rest.rest # NIL DO NULL ENDLOOP;
tail ← whole.rest.first;
whole.rest ← NIL;
END;
GetStream:
PROC
RETURNS [
IO.
STREAM] = {
WITH List.Assoc[$CommanderHandle, ProcessProps.GetPropList[]]
SELECT
FROM
cmd: Commander.Handle => RETURN [cmd.out];
ENDCASE => RETURN [NIL];
};
NArgs:
PROC [tree: BBEval.Tree]
RETURNS [sons:
NAT ← 0] = {
args: BBEval.Tree ← PPTreeOps.NthSon[tree, 2];
IF PPTreeOps.OpName[args] = list
THEN sons ← PPTreeOps.NSons[args]
ELSE sons ← 1;
};
GetArg:
PROC [tree: BBEval.Tree, which:
NAT]
RETURNS [son: BBEval.Tree ←
NIL] = {
args: BBEval.Tree ← PPTreeOps.NthSon[tree, 2];
IF PPTreeOps.OpName[args] = list
THEN {
IF which
IN [1..PPTreeOps.NSons[args]]
THEN
son ← PPTreeOps.NthSon[args, which]}
ELSE IF which = 1 THEN son ← args;
};
DotsToRopes:
PROC [dots: BBEval.Tree, tail:
LIST
OF
ROPE ←
NIL]
RETURNS [ropes:
LIST
OF
ROPE] =
BEGIN
IF PPTreeOps.OpName[dots] = dot
THEN
BEGIN
step: ROPE ← BBEvalUtil.TreeToRope[PPTreeOps.NthSon[dots, 2]];
ropes ← DotsToRopes[PPTreeOps.NthSon[dots, 1], CONS[step, tail]];
END
ELSE ropes ← CONS[BBEvalUtil.TreeToRope[dots], tail];
END;
cellAsCell: REF Cell ← NEW[Cell ← NIL];
cellAsTV: AMTypes.TypedVariable;
cellType: AMTypes.Type;
TVToCell:
ENTRY
PROC [tv: AMTypes.TypedVariable]
RETURNS [cell: Cell] =
BEGIN
AMTypes.Assign[cellAsTV, tv];
cell ← cellAsCell^;
END;
TVForCell:
ENTRY
PROC [cell: Cell]
RETURNS [tv: AMTypes.TypedVariable] =
BEGIN
cellAsCell^ ← cell;
tv ← AMTypes.Copy[cellAsTV];
END;
nodeAsNode: REF Node ← NEW[Node ← NIL];
nodeAsTV: AMTypes.TypedVariable;
nodeType: AMTypes.Type;
TVToNode:
ENTRY
PROC [tv: AMTypes.TypedVariable]
RETURNS [node: Node] =
BEGIN
AMTypes.Assign[nodeAsTV, tv];
node ← nodeAsNode^;
END;
TVForNode:
ENTRY
PROC [node: Node]
RETURNS [tv: AMTypes.TypedVariable] =
BEGIN
nodeAsNode^ ← node;
tv ← AMTypes.Copy[nodeAsTV];
END;
Some EvalQuoteProcs:
EvalLookupCell: BBEvalQuote.EvalQuoteProc
-- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type ← nullType, data: REF ← NIL] RETURNS [return: TV] -- =
BEGIN
path: LIST OF ROPE ← DotsToRopes[GetArg[tree, 1]];
from: Cell ← IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
return ← TVForCell[Rosemary.LookupCell[path: path, from: from]];
END;
EvalLookupInternalNode: BBEvalQuote.EvalQuoteProc
-- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type ← nullType, data: REF ← NIL] RETURNS [return: TV] -- =
BEGIN
path: LIST OF ROPE ← DotsToRopes[GetArg[tree, 1]];
from: Cell ← IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
return ← TVForNode[LookupInternalNode[path: path, from: from]];
END;
EvalLookupInterfaceNode: BBEvalQuote.EvalQuoteProc
-- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type ← nullType, data: REF ← NIL] RETURNS [return: TV] -- =
BEGIN
path: LIST OF ROPE ← DotsToRopes[GetArg[tree, 1]];
from: Cell ← IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
return ← TVForNode[LookupInterfaceNode[path: path, from: from]];
END;
TRUSTED
{
cellAsTV ← AMBridge.TVForReferent[cellAsCell];
nodeAsTV ← AMBridge.TVForReferent[nodeAsNode];
};
cellType ← AMTypes.TVType[cellAsTV];
nodeType ← AMTypes.TVType[nodeAsTV];
BBEvalQuote.Register["&lc", EvalLookupCell];
BBEvalQuote.Register["&lin", EvalLookupInternalNode];
BBEvalQuote.Register["&len", EvalLookupInterfaceNode];
END.