
<<RoseFunctions.Mesa>>
<<Last Edited by: Spreitzer, July 8, 1983 4:11 pm>>

    DIRECTORY
        AMTypes, AMBridge, BBEval, BBEvalQuote, BBEvalUtil, Commander, IO, List, OrderedSymbolTableRef, ProcessProps, PPTreeOps, Rope, 
        Rosemary;

    RoseFunctions: CEDAR MONITOR
        IMPORTS AMTypes, AMBridge, BBEval, BBEvalQuote, BBEvalUtil, List, OSTR: OrderedSymbolTableRef, ProcessProps, PPTreeOps, Rosemary =

    BEGIN

    ROPE: TYPE = Rope.ROPE;
    Cell: TYPE = Rosemary.Cell;
    Node: TYPE = Rosemary.Node;

    Test: TYPE = REF TestRep;
    TestRep: TYPE = RECORD [
        testProc: Rosemary.TestProc _ NIL,
        testData: REF ANY _ NIL];

    <<Some procedures for calling directly from the interpreter:>>

    Assign: PROC [n: Node, value: ROPE] RETURNS [success: BOOLEAN] =
        BEGIN
        ModifyIt: Rosemary.ModifyProc --PROC [cell: Cell] RETURNS [subtle: BOOLEAN _ FALSE]-- = TRUSTED
            BEGIN
            wp: Rosemary.WordPtr _ n.visible.SocketToWP[];
            success _ n.type.fromRope[rope: value, where: wp, typeData: n.type.typeData];
            END;
        IF n.visible.cell = NIL THEN ERROR;
        Rosemary.AllowToModify[cell: n.visible.cell, modifier: ModifyIt];
        END;

    CompileTest: PROC [type: Rosemary.SignalType, asRope: ROPE] RETURNS [test: Test] =
        BEGIN
        success: BOOLEAN;
        test _ NEW [TestRep _ []];
        [success, test.testProc, test.testData] _ type.parseTest[rope: asRope, typeData: type.typeData];
        IF NOT success THEN test _ NIL;
        END;

    ApplyTest: PROC [n: Node, test: Test] RETURNS [BOOLEAN] =
        BEGIN
        wp: Rosemary.WordPtr;
        IF n.visible.cell = NIL THEN ERROR;
        wp _ n.visible.SocketToWP[];
        RETURN[test.testProc[testData: test.testData, where: wp, typeData: n.type.typeData]];
        END;

    TestNode: PROC [n: Node, testAsRope: ROPE] RETURNS [BOOLEAN] =
        BEGIN
        test: Test _ CompileTest[n.type, testAsRope];
        IF test = NIL THEN ERROR ELSE RETURN[ApplyTest[n, test]];
        END;

    <<the following (and Rosemary.LookupCell) have EvalQuote alternates:>>

    LookupInternalNode: PROC [path: LIST OF ROPE, from: Cell _ NIL] RETURNS [n: Node] =
        BEGIN
        prefix: LIST OF ROPE;
        nodeName: ROPE;
        IF path = NIL THEN ERROR;
        [prefix, nodeName] _ PrefixAndTail[path];
        IF from = NIL AND prefix = NIL THEN ERROR;
        from _ Rosemary.LookupCell[path: prefix, from: from];
        n _ NARROW[from.internalNodes.Lookup[nodeName]];
        END;

    LookupInterfaceNode: PROC [path: LIST OF ROPE, from: Cell _ NIL] RETURNS [n: Node] =
        BEGIN
        prefix: LIST OF ROPE;
        nodeName: ROPE;
        index: CARDINAL;
        IF path = NIL THEN ERROR;
        [prefix, nodeName] _ PrefixAndTail[path];
        IF from = NIL AND prefix = NIL THEN ERROR;
        from _ Rosemary.LookupCell[path: prefix, from: from];
        IF (index _ Rosemary.GetIndex[from.class.ports, nodeName]) # Rosemary.notFound THEN RETURN [from.interfaceNodes[index]];
        n _ NIL;
        END;

    <<Some internal procedures:>>

    PrefixAndTail: PROC [whole: LIST OF ROPE] RETURNS [prefix: LIST OF ROPE, tail: ROPE] =
        BEGIN
        IF whole = NIL THEN ERROR;
        IF whole.rest = NIL THEN RETURN[NIL, whole.first];
        prefix _ whole;
        FOR whole _ whole, whole.rest WHILE whole.rest.rest # NIL DO NULL ENDLOOP;
        tail _ whole.rest.first;
        whole.rest _ NIL;
        END;

    GetStream: PROC RETURNS [IO.STREAM] = {
        WITH List.Assoc[$CommanderHandle, ProcessProps.GetPropList[]] SELECT FROM
            cmd: Commander.Handle => RETURN [cmd.out];
            ENDCASE => RETURN [NIL];
        };

    NArgs: PROC [tree: BBEval.Tree] RETURNS [sons: NAT _ 0] = {
        args: BBEval.Tree _ PPTreeOps.NthSon[tree, 2];
        IF PPTreeOps.OpName[args] = list
            THEN sons _ PPTreeOps.NSons[args]
            ELSE sons _ 1;
        };

    GetArg: PROC [tree: BBEval.Tree, which: NAT] RETURNS [son: BBEval.Tree _ NIL] = {
        args: BBEval.Tree _ PPTreeOps.NthSon[tree, 2];
        IF PPTreeOps.OpName[args] = list
            THEN {IF which IN [1..PPTreeOps.NSons[args]] THEN
                son _ PPTreeOps.NthSon[args, which]}
            ELSE IF which = 1 THEN son _ args;
        };

    DotsToRopes: PROC [dots: BBEval.Tree, tail: LIST OF ROPE _ NIL] RETURNS [ropes: LIST OF ROPE] =
        BEGIN
        IF PPTreeOps.OpName[dots] = dot THEN
            BEGIN
            step: ROPE _ BBEvalUtil.TreeToRope[PPTreeOps.NthSon[dots, 2]];
            ropes _ DotsToRopes[PPTreeOps.NthSon[dots, 1], CONS[step, tail]];
            END
        ELSE ropes _ CONS[BBEvalUtil.TreeToRope[dots], tail];
        END;

    cellAsCell: REF Cell _ NEW[Cell _ NIL];
    cellAsTV: AMTypes.TypedVariable;
    cellType: AMTypes.Type;

    TVToCell: ENTRY PROC [tv: AMTypes.TypedVariable] RETURNS [cell: Cell] =
        BEGIN
        AMTypes.Assign[cellAsTV, tv];
        cell _ cellAsCell^;
        END;

    TVForCell: ENTRY PROC [cell: Cell] RETURNS [tv: AMTypes.TypedVariable] =
        BEGIN
        cellAsCell^ _ cell;
        tv _ AMTypes.Copy[cellAsTV];
        END;

    nodeAsNode: REF Node _ NEW[Node _ NIL];
    nodeAsTV: AMTypes.TypedVariable;
    nodeType: AMTypes.Type;

    TVToNode: ENTRY PROC [tv: AMTypes.TypedVariable] RETURNS [node: Node] =
        BEGIN
        AMTypes.Assign[nodeAsTV, tv];
        node _ nodeAsNode^;
        END;

    TVForNode: ENTRY PROC [node: Node] RETURNS [tv: AMTypes.TypedVariable] =
        BEGIN
        nodeAsNode^ _ node;
        tv _ AMTypes.Copy[nodeAsTV];
        END;

    <<Some EvalQuoteProcs:>>

    EvalLookupCell: BBEvalQuote.EvalQuoteProc -- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type _ nullType, data: REF _ 
    NIL] RETURNS [return: TV] -- =
        BEGIN
        path: LIST OF ROPE _ DotsToRopes[GetArg[tree, 1]];
        from: Cell _ IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
        return _ TVForCell[Rosemary.LookupCell[path: path, from: from]];
        END;

    EvalLookupInternalNode: BBEvalQuote.EvalQuoteProc -- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type _ nullType, data: 
    REF _ NIL] RETURNS [return: TV] -- =
        BEGIN
        path: LIST OF ROPE _ DotsToRopes[GetArg[tree, 1]];
        from: Cell _ IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
        return _ TVForNode[LookupInternalNode[path: path, from: from]];
        END;

    EvalLookupInterfaceNode: BBEvalQuote.EvalQuoteProc -- PROC [head: BBEval.EvalHead, tree: BBEval.Tree, target: Type _ nullType, 
    data: REF _ NIL] RETURNS [return: TV] -- =
        BEGIN
        path: LIST OF ROPE _ DotsToRopes[GetArg[tree, 1]];
        from: Cell _ IF NArgs[tree] > 1 THEN TVToCell[BBEval.Eval[GetArg[tree, 2], head, cellType] !AMTypes.Error => ERROR] ELSE NIL;
        return _ TVForNode[LookupInterfaceNode[path: path, from: from]];
        END;

    TRUSTED
        {
        cellAsTV _ AMBridge.TVForReferent[cellAsCell];
        nodeAsTV _ AMBridge.TVForReferent[nodeAsNode];
        };
    cellType _ AMTypes.TVType[cellAsTV];
    nodeType _ AMTypes.TVType[nodeAsTV];
    BBEvalQuote.Register["&lc", EvalLookupCell];
    BBEvalQuote.Register["&lin", EvalLookupInternalNode];
    BBEvalQuote.Register["&len", EvalLookupInterfaceNode];

    END.