'===========================================================================
' Subject: FORMULA SOLVER                    Date: Unknown Date (00:00)   
' Author:  Quinn Tyler Jackson               Code: QB, QBasic, PDS        
' Keys:    FORMULA,SOLVER                  Packet: ALGOR.ABC
'===========================================================================
'This message is to serve as a brief tutorial on the syntax of the
'FUNCTION funSolveEquation(InText$).
'
'First of all, there are standard statements:
'
'1+1
'2+3
'9*2+2
'9etc.
'
'That's fairly simple.  Then, there are more advanced operators, such as
'` and # and }.
'
'-4` = 4  That is to say, ` returns the ABSOLUTE value of x.
'
'4.5# = 4  That is to say, # returns the integer part of x.
'
'2}4 means "the square root of 4"
'3}8 means "the cube root of 4"
'
'That is, n}x returns the nth root of x.
'
'Then, there are exotic operators, such as !, which is the factorial
'symbol, which means that 5! returns 5 factorial, or 1x2x3x4x5, or 120.
'0! is 1 by definition.
'
'There are other operators:
'
'5%2 works as 5 MOD 2
'5\2 does integer division
'5~7 works as 5 XOR 7
'5&7 works as 5 AND 7
'5|7 works as 5 OR 7
'
'Some logical operators:
'
'1>2 returns 0, for false
'1<>2 returns -1, for true
'5==2 returns 0, for false
'(1<3)|=(2==1) returns -1, for IMPLIED TRUTH
'
'Parenthesis override standard BODMAS precedence.  Therefore:
'
'5*(1+2) returns 15, rather than 7.
'
'VARIABLE ASSIGNMENT:
'
'Variables are case insensitive, and can consist of:
'
'        first character must be either @ or A-Z
'        subsequent characters can be anything but spaces or
'        operators (numbers or commas are legal, as are underscores, but
'        A^TEST would be a to the power of test.
'
'Variable assignment is achieved by the statment:
'
'Variable:=equation
'
'Therefore, one could do any of the following:
'
'STATEMENT                          VALUE OF A
'---------------------------------------------
'A:=10                                10
'A:=10*2                              20
'A:=square_root[9]                     3
'
'Suppose A is equal to 10, the following would change its value to 20:
'
'A:=A*2
'
'FUNCTIONS:
'
'Functions are assigned in a similar fashion to variables.
'
'square[x]:=x^2
'
'Now, whenever a value for the x parameter is supplied, it is put into
'the formula, and the function returns the result.  Variables in function
'parameters are local to those functions and are dynamic.  That is to
'say, if x is specified as being 100 somewhere else, that doesn't affect
'the function.
'
'Therefore,
'
'square[10] would return 100.
'square[n] would return 4 if n were equal to 2
'square[1+5] would return 36 and
'square[square[2]] would return 16, and is an example of the nesting that
'is possible with functions.
'
'In the definition of the function, one can assign parameter defaults.
'That is, one can supply values for the parameters that are used as a
'default value if that parameter is not supplied in the call.
'
'area[radius,pi:(22/7)]:=pi*radius^2
'
'As it stands, suppose someone were to then call the function like this:
'
'area[10]

'This would return 31.429, using the default of 22/7 for pi, which is a
'rough approximation.  However, if a stickler were to come along and
'demand a more accurate value for pi, he could supply the missing
'parameter:
'
'area[10,3.14159]
'
'and the function would use this value for pi rather than the default.
'
'Note that when the default parameter is at the END of the paremeter list
'in the function definition, there is no need for a placeholder.  In
'other locations, one is required:
'
'area[pi:22/7,radius]:=pi*radius^2
'
'Now, to call this using the default value for pi, one would have to do
'this:
'
'area[,10]
'
'The , serves as a place holder for the missing parameter, just as in the
'BASIC statement:
'
'LOCATE ,10
'
'SOME ADVANCED TOPICS:

