SMValImpl.mesa
Copyright
© 1985 by Xerox Corporation. All rights reserved.
last edit by Satterthwaite, May 25, 1986 10:18:43 am PDT
DIRECTORY
SMOps:
TYPE
USING [
MS],
SMTree:
TYPE Tree
USING [
BindOp, Handle, Id, Link, Name, NodeName, SonId, null, nullHandle],
SMTreeOps:
TYPE TreeOps
USING [
Scan,
TM, EndVisit, GetExt, GetName, NSons, NthSon, OpName, PutExt, ScanSons,
StartVisit],
SMVal:
TYPE
USING [];
SMValImpl:
CEDAR
PROGRAM
IMPORTS SMTreeOps
EXPORTS SMVal ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;
note: to expedite Id handling, these procs know about Tree.Node internals
Binding:
PUBLIC
PROC[t: Tree.Link]
RETURNS[
BOOL] ~ {
RETURN [TreeOps.OpName[t]
IN Tree.BindOp]};
BtoD:
PUBLIC
PROC[binding: Tree.Link]
RETURNS[decl: Tree.Handle] ~ {
b: Tree.Handle ~
NARROW[binding];
RETURN[
NARROW[b.son[1]]]};
BtoG:
PUBLIC
PROC[binding: Tree.Link]
RETURNS[group: Tree.Handle] ~ {
b: Tree.Handle ~
NARROW[binding];
son2: Tree.Handle ~
NARROW[b.son[2]];
RETURN[
SELECT son2.name
FROM
$group => son2,
$let =>
NARROW[son2.son[2]],
ENDCASE =>
ERROR]
};
next two auxiliary procs duplicated from SMEvalImpl
DBtoD:
PROC[db: Tree.Handle]
RETURNS[Tree.Handle] ~
INLINE {
RETURN[
IF db.name = $decl
THEN db
ELSE
NARROW[db.son[1]]]};
-- BindOp or cross2
DBtoG:
PROC[db: Tree.Handle]
RETURNS[g: Tree.Handle] ~ {
IF db.name
IN Tree.BindOp
THEN {
node: Tree.Handle ~
NARROW[db.son[2]];
SELECT node.name
FROM
$group => g ← node;
$let => g ←
NARROW[node.son[2]];
ENDCASE =>
ERROR;
}
ELSE g ← Tree.nullHandle;
RETURN};
IdName:
PUBLIC
PROC[id: Tree.Id]
RETURNS[Tree.Name] ~ {
RETURN[TreeOps.GetName[TreeOps.NthSon[DBtoD[id.db].son[id.p], 1]]]};
IdType:
PUBLIC
PROC[id: Tree.Id]
RETURNS[Tree.Link] ~ {
RETURN[TreeOps.NthSon[DBtoD[id.db].son[id.p], 2]]};
IdValue:
PUBLIC
PROC[id: Tree.Id]
RETURNS[Tree.Link] ~ {
RETURN[
SELECT id.db.name
FROM
$decl => Tree.null,
-- id? see VisitNodes
IN Tree.BindOp => DBtoG[id.db].son[id.p],
ENDCASE => Tree.null]
};
attribute retrieval (after Eval)
Select:
PUBLIC
PROC[binding: Tree.Link, index: Tree.Name]
RETURNS[Tree.Link] ~ {
d: Tree.Link ~ BtoD[binding];
g: Tree.Link ~ BtoG[binding];
FOR i:
NAT
IN [1 .. TreeOps.NSons[d]]
DO
son: Tree.Link ~ TreeOps.NthSon[d, i];
IF TreeOps.GetName[TreeOps.NthSon[son, 1]] = index
THEN
RETURN[TreeOps.NthSon[g, i]];
ENDLOOP;
RETURN[Tree.null]};
ValOf:
PUBLIC
PROC[t: Tree.Link]
RETURNS[Tree.Link] ~ {
RETURN[
WITH t
SELECT
FROM
id: Tree.Id =>
IF id.db.name
IN Tree.BindOp
THEN ValOf[DBtoG[id.db].son[id.p]]
ELSE id,
node: Tree.Handle =>
(
SELECT node.name
FROM
$subscript =>
IF Binding[ValOf[node.son[1]]]
THEN ValOf[Select[ValOf[node.son[1]], TreeOps.GetName[node.son[2]]]]
ELSE t,
$let => ValOf[node.son[2]],
ENDCASE => t),
ENDCASE => t]
};
ValOfNthSon:
PUBLIC
PROC[t: Tree.Link, n: Tree.SonId]
RETURNS[Tree.Link] ~ {
RETURN[ValOf[TreeOps.NthSon[t, n]]]};
enumeration of operator nodes (evaluates Id's, suppresses multiple visits)
VisitNodes:
PUBLIC
PROC[
tm: TreeOps.
TM, root: Tree.Link, proc:
PROC[node, parent: Tree.Link]] ~ {
mark:
BOOL ~ tm.StartVisit[];
parent: Tree.Link ← Tree.null;
Visit: TreeOps.Scan ~ {
WITH t
SELECT
FROM
node: Tree.Handle =>
IF node.visited # mark
AND node.name # $lambda
THEN {
saveParent: Tree.Link ~ parent;
node.visited ← mark;
parent ← node;
TreeOps.ScanSons[node, Visit];
-- postorder
proc[node, saveParent];
IF node.name = declElem
THEN Visit[node.ext]};
id: Tree.Id => Visit[IdValue[id]];
ENDCASE =>
NULL;
};
Visit[root];
tm.EndVisit};
ResetVisits:
PUBLIC
PROC[ms: SMOps.
MS] ~ {
for disaster recovery
mark:
BOOL;
Unmark: TreeOps.Scan ~ {
WITH t
SELECT
FROM
node: Tree.Handle => {
TreeOps.ScanSons[node, Unmark];
node.visited ← mark};
ENDCASE;
};
(ms.tm).EndVisit;
-- ok as a no-op
mark ← (ms.tm).StartVisit[];
Unmark[ms.val];
(ms.tm).EndVisit};
lambda decomposition
OuterBody:
PUBLIC
PROC[t: Tree.Link]
RETURNS[formals, body: Tree.Link] ~ {
RETURN (
WITH ValOf[t]
SELECT
FROM
node: Tree.Handle =>
SELECT TreeOps.OpName[node]
FROM
$lambda => [TreeOps.NthSon[node, 1], TreeOps.NthSon[node, 3]],
ENDCASE => [Tree.null, node],
ENDCASE => [Tree.null, t])
};
extension management (indirect to parse tree, after Eval)
GetExtFromParse:
PUBLIC
PROC[link: Tree.Link]
RETURNS[Tree.Link] ~ {
parseLink: Tree.Link ~
(
IF link = Tree.null
THEN Tree.null
ELSE
NARROW[TreeOps.GetExt[link]]);
RETURN[
WITH parseLink
SELECT
FROM
parseNode: Tree.Handle => TreeOps.GetExt[parseNode],
ENDCASE => Tree.null]
};
PutExtInParse:
PUBLIC
PROC[link: Tree.Link, ext: Tree.Link] ~ {
parseLink: Tree.Link ~
NARROW[TreeOps.GetExt[link]];
TreeOps.PutExt[parseLink, ext]};
}.