
<<VariablesImpl.mesa>>
<<Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT>>
<<>>
DIRECTORY
Rope,
    IO,
    Basics,
    Ascii,
    Atom,
MathExpr,
MathConstructors,
AlgebraClasses,
Ints,
Variables;

VariablesImpl: CEDAR PROGRAM
IMPORTS IO, Rope, Ascii, MathExpr, MathConstructors, AlgebraClasses
EXPORTS Variables

= BEGIN OPEN Variables, AC: AlgebraClasses;
<<Types>>
VariablesError: PUBLIC SIGNAL [reason: ATOM _ $Unspecified] = CODE;
    bitsPerWord: CARDINAL = Basics.bitsPerWord;
    CARD: TYPE = LONG CARDINAL;
    ROPE: TYPE = Rope.ROPE;
    STREAM: TYPE = IO.STREAM;
    Object: TYPE = AC.Object;
    Method: TYPE = AC.Method;
EXPR: TYPE =  MathExpr.EXPR;

TypeError: PUBLIC ERROR [message: ATOM _ $Unspecified] = CODE;
<<Structure Operations>>
PrintName: PUBLIC AC.ToRopeOp = {
RETURN["Variables"];
};

ShortPrintName: PUBLIC AC.ToRopeOp = {
RETURN["V"];
};

IsVariables: PUBLIC AC.UnaryPredicate = {
RETURN[AC.StructureEqual[arg, Variables] ];
};
<<I/O and Conversion>>
Recast: PUBLIC AC.BinaryOp = {
    isVarInSSSMethod: Method;
IF AC.StructureEqual[firstArg.class, Variables] THEN RETURN[firstArg];
    isVarInSSSMethod _ AC.LookupMethodInStructure[$isVarInSSS, firstArg.class];
    IF isVarInSSSMethod# NIL THEN {
        uSUEltFromSSSEltMethod: Method _ AC.LookupMethodInStructure[$USUEltFromSSSElt, firstArg.class];
        RETURN[AC.ApplyNoLkpNoRecastObject[uSUEltFromSSSEltMethod, LIST[firstArg] ] ];
        };
    RETURN[NIL];
}; 

CanRecast: PUBLIC AC.BinaryPredicate = {
firstArgStructure: Object _ IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN 
firstArg ELSE ERROR;
    IF AC.StructureEqual[firstArgStructure, Variables] THEN RETURN[TRUE];
    IF AC.LookupMethodInStructure[$singleSetStructure, firstArgStructure]#NIL THEN {
    underlyingSet: Object _ AC.ApplyLkpNoRecastObject[$underlyingSet, firstArgStructure, LIST[firstArg.class] ];
    universe: Object _ AC.ApplyLkpNoRecastObject[$universe, underlyingSet.class, LIST[underlyingSet.class] ];
        RETURN[ AC.StructureEqual[universe, Variables] ];
        };
    RETURN[FALSE];
};

    MakeSuperscript: PUBLIC PROC[base, superscript: EXPR] RETURNS[EXPR] ~ {
        RETURN[MathExpr.MakeCompoundExpr[$superscript, LIST[[$base, base], [$superscript, superscript]]]];
        };

    MakeHat: PUBLIC PROC[base, hat: EXPR] RETURNS[EXPR] ~ {
        RETURN[MathExpr.MakeCompoundExpr[$hat, LIST[[$base, base], [$hat, hat]]]];
        };

    MakePrime: PUBLIC PROC[base: EXPR] RETURNS[EXPR] ~ {
        RETURN[MathExpr.MakeCompoundExpr[$prime, LIST[[$a, base]] ] ];
        };

ToExpr: PUBLIC AC.ToExprOp = {
name: ROPE _ NARROW[in.data];
end: INT _ Rope.Length[name];
pos: INT;
base, dec: ROPE;
baseAtom, decAtom: EXPR;
pos _ Rope.Find[name, "Sub"];
IF pos>=0 THEN {
base _ Rope.Substr[name, 0, pos];
dec _ Rope.Substr[name, pos+3, end - pos - 2];
baseAtom _ MathConstructors.MakeVariable[base];
decAtom _ MathConstructors.MakeInt[dec ! MathConstructors.badFormat => decAtom _ MathConstructors.MakeVariable[dec] ];
RETURN[MathConstructors.MakeSubscript[baseAtom, decAtom] ];
};
pos _ Rope.Find[name, "Super"];
IF pos>=0 THEN {
base _ Rope.Substr[name, 0, pos];
dec _ Rope.Substr[name, pos+5, end - pos - 4];
baseAtom _ MathConstructors.MakeVariable[base];
decAtom _ MathConstructors.MakeInt[dec ! MathConstructors.badFormat => decAtom _ MathConstructors.MakeVariable[dec] ];
RETURN[MakeSuperscript[baseAtom, decAtom] ];
};
pos _ Rope.Find[name, "Hat"];
IF pos>=0 THEN {
base _ Rope.Substr[name, 0, pos];
dec _ Rope.Substr[name, pos+3, end - pos - 2];
baseAtom _ MathConstructors.MakeVariable[base];
decAtom _ MathConstructors.MakeInt[dec ! MathConstructors.badFormat => decAtom _ MathConstructors.MakeVariable[dec] ];
RETURN[MakeHat[baseAtom, decAtom] ];
};
pos _ Rope.Find[name, "Prime"];
IF pos>=0 THEN {
base _ Rope.Substr[name, 0, pos];
baseAtom _ MathConstructors.MakeVariable[base];
RETURN[MakePrime[baseAtom] ];
};
RETURN[MathConstructors.MakeVariable[name] ];
};

