[ivy]<Satterthwaite>SML>SMValImpl.mesa!7

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]};
}.