'Multiline statements are possible.  The result of the LAST calculation
'in the list is what funSolveEquation returns.  Therefore, one could do
'this:
'        2
'a:=1;b:=2;c:=3;a+b+c
'
'This would return the value 6.
'Functions canNOT take advantage of this feature.
'
'I leave you to figure out the rest....
'
'
'
 '     THE                                *                  RDF14.BAS
 '  JACK MACK                            *
 '  RECURSIVE                           * ***    *     *
 '   DESCENT                           *     *     * *
 '  ALGEBRAIC       ******             *     *     * *
 '   FORMULA            *               `****'   *     *
 '     AND             **      ***************************************
 '  DEFINABLE            *    *
 '  FUNCTIONS            *   *
 '   ENGINE         *****'  *         *              *
 '                         *         *                *
 '        *               *         *                  *
 '       * *             *         *    5(100-x+2b)     *   *     *
 '      *   *           *          *                    *   *     *
 '           *         *           *   *************    *   *     *
 '            *       *            *                    *   `******
 '             *     *             *       3!+35y       *         *
 '              *   *               *                  *          *
 '               * *                 *                *      `****'
 '  v1.4          *                   *              *
 '              Public Domain Code Written By Quinn Tyler Jackson
 '
 '
 '           *                        *                           *
 '            ****************************************************
 '            *ALL FUTURE VERSIONS WILL LOSE QBASIC COMPATIBILITY*
 '          ***     AND WILL ADOPT PDS/VBDOS EXTENSIONS, SO      ***
 '            *           GRAB THIS ONE WHILE YOU CAN!           *
 '            ****************************************************
 '           *                        *                           *
 '
 '
 ' DEDICATION:
 '
 ' This program is dedicated to my wife Laleh, and our three children,
 '  Ozra, Shahraam, and Arehzou, who give up a lot of their time with
 '           me so I can program at this infernal keyboard!
 '
 ' The superlative, full-featured equation solver, featuring:
 '
 '  1. STANDARD AND ADVANCED OPERATORS
 '  2. STANDARD PRECEDENCE SOLVING ALGORITHM
 '  3. ASSIGNABLE VARIABLES WITH DESCRIPTIVE NAMES
 '  4. NEW TO VERSION 1.4!!!!  Function definition!
 '
 '  I've supplied the module, you figure it out!

DECLARE FUNCTION funSolveEquation! (InText$)
DECLARE FUNCTION fqjEval! (InText$)
DECLARE FUNCTION fqjVAL! (InText$)
DECLARE FUNCTION fqjFetchVar! (VarName$)
DECLARE FUNCTION fqjInList% (OpTyp$, Op$)
DECLARE FUNCTION fqjSolveFormula! (InToken$)
DECLARE FUNCTION fqjEvalErrMsg$ ()
DECLARE FUNCTION fqjEvaluate! (InText$)
DECLARE SUB sjfParse (Word$(), Txt$, Spt$, WordNum%)
DECLARE SUB sqjApplyOp (Op$, x!, y!)
DECLARE SUB sqjAssignFun (FunctName$, Formula$, Protection%)
DECLARE SUB sqjAssignVar (VarName$, VarValue!, Protection%)
DECLARE SUB sqjDesParse (Phase%, x!)
DECLARE SUB sqjGetToken ()

CONST TRUE = -1
CONST FALSE = NOT TRUE

CONST ASSIGNMENT = ":="     ' This can be changed to suit your needs
                            ' Using a simple = is possible, since
' logical
                            ' equality is a double == with this parser,
                            ' but the PASCAL standard := is easier to
' deal
                            ' with as an assignment operator for some.

' Operator classes                PRECEDENCE
'---------------------------------------------------
CONST POWER = "^}?**>><<!`#"       ' FIRST
CONST MULTDIV = "*/\%"             ' SECOND
CONST ADDSUB = "+-"                ' THIRD
CONST LOGICAL = "&|=~<=<>==>"      ' FOURTH
CONST UNARY = "!#`"                ' UNARY operators


DIM SHARED WHITESPACE AS STRING
DIM SHARED OPERATOR AS STRING

CONST OperatorClass = 1
CONST DigitClass = 2
CONST FunctionClass = 3

CONST MAXLEVELS = 10    ' Numbers of levels of nesting allowed
CONST MAXCOMMANDS = 10  ' Number of commands per statement
CONST MAXPARAMS = 10    ' Number of parameters in a function allowed
CONST SYMMAX = 200      ' Total number of symbols allowed
CONST VARMAX = 100      ' Total number of variables allowed
CONST FUNMAX = 100      ' Total number of definable functions allowed
CONST SYSMAX = 25

