-- JunoToCedarImpl.mesa
-- Last Edited by: Gnelson, December 10, 1983 7:05 pm

DIRECTORY JunoToCedar, AMBridge, AMTypes, BBApply, BBContext, RTBasic, WorldVM;

JunoToCedarImpl: PROGRAM
    IMPORTS AMBridge, AMTypes, BBApply, BBContext, WorldVM
    EXPORTS JunoToCedar =

    BEGIN OPEN JunoToCedar;

    TypedVariable: TYPE = RTBasic.TypedVariable;
    Type: TYPE = RTBasic.Type;

    GetProc: PUBLIC PROC [pi: ProcIdentifier] RETURNS [success: BOOL, proc: Proc] =
        TRUSTED BEGIN
        w: BBContext.Context _ BBContext.ContextForWorld[WorldVM.LocalWorld[]];
        p: TypedVariable;
        [, p] _ BBContext.GlobalFrameSearch[context: w, frameName: pi.moduleName, itemName: pi.procName];
        IF p = NIL THEN RETURN [FALSE, NIL];
        IF AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[p]]] # procedure THEN RETURN [FALSE, NIL];
        TRUSTED {proc _ AMBridge.TVToProc[p]};
        success _ TRUE;
        END;

    Apply: PUBLIC PROC[p: Proc, args: ParameterList] RETURNS [success: BOOL, results: ParameterList] =
        TRUSTED BEGIN
        pAsTV: TypedVariable _ AMBridge.TVForProc[p];
        argsType: Type _ AMTypes.Domain[AMTypes.TVType[pAsTV]];
        resultsType: Type;
        argsAsTV: TypedVariable _ AMTypes.New[argsType];
        resultsAsTV: TypedVariable;
        SELECT AMTypes.TypeClass[argsType] FROM
            nil => NULL;
            record, structure => BEGIN
                FOR i: INT IN [1 .. AMTypes.NComponents[argsType]] DO
                    arg: TypedVariable _ AMTypes.IndexToTV[argsAsTV, i];
                    actual: TypedVariable;
                    mismatch: BOOLEAN _ FALSE;
                    IF args = NIL THEN RETURN [FALSE, NIL];
                    {foo: REF =
                     SELECT TRUE FROM
                     args.first = NIL 
                    OR ISTYPE[args.first, LIST OF REF] 
                    OR ISTYPE[args.first, ROPE] 
                    OR ISTYPE[args.first, ATOM] 
                    OR ISTYPE[args.first, REF TEXT] 
                    => NEW[REF _ args.first],
                     TRUE => args.first
                     ENDCASE => ERROR;
                     actual _ AMBridge.TVForReferent[foo]};
                    AMTypes.Assign[arg, actual !AMTypes.Error => {mismatch _ TRUE; -- this is because Cedar won't let us simply RETURN here-- 
                    CONTINUE}];
                    IF mismatch THEN RETURN [FALSE, NIL];
                    args _ args.rest;
                    ENDLOOP;
                IF args # NIL THEN RETURN [FALSE, NIL];
                END;
            ENDCASE => ERROR;
        resultsAsTV _ BBApply.ApplyProcToRecord[proc: pAsTV, args: argsAsTV];
        resultsType _ AMTypes.TVType[resultsAsTV];
        results _ NIL;
        SELECT AMTypes.TypeClass[resultsType] FROM
            nil => NULL;
            record, structure => BEGIN
                FOR i: INT DECREASING IN [1 .. AMTypes.NComponents[resultsType]] DO
                    result: TypedVariable _ AMTypes.IndexToTV[resultsAsTV, i];
                    temp: REF _ AMBridge.RefFromTV[AMTypes.Copy[result]];
                    IF ISTYPE[temp, REF LIST OF REF] 
                    OR ISTYPE[temp, REF ROPE] 
                    OR ISTYPE[temp, REF ATOM] 
                    OR ISTYPE[temp, REF REF TEXT] 
                    THEN temp _ NARROW[temp, REF REF]^;
                    results _ CONS[temp, results];
                    ENDLOOP;
                END;
            ENDCASE => ERROR;
        success _ TRUE;
        END;

    Test: PROC[n: INT, m: INT] RETURNS [INT] = {RETURN [n + m]};

    END.