
    <<TJaMTypeImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Maureen Stone February 6, 1984 5:07:45 pm PST>>
        <<Doug Wyatt, March 25, 1985 4:43:29 pm PST>>
    <<>>
    DIRECTORY
        Atom USING [GetPName, MakeAtom],
        Convert USING [IntFromRope, RealFromRope],
        TJaM,
        Real USING [Round],
        Rope USING [Equal, Length];

    TJaMTypeImpl: CEDAR PROGRAM
    IMPORTS Atom, Convert, TJaM, Rope, Real
    EXPORTS TJaM
    ~ BEGIN OPEN TJaM;

    firstInt: REAL _ INT.FIRST;
    lastInt: REAL _ INT.LAST;

    IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ {
        int: INT _ 0;
        IF real IN[firstInt..lastInt] THEN int _ Real.Round[real];
        IF int#real THEN ProduceError[wrongType];
        RETURN[int];
        };

    IntFromNum: PUBLIC PROC [n: NumberRep] RETURNS [INT] ~ {
        WITH n: n SELECT FROM
            int => RETURN[n.int];
            real => RETURN[IntFromReal[n.real]];
            ENDCASE => ERROR;
        };

    RealFromNum: PUBLIC PROC [n: NumberRep] RETURNS [REAL] ~ {
        WITH n: n SELECT FROM
            int => RETURN[REAL[n.int]];
            real => RETURN[n.real];
            ENDCASE => ERROR;
        };

    IntFromAny: PUBLIC PROC [x: REF] RETURNS [INT] ~ {
        WITH x SELECT FROM
            x: Number => {
                n: NumberRep ~ x^;
                WITH n: n SELECT FROM
                    int => RETURN[n.int];
                    ENDCASE;
                RETURN[IntFromNum[n]];
                };
            ENDCASE;
        ProduceError[wrongType]; RETURN[0];
        };

    RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ {
        WITH x SELECT FROM
            x: Number => {
                n: NumberRep ~ x^;
                WITH n: n SELECT FROM
                    int => RETURN[REAL[n.int]];
                    real => RETURN[n.real];
                    ENDCASE;
                RETURN[RealFromNum[n]];
                };
            ENDCASE;
        ProduceError[wrongType]; RETURN[0];
        };


    NumberFromAny: PUBLIC PROC [x: Any] RETURNS [Number] ~ {
        WITH x SELECT FROM
            x: Number => RETURN[x];
            x: Ob => RETURN[NumberFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    AtomFromAny: PUBLIC PROC [x: Any] RETURNS [ATOM] ~ {
        WITH x SELECT FROM
            x: ATOM => RETURN[x];
            x: Ob => RETURN[AtomFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    RopeFromAny: PUBLIC PROC [x: Any] RETURNS [ROPE] ~ {
        WITH x SELECT FROM
            x: ROPE => RETURN[x];
            x: Ob => RETURN[RopeFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    StreamFromAny: PUBLIC PROC [x: Any] RETURNS [STREAM] ~ {
        WITH x SELECT FROM
            x: STREAM => RETURN[x];
            x: Ob => RETURN[StreamFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    CmdFromAny: PUBLIC PROC [x: Any] RETURNS [Cmd] ~ {
        WITH x SELECT FROM
            x: Cmd => RETURN[x];
            x: Ob => RETURN[CmdFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    ArrayFromAny: PUBLIC PROC [x: Any] RETURNS [Array] ~ {
        WITH x SELECT FROM
            x: Array => RETURN[x];
            x: Ob => RETURN[ArrayFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    DictFromAny: PUBLIC PROC [x: Any] RETURNS [Dict] ~ {
        WITH x SELECT FROM
            x: Dict => RETURN[x];
            x: Ob => RETURN[DictFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };

    MarkFromAny: PUBLIC PROC [x: Any] RETURNS [Mark] ~ {
        WITH x SELECT FROM
            x: Mark => RETURN[x];
            x: Ob => RETURN[MarkFromAny[x.body]];
            ENDCASE;
        ProduceError[wrongType]; RETURN[NIL];
        };


    RopeFromAtom: PUBLIC PROC [atom: ATOM] RETURNS [ROPE] ~ {
        RETURN[Atom.GetPName[atom]];
        };

    AtomFromRope: PUBLIC PROC [rope: ROPE] RETURNS [ATOM] ~ {
        RETURN[Atom.MakeAtom[rope]];
        };
    <<>>
    Type: PUBLIC PROC [x: Any] RETURNS [TypeCode] ~ {
        IF x=NIL THEN RETURN[nil];
        RETURN[WITH x SELECT FROM
            x: Number => number,
            x: ATOM => atom,
            x: ROPE => rope,
            x: STREAM => stream,
            x: Cmd => cmd,
            x: Dict => dict,
            x: Array => array,
            x: Mark => mark,
            x: Ob => Type[x.body],
            ENDCASE => other];
        };


    TypeAtomArray: TYPE ~ REF TypeAtomArrayRep;
    TypeAtomArrayRep: TYPE ~ ARRAY TypeCode OF ATOM;
    typeAtom: TypeAtomArray ~ NEW[TypeAtomArrayRep _ [
        nil: AtomFromRope[".nil"],
        number: AtomFromRope[".number"],
        atom: AtomFromRope[".atom"],
        rope: AtomFromRope[".rope"],
        stream: AtomFromRope[".stream"],
        cmd: AtomFromRope[".cmd"],
        dict: AtomFromRope[".dict"],
        array: AtomFromRope[".array"],
        mark: AtomFromRope[".mark"],
        other: AtomFromRope[".other"]
        ]];

    Length: PUBLIC PROC [x: Any] RETURNS [INT] ~ {
        WITH x SELECT FROM
            x: Array => RETURN[x.len];
            x: Dict => RETURN[DictLength[x]];
            x: ROPE => RETURN[Rope.Length[x]];
            x: Ob => RETURN[Length[x.body]];
            ENDCASE;
        RETURN[1];
        };

    Equal: PUBLIC PROC [a, b: Any] RETURNS [BOOL] ~ {
        IF a=b THEN RETURN[TRUE];
        WITH a SELECT FROM
            a: Number => WITH b SELECT FROM
                b: Number => WITH a: a SELECT FROM
                    int => WITH b: b SELECT FROM
                        int => RETURN[a.int=b.int];
                        real => RETURN[a.int=b.real];
                        ENDCASE => ERROR;
                    real => WITH b: b SELECT FROM
                        int => RETURN[a.real=b.int];
                        real => RETURN[a.real=b.real];
                        ENDCASE => ERROR;
                    ENDCASE => ERROR;
                ENDCASE;
            a: ATOM => WITH b SELECT FROM
                b: ATOM => RETURN[a=b];
                b: ROPE => RETURN[a=AtomFromRope[b]];
                ENDCASE;
            a: ROPE => WITH b SELECT FROM
                b: ATOM => RETURN[AtomFromRope[a]=b];
                b: ROPE => RETURN[Rope.Equal[a, b]];
                ENDCASE;
            ENDCASE;
        WITH a SELECT FROM
            a: Ob => RETURN[Equal[a.body, b]];
            ENDCASE;
        WITH b SELECT FROM
            b: Ob => RETURN[Equal[a, b.body]];
            ENDCASE;
        RETURN[FALSE];
        };

    CvX: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
        WITH x SELECT FROM
            x: Ob => RETURN[IF x.tag=executable THEN x ELSE CvX[x.body]];
            ENDCASE => RETURN[NEW[ObRep _ [tag: executable, body: x]]];
        };

    CvLit: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
        WITH x SELECT FROM
            x: Ob => RETURN[IF x.tag=literal THEN x ELSE CvLit[x.body]];
            ENDCASE => RETURN[NEW[ObRep _ [tag: literal, body: x]]];
        };

    CvI: PUBLIC PROC [x: Any] RETURNS [INT] ~ {
        WITH x SELECT FROM
            x: Number => WITH x: x SELECT FROM
                int => RETURN[x.int];
                real => RETURN[Real.Round[x.real]];
                ENDCASE => ProduceError[bug];
            x: ROPE => RETURN[Convert.IntFromRope[x]];
            x: Ob => RETURN[CvI[x.body]];
            ENDCASE => ProduceError[wrongType];
        RETURN[0];
        };

    CvR: PUBLIC PROC [x: Any] RETURNS [REAL] ~ {
        WITH x SELECT FROM
            x: Number => WITH x: x SELECT FROM
                int => RETURN[REAL[x.int]];
                real => RETURN[x.real];
                ENDCASE => ProduceError[bug];
            x: ROPE => RETURN[Convert.RealFromRope[x]];
            x: Ob => RETURN[CvR[x.body]];
            ENDCASE => ProduceError[wrongType];
        RETURN[0];
        };


    ApplyType: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        type: TypeCode ~ Type[x];
        PushAtom[frame, typeAtom[type]];
        };

    ApplyLength: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        PushInt[frame, Length[x]];
        };

    ApplyCvLit: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        Push[frame, CvLit[x]];
        };

    ApplyCvX: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        Push[frame, CvX[x]];
        };

    ApplyCvI: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        PushInt[frame, CvI[x]];
        };

    ApplyCvR: PUBLIC PROC [frame: Frame] ~ {
        x: Any ~ Pop[frame];
        PushReal[frame, CvR[x]];
        };

    ApplyCommandName: PUBLIC PROC [frame: Frame] ~ {
        cmd: Cmd ~ PopCmd[frame];
        PushAtom[frame, cmd.name];
        };


    RegisterPrimitive[".type", ApplyType];
    RegisterPrimitive[".length", ApplyLength];
    RegisterPrimitive[".cvlit", ApplyCvLit];
    RegisterPrimitive[".cvx", ApplyCvX];
    RegisterPrimitive[".cvi", ApplyCvI];
    RegisterPrimitive[".cvr", ApplyCvR];
    RegisterPrimitive[".commandname", ApplyCommandName];

    END.