TYPE SymbolTableType
        SymName AS STRING * 30  ' Name of the symbol
        SymLvl AS INTEGER       ' Level that it was assigned
        SymType AS INTEGER      ' Whether it is a variable or function
        TabPtr AS INTEGER       ' Ptr to data tables
END TYPE

' Used by SymType
CONST SymVARIABLE = 0
CONST SymFUNCTION = 1

CONST PROTECTED = -1
CONST UNPROTECTED = 1

DIM SHARED ErrorCode AS INTEGER
DIM SHARED WarningCode AS INTEGER
' Error code constants
CONST eqjDivisionByZero = 1
CONST eqjProtectedFunction = 2
CONST eqjProtectedVariable = 3
CONST eqjSymbolTableFull = 4
CONST eqjVariableTableFull = 5
CONST eqjFucntionTableFull = 6
CONST eqjMismatchedParenthesis = 7
CONST eqjUndefinedVariable = 8
CONST eqjFunctionDefaultUsed = 9
CONST eqjSyntaxError = 10

' Variables global to this module...
DIM SHARED SymTable(SYMMAX) AS SymbolTableType  ' Table holds symbols
DIM SHARED VarTable(VARMAX) AS SINGLE           ' Table hold variable DATA
DIM SHARED ParTable(FUNMAX) AS STRING   ' Table holds function parameters
DIM SHARED ForTable(FUNMAX) AS STRING   ' Table holds function formulas
DIM SHARED SysTable(SYSMAX) AS STRING

DIM SHARED SymPtr AS INTEGER    ' Points to highest symbol in table
DIM SHARED VariPtr AS INTEGER   ' Points to highest variable in table
DIM SHARED FunPtr AS INTEGER    ' Points to highest function in table
DIM SHARED LvlPtr AS INTEGER    ' Indicates the current level being
                                ' evaluated

DIM SHARED PTR(MAXLEVELS) AS INTEGER    ' Points to location in string being
                                        ' evluated
DIM SHARED EXPR$(MAXLEVELS)       ' Expression being evaluated
DIM SHARED TOKEN$(MAXLEVELS)            ' Current token being evaluated
DIM SHARED TypeToken(MAXLEVELS)         ' Type of current token

CLEAR , , 1024 * 4


CLS
' Initialize tables
nul = fqjEvaluate("")

' The following module level code is used for testing and debugging.

DO
    LvlPtr = 0
    TestDeep% = 0   ' Find all cases of TestDeep% and erase when
                    ' you modify this module to fit into your programs,
                    ' since it is only used for testing purposes
    LOCATE 4
    PRINT "Formula --->" + SPACE$(80);
    LOCATE 4, 16
    LINE INPUT Test$
    LOCATE 6
    Synch! = TIMER          'synchronize to the system timer
    DO
      Start! = TIMER
    LOOP WHILE Start! = Synch!
    PRINT "Result ---->", funSolveEquation(Test$); "                  "
    LOCATE 3
    PRINT "Time ------>"; TIMER - Start!; "                "; TAB(50); "Recursion Depth: "; TestDeep%
    LOCATE 1
    PRINT "Last error->", fqjEvalErrMsg$; "                                                      "

    VIEW PRINT 8 TO 24
    FOR i% = 1 TO SymPtr
        IF i% MOD 17 = 0 THEN
            LOCATE 8
            Sec% = TRUE
        END IF

        IF Sec% THEN
            LOCATE , 40
        END IF

        SELECT CASE SymTable(i%).SymType
            CASE SymVARIABLE
                PRINT "V: "; RTRIM$(SymTable(i%).SymName); " -->";
                SELECT CASE SymTable(i%).SymLvl
                    CASE IS > PROTECTED
                        PRINT VarTable(SymTable(i%).TabPtr); "         "
                    CASE ELSE
                        PRINT fqjFetchVar(RTRIM$(SymTable(i%).SymName)); "          "
                END SELECT
            CASE SymFUNCTION
                PRINT "F: "; RTRIM$(SymTable(i%).SymName)
        END SELECT
    NEXT i%
    Sec% = FALSE
    VIEW PRINT
LOOP


PredefinedFunctionData:

