TransferStatements.Mesa
Last Edited by: Spreitzer, May 10, 1986 3:31:04 pm PDT
DIRECTORY AMBridge, AMModel, AMTypes, BackStop, BBUrpEval, CBinary, Commander, EvalQuote, Interpreter, InterpreterOps, InterpreterPrivate, IO, List, PPLeaves, PPP1, PPTree, PPTreeOps, PrincOps, PrincOpsUtils, PrintTV, Process, ProcessProps, Real, Rope, SafeStorage, StatementInterpreter, StatementInterpreterPrivate, SymTab;
TransferStatements:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, BackStop, BBUrpEval, InterpreterOps, IO, PPTreeOps, PrincOpsUtils, PrintTV, Process, Rope, SafeStorage, StatementInterpreterPrivate, SymTab
EXPORTS StatementInterpreter, StatementInterpreterPrivate =
BEGIN OPEN StatementInterpreterPrivate;
emptyFields: Fields ← NEW[FieldsRep[0]];
CatchSeries: TYPE = REF CatchSeriesRep;
CatchSeriesRep:
TYPE =
RECORD [
arms: SEQUENCE length: NAT OF CatchArm];
CatchArm: TYPE = REF CatchArmRep;
CatchArmRep:
TYPE =
RECORD [
stmt: Tree,
theSigType: Type,
multipleSigTypes: BOOL,
signals: SEQUENCE length: NAT--0 is for the ANY arm-- OF Signal
];
Signal: TYPE = ERROR ANY RETURNS ANY;
Decide:
PROC [catchSeries: CatchSeries, sig: Signal, lftv:
TV, head: EvalHead]
RETURNS [sd: SignalDecision] = {
TryCatch:
PROC [catch: CatchArm]
RETURNS [caught:
BOOL] = {
caught ← FALSE;
IF catch.length = 0
THEN caught ← TRUE
ELSE
FOR i:
NAT
IN [0 .. catch.length)
WHILE
NOT caught
DO
IF catch.signals[i] = sig THEN caught ← TRUE;
ENDLOOP;
IF caught
THEN sd ← ProcessStmt[
catch.stmt,
IF catch.multipleSigTypes THEN nullType ELSE catch.theSigType,
lftv,
head];
};
FOR i:
NAT
IN [0 .. catchSeries.length)
DO
IF TryCatch[catchSeries[i]] THEN RETURN;
ENDLOOP;
sd ← [Reject];
};
ProcessStmt:
PROC [stmt: Tree, sigType: Type, lftv:
TV, head: EvalHead]
RETURNS [sd: SignalDecision] = {
subHead: EvalHead = NestHead[head];
argsType, resultsType: Type ← nullType;
IF sigType # nullType
THEN {
argsType ← AMTypes.Domain[sigType];
SELECT AMTypes.TypeClass[sigType]
FROM
signal => resultsType ← AMTypes.Range[sigType];
error => resultsType ← nullType;
ENDCASE => ERROR;
SetupFrame[subHead, argsType, resultsType, lftv, FALSE];
};
sd ← [Reject];
InterpNoProps[stmt, subHead !
DecideSignal => {sd ← [decision]; CONTINUE};
GetResumeFields => RESUME [NIL--wrong, but you'll never know, since we can't RESUME anyway--];
Resume => {sd ← [type: Resume, fields: fields]; CONTINUE};
GetReturnFields, Return =>
The language prohibits this, so we
BBUrpEval.UrpFatal[subHead, stmt, "Can't RETURN out of a catch phrase"];
but wouldn't it be nice if we could
{sd ← [type: Return, fields: fields]; CONTINUE};
Exit => {sd ← [Exit]; CONTINUE};
Loop => {sd ← [Loop]; CONTINUE};
GoTo => {sd ← [type: GoTo, label: label]; CONTINUE};
];
IF sd.type = Resume
THEN {
formalResults: Fields = FieldsFromType[resultsType];
CloseupFrame[formalResults, sd.fields, lftv, NIL, "Catch phrase", subHead, stmt, subHead.specials, FALSE];
};
};
DigestCatchSeries:
PROC [catch: Node, head: EvalHead]
RETURNS [cs: CatchSeries] = {
catchRegular: Node ← NARROW[catch.son[1]];
catchAny: Node ← NARROW[catch.son[2]];
anyPresent: BOOL ← catchAny # NIL;
numRegulars: NAT ← PPTreeOps.ListLength[catchRegular];
armIndex: NAT ← 0;
PerCatch:
PROC [t: Tree] = {
item: Node ← NARROW[t];
names: Tree ← item.son[1];
stmt: Tree ← item.son[2];
numNames: NAT ← PPTreeOps.ListLength[names];
nameIndex: NAT ← 0;
PerName:
PROC [t: Tree] = {
armtv: TV;
armType: Type;
armtv ← EvalExpr[tree: t, head: head, target: cs[armIndex].theSigType];
armType ← AMTypes.UnderType[AMTypes.TVType[armtv]];
IF NOT AMTypes.TypeClass[armType] IN [signal .. error] THEN BBUrpEval.UrpFatal[head, t, "Not a signal or error"];
TRUSTED {cs[armIndex].signals[nameIndex] ← AMBridge.TVToSignal[armtv]};
IF cs[armIndex].theSigType = nullType THEN cs[armIndex].theSigType ← armType ELSE
IF cs[armIndex].multipleSigTypes THEN NULL ELSE
IF NOT SafeStorage.EquivalentTypes[cs[armIndex].theSigType, armType] THEN cs[armIndex].multipleSigTypes ← TRUE;
nameIndex ← nameIndex + 1;
};
cs[armIndex] ← NEW [CatchArmRep[numNames]];
cs[armIndex].stmt ← stmt;
cs[armIndex].theSigType ← nullType;
cs[armIndex].multipleSigTypes ← FALSE;
PPTreeOps.ScanList[names, PerName];
IF nameIndex # numNames THEN ERROR;
armIndex ← armIndex + 1;
};
cs ← NEW [CatchSeriesRep[numRegulars + (IF anyPresent THEN 1 ELSE 0)]];
PPTreeOps.ScanList[catchRegular, PerCatch];
IF armIndex # numRegulars THEN ERROR;
IF anyPresent
THEN {
cs[armIndex] ← NEW [CatchArmRep[0]];
cs[armIndex].stmt ← catchAny;
cs[armIndex].theSigType ← nullType;
cs[armIndex].multipleSigTypes ← FALSE;
armIndex ← armIndex + 1;
};
};
Enable:
PUBLIC
PROC [catches: Node, head: EvalHead, inner:
PROC] = {
IF catches =
NIL
THEN inner[]
ELSE {
catchSeries: CatchSeries;
sd: SignalDecision ← [Continue];
IF catches.name # catch THEN ERROR;
catchSeries ← DigestCatchSeries[catches, head];
inner[!
UNWIND => {
lf: PrincOps.FrameHandle;
lftv: TV;
TRUSTED {
lf ← PrincOpsUtils.MyLocalFrame[];
lftv ← AMBridge.TVForFrame[fh: lf];
};
sd ← Decide[catchSeries: catchSeries, sig: UNWIND, lftv: lftv, head: head];
SELECT sd.type
FROM
Reject => REJECT;
Retry => RETRY;
Continue, Return, Exit, Loop, GoTo => CONTINUE;
Resume => BBUrpEval.UrpFatal[head, catches, "RESUMEing not yet implemented"];
ENDCASE => ERROR;
};
ANY => {
lf: PrincOps.FrameHandle;
lftv, sigtv: TV;
sig: Signal;
TRUSTED {
lf ← PrincOpsUtils.MyLocalFrame[];
lftv ← AMBridge.TVForFrame[fh: lf];
sigtv ← AMTypes.Signal[lftv];
sig ← AMBridge.TVToSignal[sigtv];
};
sd ← Decide[catchSeries: catchSeries, sig: sig, lftv: lftv, head: head];
SELECT sd.type
FROM
Reject => REJECT;
Retry => RETRY;
Continue, Return, Exit, Loop, GoTo => CONTINUE;
Resume => BBUrpEval.UrpFatal[head, catches, "RESUMEing not yet implemented"];
ENDCASE => ERROR;
}
];
SELECT sd.type
FROM
Reject => NULL;
Retry => NULL;
Continue => NULL;
Resume => NULL;
Return => ERROR Return[sd.fields];
Exit => ERROR Exit[];
Loop => ERROR Loop[];
GoTo => ERROR GoTo[sd.label];
ENDCASE => ERROR;
};
};
SetupFrame:
PROC [head: EvalHead, argsType, resultsType: Type, frameTV:
TV, useLocals:
BOOL] = {
locals: TV;
localsType: Type;
GetLocal:
PROC [name:
ROPE]
RETURNS [local:
TV] = {
index: CARDINAL = AMTypes.NameToIndex[localsType, name];
local ← AMTypes.IndexToTV[locals, index];
};
nArgs, nResults: NAT;
IF useLocals
THEN {
locals ← AMTypes.Locals[frameTV];
localsType ← AMTypes.TVType[locals];
};
nArgs ←
SELECT AMTypes.TypeClass[argsType]
FROM
record, structure => AMTypes.NComponents[argsType],
nil => 0,
ENDCASE => ERROR;
nResults ←
SELECT AMTypes.TypeClass[resultsType]
FROM
record, structure => AMTypes.NComponents[resultsType],
nil => 0,
ENDCASE => ERROR;
FOR i:
NAT
IN [1 .. nArgs]
DO
name: ROPE ← AMTypes.IndexToName[argsType, i];
val: TV;
IF name.Length[] = 0 THEN LOOP;
val ← IF useLocals THEN GetLocal[name] ELSE AMTypes.Copy[AMTypes.Argument[frameTV, i]];
[] ← SymTab.Store[head.specials, name, val];
ENDLOOP;
FOR i:
NAT
IN [1 .. nResults]
DO
name: ROPE ← AMTypes.IndexToName[resultsType, i];
val: TV;
IF name.Length[] = 0 THEN LOOP;
IF useLocals
THEN val ← GetLocal[name]
ELSE {
val ← AMTypes.IndexToDefaultInitialValue[resultsType, i];
val ← IF val # NIL THEN AMTypes.Copy[val] ELSE AMTypes.New[AMTypes.IndexToType[resultsType, i]];
};
[] ← SymTab.Store[head.specials, name, val];
ENDLOOP;
};
SetupProc:
PROC [head: EvalHead, argsType, resultsType: Type, frameTV, locals:
TV, argsFields, retsFields: Fields, hackResults:
BOOL] = {
nArgs, nResults: NAT;
nArgs ←
SELECT AMTypes.TypeClass[argsType]
FROM
record, structure => AMTypes.NComponents[argsType],
nil => 0,
ENDCASE => ERROR;
nResults ←
SELECT AMTypes.TypeClass[resultsType]
FROM
record, structure => AMTypes.NComponents[resultsType],
nil => 0,
ENDCASE => ERROR;
IF nArgs # argsFields.length OR nResults # retsFields.length THEN ERROR;
FOR i:
NAT
IN [0 .. nArgs)
DO
name: ROPE = argsFields[i].name;
val: TV;
IF name.Length[] = 0 THEN LOOP;
val ← AMTypes.Argument[frameTV, i+1];
[] ← SymTab.Store[head.specials, name, val];
ENDLOOP;
FOR i:
NAT
IN [0 .. nResults)
DO
name: ROPE = retsFields[i].name;
var, val: TV;
var ← IF hackResults THEN AMTypes.IndexToTV[locals, i+1] ELSE AMTypes.Result[frameTV, i+1];
val ← IF retsFields[i].valued THEN NARROW[retsFields[i].value] ELSE AMTypes.New[retsFields[i].type];
AMTypes.Assign[var, val];
IF name.Length[] = 0 THEN LOOP;
[] ← SymTab.Store[head.specials, name, var];
ENDLOOP;
};
CloseupFrame:
PROC [formalResults, actualResults: Fields, frameTV, locals:
TV, lname:
ROPE, head: EvalHead, parent: Tree, table: SymbolTable, hackResults:
BOOL] = {
matchedResults: Fields = SafeMatch[formalResults, actualResults, lname, head, parent, table];
FOR i:
NAT
IN [0 .. formalResults.length)
DO
val, var: TV;
val ← matchedResults[i].value;
var ← IF hackResults THEN AMTypes.IndexToTV[locals, i+1] ELSE AMTypes.Result[frameTV, i+1];
AMTypes.Assign[var, val];
ENDLOOP;
};
DoDummy:
PUBLIC
PROC [fh: PrincOps.FrameHandle, hackReturns:
BOOL ←
FALSE] = {
lftv, proctv, locals: TV ← NIL;
proc: PROCANY;
ds: DummyStuff;
l: Lambda;
subHead: EvalHead;
ans: Fields ← NIL;
TRUSTED {
lftv ← AMBridge.TVForFrame[fh];
proctv ← AMTypes.Procedure[lftv];
proc ← AMBridge.TVToProc[proctv];
};
IF hackReturns THEN locals ← AMTypes.Locals[lftv];
ds ← GetStuff[proc];
l ← ds.asLambda;
subHead ← NestHead[l.head];
SetupProc[subHead, l.argsType, l.retsType, lftv, locals, l.args, l.rets, hackReturns];
InterpNoProps[l.body, subHead !
GetReturnFields => RESUME [l.rets];
Return => {ans ← fields; CONTINUE};
DecideSignal, GetResumeFields, Resume, Exit, Loop, GoTo => {BBUrpEval.UrpFatal[subHead, l.body, "Can't EXIT, LOOP, GOTO, REJECT, RESUME, RETRY, or CONTINUE out of a procedure body"]; CONTINUE}
];
IF ans # NIL THEN CloseupFrame[l.rets, ans, lftv, locals, l.name, subHead, l.body, subHead.specials, hackReturns];
};
RecordFromFields:
PUBLIC
PROC [fields: Fields, type: Type]
RETURNS [rec:
TV] = {
rec ← AMTypes.New[type];
FOR i:
NAT
IN [0 .. fields.length)
DO
index: NAT ← IF fields.named THEN AMTypes.NameToIndex[type, fields[i].name] ELSE (i+1);
elt: TV ← AMTypes.IndexToTV[rec, index];
AMTypes.Assign[elt, fields[i].value];
ENDLOOP;
};
FieldsFromType:
PUBLIC
PROC [type: Type]
RETURNS [fields: Fields] = {
n: NAT;
someNamed: BOOL ← FALSE;
allNamed: BOOL ← TRUE;
n ←
SELECT AMTypes.TypeClass[type]
FROM
record, structure => AMTypes.NComponents[type],
nil => 0,
ENDCASE => ERROR;
fields ← NEW [FieldsRep[n]];
FOR i:
NAT
IN [0 .. n)
DO
fields[i].name ← AMTypes.IndexToName[type, i+1];
IF fields[i].name.Length[] # 0 THEN someNamed ← TRUE ELSE allNamed ← FALSE;
fields[i].type ← AMTypes.IndexToType[type, i+1];
fields[i].typed ← TRUE;
fields[i].value ← AMTypes.IndexToDefaultInitialValue[type, i+1];
fields[i].valued ← fields[i].value # NIL;
ENDLOOP;
IF (n>0) AND (someNamed # allNamed) THEN ERROR;
fields.named ← someNamed;
};
DigestFields:
PUBLIC
PROC [tree: Tree, eval, mayNIL:
BOOLEAN, head: EvalHead, guide: Fields ←
NIL]
RETURNS [fields: Fields] =
BEGIN
Op: TYPE = {Count, Fill};
count, index: NAT ← 0;
op: Op;
someNamed: BOOLEAN ← FALSE;
allNamed: BOOLEAN ← TRUE;
DoIt: PPTree.Scan
--PROC [t: Link]-- =
BEGIN
SELECT PPTreeOps.OpName[t]
FROM
decl => Work[PPTreeOps.NthSon[t, 1], PPTreeOps.NthSon[t, 2], PPTreeOps.NthSon[t, 3]];
item => Work[PPTreeOps.NthSon[t, 1], NIL, PPTreeOps.NthSon[t, 2]];
ENDCASE => Work[NIL, NIL, t];
END;
Work:
PROCEDURE [name, type, value: Tree] =
BEGIN
RealWork: PPTree.Scan
--PROC [t: Link]-- =
BEGIN
name: Tree = t;
SELECT op
FROM
Count => count ← count + 1;
Fill =>
BEGIN
IF name #
NIL
THEN
BEGIN
someNamed ← TRUE;
fields[index].name ← InterpreterOps.TreeToName[name]
END
ELSE
BEGIN
allNamed ← FALSE;
fields[index].name ← NIL;
END;
fields[index].type ←
IF (fields[index].typed ← type #
NIL)
THEN ForceType[EvalExpr[type, head, typeType], head, type]
ELSE nullType;
IF NOT (fields[index].valued ← value # NIL) THEN NULL
ELSE IF NOT eval THEN fields[index].value ← value
ELSE {
target: Type ← fields[index].type;
IF target = nullType
AND guide #
NIL
THEN {
j: NAT ← IF fields[index].name = NIL THEN index ELSE FindName[guide, fields[index].name];
IF j < guide.length THEN target ← guide[j].type;
};
fields[index].value ← EvalExpr[value, head, target];
};
index ← index + 1;
END;
ENDCASE => ERROR;
END;
IF name = NIL THEN RealWork[NIL]
ELSE PPTreeOps.ScanList[name, RealWork];
END;
IF mayNIL AND (tree = NIL) THEN RETURN [NIL];
op ← Count; PPTreeOps.ScanList[tree, DoIt];
fields ← NEW [FieldsRep[count]];
op ← Fill; PPTreeOps.ScanList[tree, DoIt];
IF (someNamed # allNamed) AND count > 0 THEN ERROR;
fields.named ← someNamed;
END;
EvalReturn:
PUBLIC
PROC [rn: Node, head: EvalHead] = {
guide: Fields ← GetReturnFields[];
fields: Fields;
fields ← DigestFields[rn.son[1], TRUE, TRUE, head, guide];
ERROR Return[fields];
};
EvalResume:
PUBLIC
PROC [rn: Node, head: EvalHead] = {
fields: Fields;
fields ← DigestFields[rn.son[1], TRUE, TRUE, head];
ERROR Resume[fields];
};
EvalProcedure:
PUBLIC
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
--EvalQuote.EvalQuoteProc-- =
BEGIN
args: Tree;
actualFields, matchedArgs, ans: Fields ← NIL;
l: Lambda ← NARROW[data];
subHead: EvalHead;
SIGNAL BackStop.SuspendBackStop[];
Process.CheckForAbort[];
SIGNAL BackStop.ResumeBackStop[];
IF PPTreeOps.OpName[tree] # apply THEN ERROR;
args ← PPTreeOps.NthSon[tree, 2];
actualFields ← DigestFields[args, TRUE, FALSE, head, l.args];
matchedArgs ← SafeMatch[l.args, actualFields, l.name.Cat[".Args"], head, tree, NIL];
subHead ← NestHead[head, l.head.specials];
Bind[subHead.specials, matchedArgs];
Bind[subHead.specials, l.rets];
[] ← InterpNoProps[l.body, subHead !
GetReturnFields => RESUME [l.rets];
Return => {ans ← fields; CONTINUE};
DecideSignal, GetResumeFields, Resume, Exit, Loop, GoTo => {BBUrpEval.UrpFatal[head, tree, "Can't EXIT, LOOP, GOTO, REJECT, RESUME, RETRY, or CONTINUE out of a procedure body"]; CONTINUE}];
SELECT l.rets.length
FROM
=0 => {
IF ans # NIL AND ans.length # 0 THEN BBUrpEval.UrpFatal[head, tree, Rope.Cat["Values returned to ", l.name, ", who wasn't expecting them"]];
return ← empty;
};
>0 => {
matchedRets: Fields ← SafeMatch[l.rets, ans, l.name.Cat[".Results"], subHead, tree, subHead.specials];
return ← IF l.retsType # nullType THEN RecordFromFields[matchedRets, l.retsType] ELSE matchedRets[0].value
};
ENDCASE => ERROR;
END;
SafeMatch:
PROC [formals, actuals: Fields, lname:
ROPE, head: EvalHead, parent: Tree, table: SymbolTable]
RETURNS [bound: Fields] =
BEGIN
bound ← Match[formals, actuals, lname, table !
MatchWarning => {BBUrpEval.UrpFatal[head, parent, IO.PutFR[fmt, v1, v2, v3, v4]]; CONTINUE};
MatchError => {BBUrpEval.UrpFatal[head: head, parent: parent, msg: IO.PutFR[format, v1, v2, v3, v4]]; CONTINUE}];
END;
MatchWarning: SIGNAL [fmt: ROPE, v1, v2, v3, v4: IO.Value ← [null[]]] = CODE;
MatchError: ERROR [format: ROPE, v1, v2, v3, v4: IO.Value ← [null[]]] = CODE;
MissType: TYPE = {elide, omit};
Match:
PROC [formals, actuals: Fields, lname:
ROPE, table: SymbolTable]
RETURNS [bound: Fields] =
BEGIN
Miss:
PROC [i:
NAT, how: MissType] = {
IF formals[i].valued
THEN {bound[i].valued ← TRUE; bound[i].value ← formals[i].value; RETURN}
ELSE
IF formals[i].typed
THEN {
div: TV ← AMTypes.DefaultInitialValue[formals[i].type];
IF div #
NIL
THEN {bound[i].valued ← TRUE; bound[i].value ← div; RETURN};
}
ELSE ERROR --formals must have types, right?--;
SELECT how
FROM
elide => {v:
TV ← AMTypes.New[formals[i].type];
bound[i].valued ← TRUE; bound[i].value ← v; RETURN};
omit => ERROR MatchError["%g omitted", IO.rope[Describe[i]]];
ENDCASE;
};
SetValue:
PROC [j, i:
NAT] =
BEGIN
bound[j].valued ← TRUE;
IF NOT bound[j].typed THEN bound[j].value ← actuals[i].value
ELSE bound[j].value ← AMTypes.Coerce[
tv: actuals[i].value,
targetType: bound[j].type !
AMTypes.Error => {msgs:
IO.
STREAM ←
IO.
ROS[];
msgs.PutF["Type mismatch at %g: expecting a ", IO.rope[Describe[j]]];
PrintTV.PrintType[bound[j].type, msgs];
msgs.PutRope[", got "];
PrintTV.Print[actuals[i].value, msgs];
ERROR MatchError[IO.RopeFromROS[msgs]]}];
END;
Describe:
PROC [i:
NAT]
RETURNS [
ROPE] =
{
RETURN[
IF bound.named
THEN IO.PutFR["%g.%g", IO.rope[lname], IO.rope[bound[i].name]]
ELSE IO.PutFR["%g'th %g", IO.card[i], IO.rope[lname]]]};
bound ← UnvalueFields[formals];
IF actuals =
NIL
THEN {
IF table = NIL THEN ERROR;
IF bound.length = 0 THEN RETURN;
IF NOT bound.named THEN MatchError["Default return or resume of unnamed fields from %g", IO.rope[lname]];
FOR i:
NAT
IN [0 .. bound.length)
DO
found: BOOL;
val: TV;
[found, val] ← table.Fetch[bound[i].name];
IF NOT found THEN ERROR --should have been initialized, right?--;
bound[i].valued ← TRUE;
bound[i].value ← val;
ENDLOOP;
RETURN;
};
IF actuals.named
THEN
BEGIN
IF NOT bound.named THEN ERROR MatchError["No keywords to match against"];
FOR i:
NAT
IN [0 .. actuals.length)
DO
j: NAT ← FindName[bound, actuals[i].name];
IF j >= bound.length
THEN
BEGIN
SIGNAL MatchWarning["%g is not a valid key for %g", IO.rope[actuals[i].name], IO.rope[lname]];
LOOP;
END;
IF bound[j].valued THEN SIGNAL MatchWarning["%g was bound multiple times", IO.rope[Describe[j]]];
IF actuals[i].valued THEN SetValue[j, i] ELSE Miss[j, elide];
ENDLOOP;
END
ELSE
BEGIN
IF actuals.length > formals.length
THEN
SIGNAL MatchWarning["%g extra fields for %g ignored", IO.int[actuals.length - formals.length], IO.rope[lname]];
FOR i:
NAT
IN [0 ..
MIN[formals.length, actuals.length])
DO
IF actuals[i].valued THEN SetValue[i, i] ELSE Miss[i, elide];
ENDLOOP;
END;
FOR i:
NAT
IN [0 .. bound.length)
DO
IF NOT bound[i].valued THEN Miss[i, omit];
ENDLOOP;
END;
FindName:
PROC [fields: Fields, name:
ROPE]
RETURNS [index:
NAT] =
BEGIN
FOR index ← 0, index + 1
WHILE index < fields.length
DO
IF name.Equal[fields[index].name] THEN RETURN;
ENDLOOP;
END;
UnvalueFields:
PROC [from: Fields]
RETURNS [to: Fields] =
BEGIN
to ← NEW [FieldsRep[from.length]];
to.named ← from.named;
FOR i: NAT IN [0 .. to.length) DO to[i] ← from[i]; to[i].valued ← FALSE ENDLOOP;
END;
Bind:
PROC [st: SymbolTable, fields: Fields] =
BEGIN
FOR i:
NAT
IN [0 .. fields.length)
DO
IF fields[i].name = NIL THEN LOOP;
IF fields[i].valued
THEN
BEGIN
[] ← SymTab.Store[st, fields[i].name, AMTypes.Copy[fields[i].value]];
END
ELSE
IF fields[i].typed
THEN
BEGIN
[] ← SymTab.Store[st, fields[i].name, AMTypes.New[fields[i].type]];
END;
ENDLOOP;
END;
Start:
PROC = {
emptyFields.named ← FALSE;
};
Start[];
END.