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