' The following functions are read into the symbol table the first
' time the function is called.  I thought they would be of some help.
' Note that they are PROTECTED.  That is to say, they cannot be
' redefined
' by the user, in the same way the user cannot redefine built-in
' functions
' in BASIC.  Add any to this list any functions that would suit your
' needs.

DATA "square_root[x]","2}x"
DATA "cube_root[x]","3}x"
DATA "rand[high:100,seed:timer]","high?seed"
'                          ^
'                          |
'         seeds with timer if no seed supplied
'
DATA "area_of_circle[r,pi:3.1415926]","pi*r^2"
'                         ^^^^^^^^^
'                             |
'                  defaults if none supplied
'                       |          |
'                       V          V
DATA "distance[x1,y1,z1:0,x2,y2,z2:0]","square_root[(x1-x2)^2+(y1-y2)^2+(z1-z2)^2]"
DATA "*END*",""

' These following system variables.  They cannot be redefined, since
' they
' return system information.  When you add a system variable to this
' list, you must also add it to the SELECT CASE VarName$ structure in
' the FUNCTION fqjFetchVar.  Here are a few to get you started.

SystemVariableData:
DATA "timer"
DATA "string_mem"
DATA "free_mem"
DATA "stack"
DATA "rnd"
DATA "*END*"

FUNCTION fqjEval (InText$)

EXPR$(LvlPtr) = UCASE$(InText$)

PTR(LvlPtr) = 1

AssignmentPtr% = INSTR(EXPR$(LvlPtr), ASSIGNMENT)
ParenPtr% = INSTR(EXPR$(LvlPtr), "[")

IF AssignmentPtr% = 0 THEN ' just do a simple evaluation
            EXPR$(LvlPtr) = EXPR$(LvlPtr)
            CALL sqjGetToken
            CALL sqjDesParse(1, x)
            fqjEval = x
ELSE                       ' assign a variable or function!
    VariableName$ = LTRIM$(RTRIM$(LEFT$(EXPR$(LvlPtr), AssignmentPtr% - 1)))

    SELECT CASE (ParenPtr% > 0) AND (ParenPtr% < AssignmentPtr%)
        CASE 0
                Valu = fqjEval(MID$(EXPR$(LvlPtr), AssignmentPtr% + 2))
                CALL sqjAssignVar(VariableName$, Valu, LvlPtr)
                fqjEval = Valu
        CASE ELSE
                Formula$ = LTRIM$(MID$(EXPR$(LvlPtr), AssignmentPtr% + 2))
                CALL sqjAssignFun(VariableName$, Formula$, UNPROTECTED)
    END SELECT
END IF
END FUNCTION

FUNCTION fqjEvalErrMsg$
' This function returns either a null string for no error, or a
' description
' of the most recent error that occurred in processing a statement.
' Errors
' terminate the process and return 0, whereas warnings continue
' functioning
' and return a value based upon defaults.

SELECT CASE ErrorCode + WarningCode
    CASE 0
        T$ = ""
    CASE eqjDivisionByZero
        T$ = "Division by zero"
    CASE eqjProtectedVariable
        T$ = "Attempt to overwrite protected variable"
    CASE eqjProtectedFunction
        T$ = "Attrmpt to redefine protected function"
    CASE eqjSymbolTableFull
        T$ = "Symbol table full"
    CASE eqjVariableTableFull
        T$ = "Variable table full"
    CASE eqjFunctionTableFull
        T$ = "Function table full"
    CASE eqjMismatchedParenthesis
        T$ = "Mismatched parenthesis encountered"
    CASE eqjUndefinedVariable
        T$ = "Undefined variable referenced -- assuming value of 0"
    CASE eqjFunctionDefaultUsed
        T$ = "Function parameter not supplied -- default assumed"
    CASE eqjSyntaxError
        T$ = "General syntax error"
END SELECT

fqjEvalErrMsg$ = T$
END FUNCTION

FUNCTION fqjEvaluate (InText$)


InText$ = LTRIM$(InText$)

' Expand unary suffixes for easier parsing
 FOR i% = 1 TO LEN(UNARY)
    Temp$ = MID$(UNARY, i%, 1)
    IF INSTR(InText$, Temp$) THEN
        TempPtr = 1
        DO
            Char$ = MID$(InText$, TempPtr, 1)
            IF fqjInList(UNARY, Char$) THEN
                InText$ = LEFT$(InText$, TempPtr) + "0" + MID$(InText$, TempPtr + 1)
            END IF
            TempPtr = TempPtr + 1
        LOOP UNTIL TempPtr >= LEN(InText$)
    END IF
