
    <<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.