LegalFirstChar: PUBLIC AC.LegalFirstCharOp = {
    RETURN[Ascii.Letter[char] ];
};

Read: PUBLIC AC.ReadOp ~ { -- old version
    RETURN[NEW[AC.ObjectRec _ [
        class: Variables,
        flavor: StructureElement,
        data: IO.GetID[in]
        ] ] ];
    };

    FromRope: PUBLIC AC.FromRopeOp = {
        stream: IO.STREAM _ IO.RIS[in];
        RETURN[ Read[stream, structure] ];
        };

    ToRope: PUBLIC AC.ToRopeOp = {
        data: VariableData _ NARROW[in.data];
        RETURN[ data ];
        };

Write: PUBLIC AC.WriteOp = {
IO.PutRope[ stream, ToRope[in] ]
}; 
<<Comparison>>
Equal: PUBLIC AC.BinaryPredicate ~ {
    firstData: VariableData _ NARROW[firstArg.data];
    secondData: VariableData _ NARROW[secondArg.data];
RETURN[ Rope.Equal[firstData, secondData] ]
}; 
<<Standard Desired Arg Structures>>
VariablesDesired: PUBLIC AC.UnaryToListOp ~ {
<<Name Variables explicitly, instead of using AC.DefaultDesiredArgStructures, so that if a Variables method found by lookup from a 
subclass, then will recast its args correctly (i.e. to )>>
RETURN[ LIST[Variables] ];
};
<<Start Code>>
VariableClass: Object _ AC.MakeClass["VariableClass", NIL, NIL];
Variables: PUBLIC Object _ AC.MakeStructure["Variables", VariableClass, NIL];

categoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ set], NIL, "category"];
groundStructureMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "groundStructure"];
shortPrintNameMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ShortPrintName], NIL, "shortPrintName"];
recastMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Recast], NIL, "recast"];
canRecastMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ CanRecast], NIL, "canRecast"];
toExprMethod: Method _ AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp _ ToExpr], NEW[AC.UnaryToListOp _ VariablesDesired], 
"toExpr"];
legalFirstCharMethod: Method _ AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp _ LegalFirstChar], NIL, 
"legalFirstChar"];
readMethod: Method _ AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp _ Read], NIL, "read"];
fromRopeMethod: Method _ AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp _ FromRope], NIL, "fromRope"];
toRopeMethod: Method _ AC.MakeMethod[ToRopeOp, TRUE, NEW[AC.ToRopeOp _ ToRope], NIL, "toRope"];
<<variableMethod: Method _ AC.MakeMethod[FromRopeOp, FALSE, NEW[AC.FromRopeOp _ FromRope], NIL, "variable"];>>
parenMethod: Method _ AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp _ AC.Copy], NIL, "paren"];
equalMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ Equal], NEW[AC.UnaryToListOp _ 
VariablesDesired], "equals"];

AC.AddMethodToClass[$category, categoryMethod, VariableClass];
AC.AddMethodToClass[$groundStructure, categoryMethod, VariableClass];
AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, VariableClass];
AC.AddMethodToClass[$recast, recastMethod, VariableClass];
AC.AddMethodToClass[$canRecast, canRecastMethod, VariableClass];
AC.AddMethodToClass[$toExpr, toExprMethod, VariableClass];
AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, VariableClass];
AC.AddMethodToClass[$read, readMethod, VariableClass];
AC.AddMethodToClass[$fromRope, fromRopeMethod, VariableClass];
AC.AddMethodToClass[$toRope, toRopeMethod, VariableClass];
<<AC.AddMethodToClass[$variable, variableMethod, VariableClass];>>
AC.AddMethodToClass[$paren, parenMethod, VariableClass];
AC.AddMethodToClass[$eqFormula, equalMethod, VariableClass];

AC.InstallStructure[Variables];


END.