NEXT i%

fqjEvaluate = fqjVAL(InText$)

END FUNCTION

FUNCTION fqjFetchVar (VarName$)

SELECT CASE VarName$
    CASE "TIMER"
        fqjFetchVar = TIMER
    CASE "STRING_MEM"
        fqjFetchVar = FRE("A")
    CASE "FREE_MEM"
        fqjFetchVar = FRE(-1)
    CASE "STACK"
        fqjFetchVar = FRE(-2)
    CASE "RND"
        fqjFetchVar = RND
    CASE ELSE
        FOR i% = SymPtr TO 1 STEP -1
'            IF SymTable(i%).SymLvl = LvlPtr OR SymTable(i%).SymLvl = 1
' THEN
                IF SymTable(i%).SymType = SymVARIABLE THEN
                    IF RTRIM$(SymTable(i%).SymName) = VarName$ THEN
                        fqjFetchVar = VarTable(SymTable(i%).TabPtr)
                            EXIT FUNCTION
                    END IF
                END IF
'            END IF
        NEXT i%
        WarningCode = eqjUndefinedVariable
END SELECT

END FUNCTION

FUNCTION fqjInList% (OpTyp$, Op$)

IF LEN(Op$) THEN
    IF INSTR(OpTyp$, Op$) > 0 THEN
        fqjInList% = TRUE
    END IF
END IF
END FUNCTION

FUNCTION fqjSolveFormula (InToken$)

DIM Param$(MAXPARAMS)
DIM Default(MAXPARAMS)
DIM ParValue$(MAXPARAMS)
DIM ParValue(MAXPARAMS)

Paren% = INSTR(InToken$, "[")
FunctName$ = LTRIM$(RTRIM$(LEFT$(InToken$, Paren% - 1)))
Par$ = MID$(InToken$, Paren% + 1, LEN(InToken$) - Paren% - 1)

FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymFUNCTION THEN
        IF RTRIM$(SymTable(i%).SymName) = FunctName$ THEN
            Formula$ = ForTable(SymTable(i%).TabPtr)
            Para$ = ParTable(SymTable(i%).TabPtr)
            CALL sjfParse(Param$(), Para$, ",", Tot%)
            FOR a% = 1 TO Tot%
                Temp$ = Param$(a%)
                TempPtr = INSTR(Temp$, ":")
                SELECT CASE TempPtr
                    CASE 0
                        ' Do nothing
                        Default(a%) = 0
                    CASE ELSE
                        Param$(a%) = LEFT$(Temp$, TempPtr - 1)
                        Default(a%) = fqjEvaluate(MID$(Temp$, TempPtr + 1))
                END SELECT
            NEXT a%
            EXIT FOR
        END IF
    END IF
NEXT i%

CALL sjfParse(ParValue$(), Par$, ",", Tot2%)

FOR i% = 1 TO Tot%

    IF ParValue$(i%) = "" THEN
        ParValue(i%) = Default(i%)
        WarningCode = eqjFunctionDefaultUsed
    ELSE
        ParValue(i%) = fqjEvaluate(ParValue$(i%))
    END IF

    ' Push the parameters to the variable stack temporarily

    IF SymPtr < SYMMAX THEN
        ' Since it wasn't, put it there
        VariPtr = VariPtr + 1
        SymPtr = SymPtr + 1

        IF VariPtr <= VARMAX THEN
            SymTable(SymPtr).SymName = Param$(i%)
            SymTable(SymPtr).SymType = SymVARIABLE
            SymTable(SymPtr).TabPtr = VariPtr
            SymTable(SymPtr).SymLvl = LvlPtr + 1
            VarTable(VariPtr) = ParValue(i%)
        ELSE
            ErrorCode = eqjVariableTableFull
        END IF
    ELSE
        ErrorCode = eqjSymbolTableFull
    END IF

NEXT i%

fqjSolveFormula = fqjEvaluate(Formula$)

VariPtr = VariPtr - Tot%    ' Clear the variable stack of
SymPtr = SymPtr - Tot%      ' variables used in parameter
END FUNCTION

FUNCTION fqjVAL (InText$)

' Initialize some variables....

IF LvlPtr < MAXLEVELS THEN
    LvlPtr = LvlPtr + 1

    DIM CommandArray$(MAXCOMMANDS)

        ' separate statement by semicolons
        CALL sjfParse(CommandArray$(), InText$, ";", Tot%)

        FOR i% = 1 TO Tot%
            fqjVAL = fqjEval(CommandArray$(i%))

            IF ErrorCode THEN
                fqjVAL = 0
                EXIT FUNCTION
            END IF
        NEXT i%

    LvlPtr = LvlPtr - 1

    ELSE
        ErrorCode = eqjNestedTooDeep
END IF
END FUNCTION

FUNCTION funSolveEquation (InText$)

STATIC Initialized%

IF Initialized% = FALSE THEN
    RESTORE PredefinedFunctionData
    DO
        READ N$, F$
        IF N$ <> "*END*" THEN
            CALL sqjAssignFun(N$, F$, PROTECTED)
        END IF
    LOOP UNTIL N$ = "*END*"

    RESTORE SystemVariableData
    DO
        READ N$
        IF N$ <> "*END*" THEN
            CALL sqjAssignVar(N$, 0, PROTECTED)
        END IF
    LOOP UNTIL N$ = "*END*"

    Initialized% = TRUE
END IF

OPERATOR = ADDSUB + MULTDIV + POWER + LOGICAL
WHITESPACE = " " + CHR$(13) + CHR$(9) + CHR$(10)

ErrorCode = 0
WarningCode = 0
LvlPtr = 0
funSolveEquation = fqjEvaluate(InText$)

END FUNCTION

SUB sjfParse (Word$(), Txt$, Spt$, WordNum%)

Text$ = Txt$
WordNum% = 0
SepLen% = LEN(Spt$)

DO
    WordNum% = WordNum% + 1
    EndWord% = INSTR(Text$, Spt$)
    IF EndWord% THEN
        Word$(WordNum%) = LEFT$(Text$, EndWord% - 1)
        Text$ = MID$(Text$, EndWord% + SepLen%)
    ELSE
        Word$(WordNum%) = Text$
        Text$ = ""
    END IF
LOOP WHILE LEN(Text$)
END SUB

SUB sqjApplyOp (Op$, x, y)

' This is the meat of the operator section, and can be modified to
' includ ANY symbol as an operator, or any two byte symbol combination.
' Any symbol added has to be added to the constant that sets its
' level of precedence.

SELECT CASE Op$
    CASE "-"    ' subtraction
        x = x - y
    CASE "+"    ' addition
        x = x + y
    CASE "*"    ' multiplication
        x = x * y
    CASE "/"    ' division
        IF y <> 0 THEN
            x = x / y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "\"    ' integer division
        IF y <> 0 THEN
            x = x \ y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "%"    ' modulo division
        IF y <> 0 THEN
            x = x MOD y
        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "^", "**"  ' exponentation
        x = x ^ y
    CASE "}"    ' the rth root of y
        IF y <> 0 THEN
            x = y ^ (1 / x)

        ELSE
            ErrorCode = eqjDivisionByZero
        END IF
    CASE "?"    ' random number from 0 to x, seed y
        RANDOMIZE y
        x = RND * x
    CASE "<<"   ' bitshift left y by x bits
        x = INT(y) * 2 ^ INT(x)
    CASE ">>"   ' bitshift right y by x bits
        x = INT(y) \ 2 ^ INT(x)
    CASE "!"    ' factorial
        Temp& = 1
        FOR i% = 1 TO x
                Temp& = Temp& * i%
        NEXT i%
        x = Temp&
    CASE "`"
        x = ABS(x)
    CASE "#"    ' absolute
        x = INT(x)
    CASE "<"    ' logical less than than
        x = x < y
    CASE "<=", "=<" ' logical less than or equal to
        x = x <= y
    CASE ">"    ' logical greater than
        x = x > y
    CASE ">=", "=>" ' logical greater than or equal to
        x = x >= y
    CASE "=="    ' logical equality
        x = x = y
    CASE "<>" ' logical inequality
        x = x <> y
    CASE "|=", "=|" ' logical implication
        x = x IMP y
    CASE "&=", "=&" ' logical equivlance
        x = x EQV y
    CASE "&"   ' bitwise AND
        x = x AND y
    CASE "|"    ' bitwise OR
        x = x OR y
    CASE "~"    ' bitwise XOR
        x = x XOR y
END SELECT
END SUB

SUB sqjAssignFun (FunctName$, Formula$, Protection%)

FunctName$ = UCASE$(FunctName$)

ParPtr% = INSTR(FunctName$, "[")
NamePart$ = LEFT$(FunctName$, ParPtr% - 1)
ParamPart$ = MID$(FunctName$, ParPtr% + 1, LEN(FunctName$) - ParPtr% - 1)

' First we see if this function is already in the list
FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymFUNCTION THEN
        IF RTRIM$(SymTable(i%).SymName) = NamePart$ THEN
            IF SymTable(i%).SymLvl <> PROTECTED THEN
                ' Since it was, just change its formula
                IF ParamPart$ <> "" THEN
                    ' Make sure it just isn't a formula
                    ' that uses empty parenthesis for the params.
                    ParTable(SymTable(i%).TabPtr) = ParamPart$
                END IF
            ELSE
                ErrorCode = eqjProtectedFunction
            END IF
            ForTable(SymTable(i%).TabPtr) = Formula$
            EXIT SUB
        END IF
    END IF
NEXT i%

IF SymPtr < SYMMAX THEN
    ' Since it wasn't, put it there
    FunPtr = FunPtr + 1
    SymPtr = SymPtr + 1

    IF FunPtr <= FUNMAX THEN
        SymTable(SymPtr).SymName = NamePart$
        SymTable(SymPtr).SymType = SymFUNCTION
        SymTable(SymPtr).SymLvl = Protection%
        SymTable(SymPtr).TabPtr = FunPtr
        ParTable(FunPtr) = ParamPart$
        ForTable(FunPtr) = Formula$
    ELSE
        ErrorCode = eqjFunctionTableFull
    END IF

ELSE
    ErrorCode = eqjSymbolTableFull
END IF
END SUB

SUB sqjAssignVar (VarName$, VarValue, Protection%)
VarName$ = UCASE$(VarName$)

' First we see if this variable is already in the list
FOR i% = 1 TO SymPtr
    IF SymTable(i%).SymType = SymVARIABLE THEN
        IF RTRIM$(SymTable(i%).SymName) = VarName$ THEN
            IF SymTable(i%).SymLvl <> PROTECTED THEN
                IF SymTable(i%).SymLvl = LvlPtr THEN
                    ' Since it was, just change its value
                    VarTable(SymTable(i%).TabPtr) = VarValue
                    EXIT SUB
                END IF
            ELSE
                ErrorCode = eqjProtectedVariable
                EXIT SUB
            END IF
        END IF
    END IF
NEXT i%

IF SymPtr < SYMMAX THEN
    ' Since it wasn't, put it there
    VariPtr = VariPtr + 1
    SymPtr = SymPtr + 1

    IF VariPtr <= VARMAX THEN
        SymTable(SymPtr).SymName = VarName$
        SymTable(SymPtr).SymType = SymVARIABLE
        SymTable(SymPtr).TabPtr = VariPtr
        SymTable(SymPtr).SymLvl = Protection%
        VarTable(VariPtr) = VarValue
    ELSE
        ErrorCode = eqjVariableTableFull
    END IF
ELSE
    ErrorCode = eqjSymbolTableFull
END IF
END SUB

SUB sqjDesParse (Phase%, x)

SHARED TestDeep%    ' This variable used for testing how deep recursion goes
' This is the central cortex of this module.
' It uses wicked recursion, so beware!  In fact, this routine is so
' recursive that unless you're a major masochist, you'd better leave it
' well enough alone!
TestDeep% = TestDeep% + 1   ' Used for testing phase only

SELECT CASE Phase%

    CASE 1
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(2, x)

        Op$ = TOKEN$(LvlPtr)

        ' The lowest level of precedence is handled by this Level.

        DO WHILE fqjInList(LOGICAL, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(2, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 2
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(3, x)
        Op$ = TOKEN$(LvlPtr)

        DO WHILE fqjInList(ADDSUB, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(3, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 3
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(4, x)

        Op$ = TOKEN$(LvlPtr)

        DO WHILE fqjInList(MULTDIV, Op$)
            CALL sqjGetToken
            CALL sqjDesParse(4, y)
            CALL sqjApplyOp(Op$, x, y)
            Op$ = TOKEN$(LvlPtr)
        LOOP

    CASE 4
        ' See if something of a higher precedence should be done first.
        CALL sqjDesParse(5, x)

        Op$ = TOKEN$(LvlPtr)

        IF fqjInList(POWER, Op$) THEN
            CALL sqjGetToken
            CALL sqjDesParse(5, y)
            CALL sqjApplyOp(Op$, x, y)
        END IF

    CASE 5
        Op$ = ""

        IF TypeToken(LvlPtr) = OperatorClass AND (fqjInList(ADDSUB, TOKEN$(LvlPtr))) THEN
            Op$ = TOKEN$(LvlPtr)
            CALL sqjGetToken
        END IF

        CALL sqjDesParse(6, x)

        ' This handles negative prefixes
        SELECT CASE Op$
            CASE "-"
                x = -x
        END SELECT

    CASE 6
        ' This level handles parentheses

        IF TOKEN$(LvlPtr) = "(" AND TypeToken(LvlPtr) = OperatorClass THEN
            CALL sqjGetToken
            CALL sqjDesParse(1, x)

            IF TOKEN$(LvlPtr) <> ")" THEN
                ErrorCode = eqjMismatchedParenthesis
            END IF

            CALL sqjGetToken
        ELSE
            SELECT CASE TypeToken(LvlPtr)
                CASE DigitClass
                    x = VAL(TOKEN$(LvlPtr))
                    CALL sqjGetToken

                CASE FunctionClass
                    x = fqjSolveFormula(TOKEN$(LvlPtr))
                    TypeToken(LvlPtr) = DigitClass
                    CALL sqjGetToken
            END SELECT
        END IF
END SELECT
END SUB

SUB sqjGetToken

TOKEN$(LvlPtr) = ""

DO WHILE fqjInList(WHITESPACE, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1))
    PTR(LvlPtr) = PTR(LvlPtr) + 1
LOOP

Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
IF Temp$ >= "0" AND Temp$ <= "9" THEN

    ' Build up a number from its digits
    DO WHILE INSTR(" ()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) = 0
        TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
        PTR(LvlPtr) = PTR(LvlPtr) + 1
    LOOP

    TypeToken(LvlPtr) = DigitClass
    EXIT SUB
END IF

IF INSTR("()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) THEN

    TypeToken(LvlPtr) = OperatorClass
    TOKEN$(LvlPtr) = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
    PTR(LvlPtr) = PTR(LvlPtr) + 1

    IF INSTR("()", TOKEN$(LvlPtr)) THEN
        EXIT SUB
    ELSE
        ' see if it's a compound operator
        IF INSTR(OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) THEN
            Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
            IF Temp$ <> "-" THEN
                TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + Temp$
                PTR(LvlPtr) = PTR(LvlPtr) + 1
            END IF
        END IF
    END IF
    EXIT SUB
END IF

Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
IF Temp$ >= "@" AND Temp$ <= "Z" THEN


    ' Build up a variable name based upon letters
    DO WHILE INSTR(" ()" + OPERATOR$, MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)) = 0
        Temp$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
        IF Temp$ <> "[" THEN
            TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + Temp$
            PTR(LvlPtr) = PTR(LvlPtr) + 1
        ELSE
            TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + "["
            DO WHILE SepPtr% <> -1
                PTR(LvlPtr) = PTR(LvlPtr) + 1
                T$ = MID$(EXPR$(LvlPtr), PTR(LvlPtr), 1)
                SELECT CASE T$
                    CASE "["
                        SepPtr% = SepPtr% + 1
                    CASE "]"
                        SepPtr% = SepPtr% - 1
                END SELECT
                TOKEN$(LvlPtr) = TOKEN$(LvlPtr) + T$
            LOOP
            PTR(LvlPtr) = PTR(LvlPtr) + 1
            TypeToken(LvlPtr) = FunctionClass
            EXIT SUB
        END IF
    LOOP

    TOKEN$(LvlPtr) = STR$(fqjFetchVar(TOKEN$(LvlPtr)))
    TypeToken(LvlPtr) = DigitClass
    EXIT SUB
END IF
END SUB