-- |
-- Module:      Math.NumberTheory.Canon
-- Copyright:   (c) 2015-2019 Frederick Schneider
-- Licence:     MIT
-- Maintainer:  Frederick Schneider <fws.nyc@gmail.com> 
-- Stability:   Provisional
--
-- A Canon is exponentation-based representation for arbitrarily massive numbers, including prime towers and hyper-expressions.

{-# LANGUAGE PatternSynonyms, ViewPatterns, RankNTypes #-}

module Math.NumberTheory.Canon (
  Canon, makeCanon, makeCanon', BareStatus(..), CanonValueType(..),
  cShowFull, cShowFullAsCode, cShowAsCode, cShowAsCodeUnf, cShowUnf,
  cMult, cDiv, cAdd, cSubtract, cExp,
  cReciprocal, (>^), (<^),
  cGCD, cLCM, cMod, cOdd, cEven, cTotient, cPhi,
  cNegative, cPositive, cIntegral, cRational, cIrrational, cPrime, cSimplified,
  cSplit, cNumerator, cDenominator,
  cCanonical, cBare, cBareStatus, cValueType, cDelve,
  cIsPrimeTower, cPrimeTowerLevel, cSuperLog, cSuperLogCmp,

  -- Hyper levels 4 through 9 for these 4 lines
  cTetration,  cPentation,  cHexation,  cHeptation,  cOctation, cNonation,
  cTetrationL, cPentationL, cHexationL, cHeptationL, cOctationL, cNonationL,
  (<^>),  (<<^>>),  (<<<^>>>),  (<<<<^>>>>),  (<<<<<^>>>>>),  (|<^>|),
  (<^^>), (<<^^>>), (<<<^^>>>), (<<<<^^>>>>), (<<<<<^^>>>>>), (|<^^>|),

  -- Operators for hyper levels 10-50
  (~^~), (~<^>~), (~<<^>>~), (~<<<^>>>~), (~<<<<^>>>>~),                                         -- 10-14
  (~|^|~), (~|<^>|~), (~|<<^>>|~), (~|<<<^>>>|~), (~|<<<<^>>>>|~),                               -- 15-19
  (~~^~~), (~~<^>~~), (~~<<^>>~~), (~~<<<^>>>~~), (~~<<<<^>>>>~~),                               -- 20-24
  (~~|^|~~), (~~|<^>|~~), (~~|<<^>>|~~), (~~|<<<^>>>|~~), (~~|<<<<^>>>>|~~),                     -- 25-29
  (~~~^~~~), (~~~<^>~~~), (~~~<<^>>~~~), (~~~<<<^>>>~~~), (~~~<<<<^>>>>~~~),                     -- 30-34
  (~~~|^|~~~), (~~~|<^>|~~~), (~~~|<<^>>|~~~), (~~~|<<<^>>>|~~~), (~~~|<<<<^>>>>|~~~),           -- 35-39
  (~~~~^~~~~), (~~~~<^>~~~~), (~~~~<<^>>~~~~), (~~~~<<<^>>>~~~~), (~~~~<<<<^>>>>~~~~),           -- 40-44
  (~~~~|^|~~~~), (~~~~|<^>|~~~~), (~~~~|<<^>>|~~~~), (~~~~|<<<^>>>|~~~~), (~~~~|<<<<^>>>>|~~~~), -- 45-49
  (~~~~~^~~~~~),                                                                                 -- FIFTY

  cAddOpLevel,  cMultOpLevel, cExpOpLevel,  cTetrOpLevel,             -- Hyper levels 1-4
  cPentOpLevel, cHexOpLevel,  cHeptOpLevel, cOctOpLevel, cNonOpLevel, -- Hyper levels 5-9
  cGetHyperList, cGetHyperOp, maxHyperOpDispLevel, maxHyperOpDelveLevel,
  cFactorSum, cConvertToSum, cMaxExpoToExpand, cFactorHorizon,
  cApplyHy, cHyperOp, cHyperExpr, cHyperExprAny, cMaxHyperOp, cMinHyperOp,
  cHyperSum, cHyperProd, cHyperExpo, cHyperSumAny,
  cHyperize, cQuasiCanonize, cQuasiCanonized, cCleanup, cGetAddends, cGetFactors, cCleanupAsNumDenPair,

  CanonElement, cGetBase, cGetExponent,
  cGetBases, cGetBasesDeep, cGetExponents, cGetElements,
  cNumDivisors, cTau, cDivisors, cNthDivisor, cWhichDivisor, cRelativelyPrime, cGetFirstNDivisors,

  cN1, c0, c1, c2, c3, c4, c5, c6, c7, c8, c9,
  CycloMap, getIntegerBasedCycloMap, showCyclo, crCycloInitMap -- Exposes cyclotomic map-related functionality from AurifCyclo
)
where

import Math.NumberTheory.Primes (primes, unPrime)
import Math.NumberTheory.Primes.Testing (isPrime)
import Data.List
import Data.Maybe (fromMaybe)
import GHC.Real (Ratio(..))
import Math.NumberTheory.Canon.Internals
import Math.NumberTheory.Canon.Additive
import Math.NumberTheory.Canon.AurifCyclo
import Math.NumberTheory.Canon.Simple (CanonConv(..))
-- import Debug.Trace (trace)

-- | CanonValueType: 3 possibilities for this GADT (integral, non-integral rational, irrational).  
--   Imaginary/complex numbers are not supported
data CanonValueType = IntC | NirC | IrrC deriving (Eq, Ord, Show)

-- | This element is a base, exponent pair.  The base is an integer and is generally prime or 0, -1.
--   The exponent is also a Canon (allowing for arbitrary nesting)
--   A Canon conceptually consists of a list of these elements.  The first member of the pair will 
--   be a Canon raised to the first power.  By doing this, we're allow for further generality
--   in the definition of a Canon. 
type CanonElement = (Canon, Canon)

-- | GCR_ stands for Generalized Canonical Representation.  This is internal to Canon.
type GCR_  = [GCRE_]

type GCRE_ = (Integer, Canon)

-- | Canon: GADT for either Bare (Integer) or some variation of a Can(onical) form (see CanonValueType).
data Canon = Bare Integer BareStatus | Can GCR_ CanonValueType | HX Canon [Canon] CanonValueType

-- | BareStatus: A "Bare Simp" number means a prime number, +/-1 or 0.  The code must set the flag properly
--               A "Bare NSim" number is an Integer that has not been checked (to see if it can be factored).
data BareStatus = Simp | NSim deriving (Eq, Ord, Show)

-- | Create a Canon from an Integer.  This may involve expensive factorization.
makeCanon :: Integer -> Canon
makeCanon n = fst $ makeCanon' n

-- | Create a Canon from an Integer.  Also return True if the number is fully factored
makeCanon' :: Integer -> (Canon, Bool)
makeCanon' n = (f cr, ff)
               where f POne                  = Bare 1 Simp
                     f c    | null cs && eh == 1
                                             = if superLogI bh > superLogICutoff -- because we assume bare < hyper expr
                                               then error "Lib limitation: Can't handle massive bare numbers > cutoff"
                                               else Bare bh (if ff then Simp else NSim)
                            | otherwise      = Can g (gcrCVT g)
                                               where (bh,eh):cs = c
                                                     g          = map (\(p,e) -> (p, makeCanon e)) c
                                                     -- (can't be reduced any further)
                     (cr, ff)                = crFromI n -- 2nd param, the totally factored flag not used at this time 

-- | Convert from underlying canonical rep. to Canon.  The 2nd param indicates whether or not to force factorization/simplification.
crToC :: CR_ -> Bool -> Canon
crToC POne _                  = Bare 1              Simp
crToC c    _ | crSimplified c = Bare (fst $ head c) Simp -- a little ugly
             | otherwise      = Can g (gcrCVT g)
                                where g          = map (\(p,e) -> (p, makeCanon e)) c

-- | Instances for Canon
instance Eq Canon where
  x == y = cEq x y

-- | Internal value that corresponds with ~~~~~^~~~~~ (level 50 hyperoperation)
maxHyperOpDispLevel :: Integer
maxHyperOpDispLevel = 50;

-- | Max hyper operaton level when converting to canonical form (for the sake of combining and reducing terms)
maxHyperOpDelveLevel :: Canon
maxHyperOpDelveLevel = makeCanon 100;

-- These must correspond with the built-in and defined operators (from addition through hexation), except for ^
hyperOpStrings :: [String] -- ensure this is consistent with small canons / maxHyperOpDisplayLevel
hyperOpStrings = [
  "", "+", "*", "^", "<^>", "<<^>>", "<<<^>>>", "<<<<^>>>>", "<<<<<^>>>>>", "|<^>|",             -- 0-9
  "~^~", "~<^>~", "~<<^>>~", "~<<<^>>>~", "~<<<<^>>>>~",                                         -- 10-14
  "~|^|~", "~|<^>|~", "~|<<^>>|~", "~|<<<^>>>|~", "~|<<<<^>>>>|~",                               -- 15-19
  "~~^~~", "~~<^>~~", "~~<<^>>~~", "~~<<<^>>>~~", "~~<<<<^>>>>~~",                               -- 20-24
  "~~|^|~~", "~~|<^>|~~", "~~|<<^>>|~~", "~~|<<<^>>>|~~", "~~|<<<<^>>>>|~~",                     -- 25-29
  "~~~^~~~", "~~~<^>~~~", "~~~<<^>>~~~", "~~~<<<^>>>~~~", "~~~<<<<^>>>>~~~",                     -- 30-34
  "~~~|^|~~~", "~~~|<^>|~~~", "~~~|<<^>>|~~~", "~~~|<<<^>>>|~~~", "~~~|<<<<^>>>>|~~~",           -- 35-39
  "~~~~^~~~~", "~~~~<^>~~~~", "~~~~<<^>>~~~~", "~~~~<<<^>>>~~~~", "~~~~<<<<^>>>>~~~~",           -- 40-44
  "~~~~|^|~~~~", "~~~~|<^>|~~~~", "~~~~|<<^>>|~~~~", "~~~~|<<<^>>>|~~~~", "~~~~|<<<<^>>>>|~~~~", -- 45-49
  "~~~~~^~~~~~"]                                                                                 -- FIFTY 

smallCanons :: [Canon]
smallCanons = map (\n -> makeCanon n) [0..maxHyperOpDispLevel]

-- | Levels starting with 1 in the hyperoperation hierarchy
cAddOpLevel, cMultOpLevel, cExpOpLevel, cTetrOpLevel,
  cPentOpLevel, cHexOpLevel, cHeptOpLevel, cOctOpLevel, cNonOpLevel :: Canon

(_: cAddOpLevel  : cMultOpLevel : cExpOpLevel  : cTetrOpLevel :
    cPentOpLevel : cHexOpLevel  : cHeptOpLevel : cOctOpLevel  : cNonOpLevel : _) = smallCanons

-- | Various show functions: cShowFull - fully expand large primes and composites in Canon expression.  
--   "Unf" in name means don't factor unless it's too big too display
--    "AsCode" in name means you can copy and paste the results and execute them. 
cShowFull, cShowFullAsCode, cShowAsCode, cShowAsCodeUnf, cShowUnf, cShowForEqChk :: Canon -> String
cShowFull       = cShow True  False False False
cShowFullAsCode = cShow True  True  False False
cShowAsCode     = cShow False True  False False  -- displays hyperexpr wrapped in parens
cShowAsCodeUnf  = cShow False True  True  False
cShowUnf        = cShow False False True  False
cShowForEqChk   = cShow False False False True

instance Show Canon where
  -- If debugging ... show = cShowAsCode -- so can it be pasted back in and run.  Leave this way? Maybe default should not use { } and use use <^
  show = cShow False False False False -- 1st bool = b: if True, full display of all integers, 
                                       -- 2nd bool = p: if True, all parens for most hyperexprs,
                                       -- 3rd bool = i: if True, display unfactored integers where possible
                                       -- 4th bool = m: if True, when a hyOp is a sum or product, sort it, when to check for equality)
  -- Note: If parens flag is true and as long as the hyperOp doesn't exceed the max display level, 
  --       you can copy and paste the expression back in as input

cShow :: Bool -> Bool -> Bool -> Bool -> Canon -> String
cShow b _ i _ (Bare n NSim)
  = showI b n False i  -- False means composite
cShow b _ i _ (Bare n Simp)
  = showI b n True i -- True means prime (or -1, 0, 1)
cShow b p i m (HX h l _)
  | p && (cHyperExprAny h || h > maxSmallC)
              = "cApplyHy " ++ showH h ++ " [" ++ (concat $ intersperse ", " $ map (cShow b p i m) cl) ++ "] True" -- fmt as fcn call!
  | otherwise = fmt1 (head cl) ++ s' (tail cl)
  where cl      | h == cAddOpLevel && any cNegative l = pR ++ nR -- put the negatives in back
                | otherwise                           = l
                where (pR, nR) = partition cPositive l -- there should always be at least one of each.  The sum must be positive
        fmt1 hD | not (cHyperExpr hD) && h == cMultOpLevel = cShow b p i m hD
                | otherwise                                = showH hD
        showH c | h == cAddOpLevel || cBare c || (i && canConvToI c) = rep -- showH small helper function for clarity of expression
                | (not p) && cHyperExpr c                            = "{" ++ rep ++ "}"
                | otherwise                                          = "(" ++ rep ++ ")"
                where rep = cShow b p i m c
        fmtHy f | f                                = "-" -- indicates a negative sign, flip a plus to minus
                | cHyperExprAny h || h > maxSmallC = fmt' h
                | p && h == cExpOpLevel            = "<^"
                | otherwise                        = hyperOpStrings !! (fromInteger $ cToI h) -- and write cApplyHy for exp
                where fmt' c | (not p) && cHyperExpr c = "<H{" ++ rep' ++ "}>"
                             | otherwise               = "<H(" ++ rep ++ ")>"
                             where rep  = cShow b p i m c
                                   rep' | not m                         = rep
                                        | cGetHyperOp c == cAddOpLevel  = cShow b p i m (fst $ cConvertToSum c)
                                        | cGetHyperOp c == cMultOpLevel = cShow b p i m c
                                        | otherwise                     = rep

        s' (x:xs) = " " ++ fmtHy f' ++ " " ++ showH (if f' then (negate x) else x) ++ s' xs
                    where f' = h == cAddOpLevel && cNegative x
        s' _      = ""
        maxSmallC = smallCanons !! (fromInteger $ maxHyperOpDispLevel)
cShow b p i m c
  | denom == c1 = s numer False
  | otherwise   = s numer True ++ " / " ++ s denom True
  where (numer, denom)      = cSplit c
        s (Bare n f) _ = cShow b p i m (Bare n f)
        s v          w | i && canConvToI v = show $ cToI v -- if the Canonical is not too big, convert it back to integer (when i flag is true)
                       | w                 = "(" ++ catList ++ ")"
                       | otherwise = catList               -- w = with(out) parens
                       where catList        =   concat $ intersperse " * " $ map sE $ gcr' $ cToGCR v
                             gcr' g@(x:y:gs)| fst x == -1 && snd y == c1 = ((fst x * fst y, snd y) : gs)
                                            | otherwise                  = g -- above: display (-1,1), (2,1) as -2
                             gcr' g         = g
                             sE (p', e)     | ptLevel > 2 = sp ++ " <^> " ++ s ptLevel True -- sE means show element
                                            | otherwise   = case e of
                                                            Bare 1 _ -> sp
                                                            Bare _ _ -> sp ++ expOp ++ se
                                                            _        -> sp ++ " " ++ expOp ++ " (" ++ se ++ ")"
                                            where ptLevel = cPrimeTowerLevelI e p' 1
                                                  sp      = showI b p' (isPrime p' || p' == -1) i
                                                  se      = cShow b p i m e
                             expOp          = if p then "<^" else "^"

canConvToI :: Canon -> Bool
canConvToI c = not $ cSuperLogGT (fst $ cSuperLog c) cSuperLogCutoff

-- Allow via first parameter to suppress full printing of massive integers and just indicate an "x-digit number"
showI :: Bool -> Integer -> Bool -> Bool -> String
showI b n pOrC i | i         = show n -- just as is
                 | not pOrC  = "[" ++ txt ++ "]" -- composites go in brackets (either number or digit count)
                 | truncFlag = "(" ++ txt ++ ")" -- if prime but tooBig, put in parens
                 | otherwise = txt             -- just the number
               where txt          = if truncFlag
                                    then (show $ nd n) ++ "-digit " ++ (if pOrC then "prime" else "composite")
                                    else show n
                     truncFlag    = (not b) && n > integerShowCutoff
                     nd :: Integer -> Integer
                     nd n'        = nd' n' 1 -- Count digits 1 by 1.  ToDo: Optimize
                                    where nd' n'' ct = if (n'' >= 10) then nd' (div n'' 10) (ct + 1)
                                                                      else ct

instance Enum Canon where
  toEnum   n = makeCanon $ fromIntegral n
  fromEnum c = fromIntegral $ cToI c

instance Ord Canon where
  compare x y = cCmp x y

instance Real Canon where
  toRational c | cIrrational c = toRational $ cToD c
               | otherwise     = (cToI $ cNumerator c) :% (cToI $ cDenominator c)

instance Integral Canon where
  toInteger c | cIntegral c = cToI c
              | otherwise   = floor $ cToD c
  quotRem n m = fst $ cQuotRem n m crCycloInitMap  --  tries to use map but ultimately throws it away 
  mod n m     = cMod n m

instance Fractional Canon where
  fromRational (n :% d) = makeCanon n / makeCanon d
  (/) x y               = fst $ cDiv x y crCycloInitMap -- tries to use map but ultimately throws it away

instance Num Canon where -- tries to use the map but ultimately throws it away when using +, - and * operators
  fromInteger n = makeCanon n
  x + y         = fst $ cAdd      x y crCycloInitMap
  x - y         = fst $ cSubtract x y crCycloInitMap
  x * y         = fst $ cMult     x y crCycloInitMap

  negate x      = cNegate x
  abs x         = cAbs    x
  signum x      = cSignum x

-- | Checks if the Canon is Canonical, a more complex expression.
cCanonical :: Canon -> Bool
cCanonical (Can _ _) = True
cCanonical _         = False

-- | Checks if the Canon just a "Bare" Integer.
cBare :: Canon -> Bool
cBare (Bare _ _) = True
cBare _          = False

-- | Returns the status for "Bare" numbers.
cBareStatus :: Canon -> BareStatus
cBareStatus (Bare _ b) = b
cBareStatus _          = error "cBareStatus: Can only checked for 'Bare' Canons"

-- | Return the CanonValueType (Integral, etc).
cValueType :: Canon -> CanonValueType
cValueType (Bare _ _) = IntC
cValueType (Can  _ v) = v
cValueType (HX _ _ v) = v

-- | Split a Canon into the numerator and denominator.
cSplit :: Canon -> (Canon, Canon)
cSplit c = (cNumerator c, cDenominator c)

-- | Check for equality.
cEq :: Canon -> Canon -> Bool
-- cEq a b | trace ("cEq: (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined
cEq (Bare x _ )   (Bare y _ )      = x == y
cEq (Bare _ Simp) (Can _ _ )       = False
cEq (Can _ _ )    (Bare _ Simp)    = False
cEq a@(HX _ _ _)  b@(HX _ _ _)     | signum a /= signum b = False
                                   | h1 /= h2             = False -- Confirm: Always true?
                                   | h1 < cExpOpLevel     = cmpHyLists cL1 cL2
                                   | otherwise            = cShowForEqChk a' == cShowForEqChk b' -- Note: Kludge for deeply nested numbers
                                   where (cL1:cL2:_) = map cGetHyperList [a',b']
                                         -- Quadratic compare: necessary to avoid sorting 
                                         -- which can be problematic and expensive for hyperoperations
                                         cmpHyLists x y | length x /= length y = False
                                                        | otherwise            = c' x y []
                                         c' l@(x:xs) (y:ys) bN | x == y    = c' xs (bN++ys) []
                                                               | otherwise = c' l  ys       (bN ++ [y])
                                         c' (_:_)    _      _  = False
                                         c' _        y      _  = null y
                                         -- "Endless" looping! (a', b') = (cQuasiCanonize $ fst $ cConvertToSum a, cQuasiCanonize $ fst $ cConvertToSum b)
                                         (a', b')              = (fst $ cConvertToSum a, fst $ cConvertToSum b) -- ToDo: make this more robust?
                                         (h1, h2)              = (cGetHyperOp a', cGetHyperOp b')

cEq hx@(HX _ _ _) b                | cBare b || cMaxHyperOp hx >= cPentOpLevel
                                               = False
                                   | otherwise = cValueType hx == cValueType b && cGetBases hx == cGetBases b
                                                 && (cSuperLogCmp (fst $ cSuperLog hx) (fst $ cSuperLog b) == EQ)
                                                  -- ToDo: Verify this is robust
cEq a             hx@(HX _ _ _)    = cEq hx a
cEq (Bare x NSim) y                | cValueType y /= IntC = False
                                   | otherwise                 = x == cToI y
cEq x             y@(Bare _ NSim) = cEq y x
cEq (Can x a )    (Can y b)       = if a /= b then False else gcrEqCheck x y

-- | Check if a Canon is integral and odd/even, respectively.  Note: Return False for both if the Canon is not integral.
--   See CanonValueType for possible cases.
cOdd, cEven :: Canon -> Bool
cOdd  = cMod2Check 1 gcrOdd
cEven = cMod2Check 0 gcrEven

cMod2Check :: Int -> (GCR_ -> Bool) -> Canon -> Bool
cMod2Check m _ (Bare x _)       = mod x 2 == toInteger m
cMod2Check _ f (Can c IntC)     = f c
cMod2Check m _ (HX PoA cL IntC) = mod (sum $ map (\c -> mod c c2) cL) 2 == smallCanons !! m -- match add "operator"
cMod2Check m _ (HX PoM cL IntC) = mod (product $ map (\c -> mod c c2) cL) 2 == smallCanons !! m -- match on mult "operator"
cMod2Check m _ (HX _   cL IntC) = mod (head cL) 2 == smallCanons !! m
cMod2Check _ _ _                = False

-- | GCD and LCM functions for Canon
cGCD, cLCM :: Canon -> Canon -> Canon
cGCD x y | cHyperExprAny x || cHyperExprAny y = head $ cMultiplicative x y Gcd
         | otherwise                          = cLGApply gcrGCD x y
cLCM x y | cHyperExprAny x || cHyperExprAny y = head $ cMultiplicative x y Lcm
         | otherwise                          = cLGApply gcrLCM x y

-- | Compare Function (cHyperCmp is internal)
cCmp, cCmpH, cCmp' :: Canon -> Canon -> Ordering
-- cCmp a b | trace ("cCmp: (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined
cCmp (Bare x _)      (Bare y _)   = compare x y
cCmp x@(Can _ _)     y@(Bare _ _) = gcrCmp (cToGCR x) (cToGCR y)
cCmp x@(Bare _ _)    y@(Can _ _)  = gcrCmp (cToGCR x) (cToGCR y)
cCmp x@(Can _ _)     y@(Can _ _)  = gcrCmp (cToGCR x) (cToGCR y)
cCmp x@(HX _ _ _)    (Bare _ _)   = if signum x == c1 then GT else LT -- Hyperexpr always has greater magnitude
cCmp (Bare _ _)      y@(HX _ _ _) = if signum y == c1 then LT else GT -- Inverse of above
cCmp x               y            | signum y == c1 && signum x /= c1   = LT
                                  | signum x == c1 && signum y /= c1   = GT
                                  | signum x == cN1 && signum y == cN1 = cCmp (abs y) (abs x)
                                  | otherwise                          = cCmpH x y

-- At this point, we are comparing positive hyper expressions.  Should not be called directly.
-- cCmpH a b | trace ("cCmpH: (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined -- Interferes with show
cCmpH x@(Can _ _)     y@(HX _ _ _)         | not (cSuperLogGT (fst $ cSuperLog x) cSuperLogCutoff) = LT
                                           | otherwise                                             = cCmpH (cConvertToHyperExpr x) y
cCmpH x@(HX _ _ _)    y@(Can _ _)          | not (cSuperLogGT (fst $ cSuperLog y) cSuperLogCutoff) = GT
                                           | otherwise                                             = cCmpH x (cConvertToHyperExpr y)
cCmpH a@(HX h1 cL1 _) b@(HX h2 cL2 _)
    | a == b                              = EQ
    | (h1 == cAddOpLevel || h2 == cAddOpLevel) && aS /= a
                                          = cCmp aS bS
    | (h1 == cMultOpLevel || h2 == cMultOpLevel) && aR /= a -- we don't always take this.  Otherwise, we can have an endless loop
                                          = cCmp aR bR
    | mOa > mOb + 1                       = GT
    | mOb > mOa + 1                       = LT
    | mOa > cHexOpLevel && mOb > cHexOpLevel && candPred a && candPred b  -- To Verify: do the bases have to match
                                          = compare (tryLiftTail a) (tryLiftTail b)
    | flag1Less                           = cba
    | flag1More                           = cab
    | mP && exprDomination a b            = GT
    | mP && exprDomination b a            = LT
    | bP && lA' > lB'                     = GT -- ToDo: Further investigate if there are any exceptions to this?
    | bP && lA' < lB'                     = LT
    | h1 > cMultOpLevel && h1 == h2 && dominates cL1 cL2 True
                                          = GT
    | h2 > cMultOpLevel && h1 >  h2 && dominates cL1 cL2 False
                                          = GT
    | h1 > cMultOpLevel && h2 == h1 && dominates cL2 cL1 True
                                          = LT
    | h1 > cMultOpLevel && h2 >  h1 && dominates cL2 cL1 False
                                          = LT
    | bP                                  = case compare (last cL1) (last cL2) of  --For large enough hyOps, last entry says which is >
                                            EQ -> compare (reduce a) (reduce b)  -- If equal try compare lists with all but last members 
                                            cmp -> cmp
    | otherwise                           = cCmp' a b
    where (mOa, mOb, bP)         = (cMaxHyperOp a, cMaxHyperOp b, h1 == h2 && h1 > cPentOpLevel)
          mP                     = mOa >= hyperOpCutoff && mOb >= hyperOpCutoff
          reduce c               | len == 0  = error "Logic error in comparison: rFmt must have a hyper list with at least one entry"
                                 | len == 1  = head l
                                 | otherwise = simpleHX (cGetHyperOp c) (init l) -- create new hyper expr with all but the last entry
                                 where (l, len) = (cGetHyperList c, length l)
          (flag1Less, cba)       = (h1 >= cPentOpLevel && h2 == h1 + 1, comp1Diff b a False)  -- ToDo: Verify it handles embedded HEs.
          (flag1More, cab)       = (h2 >= cPentOpLevel && h1 == h2 + 1, comp1Diff a b True)

          (hLa, hLb, lHa, lHb)   = (cGetHyperList a, cGetHyperList b, length hLa, length hLb)
          (lA', lB') | lHa > lHb = (cApplyHy h1 (drop lD hLa) True, last hLb)
                     | lHa < lHb = (last hLb,                       cApplyHy h2 (drop lD hLb) True)
                     | otherwise = (last hLa,                       last hLb)
                     where lD = abs (lHa - lHb)
          -- Modify this to see if there are any terms in common
          -- ((aS, bS), (aR, bR))   = (reduceSums a b, reduceProds a b) -- can cause endless looping
          ((aS, bS), (_,aR,bR))  = (reduceSums a b, simpleReduce a b False)

cCmpH x               y                    = error $ errorStrg -- We should never get to this spot in the code
                                             where errorStrg = "Logic error in cCmpH in program flow: " ++ show x ++ " vs. " ++ show y ++ "."

{- Two known cases that will cause loops.
   compare (3 * ((7 <^> 5) * (5 <<^>> 8 <<^>> 6)) + 17 <<^>> 5 + 4) (3 * ((7 <^> 4) * (5 <<^>> 6 <<^>> 8)) + 2)
   compare (3 * 5 <<^>> 8 <<^>> 6 + 2) ( 3 * 5 <<^>> 6 <<^>> 8 + 4)
-}

reduceSums :: Canon -> Canon -> (Canon, Canon)
reduceSums a b = (sum aS', negate $ sum bS')
                 where (aS', bS') = partition cPositive (cGetAddends diff) -- low level diff, no infernal looping!
                       diff       = combineSum $ simpleHX cAddOpLevel (cGetAddends a ++ (map cNegate $ cGetAddends b))

reduceProds :: Canon -> Canon -> (Canon, Canon)
-- reduceProds a b | trace ("reduceProds: (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined
reduceProds a b = (aR', bR')
                  where (_:aR':bR':_) = cMultiplicative a b Gcd

dominates :: [Canon] -> [Canon] -> Bool -> Bool
-- dominates a b _ | trace ("dominates: (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined
dominates a' b' gtf    = d' a' b' (0 :: Integer) -- gtf indicates the underlying hyper operation level was greater in a than b
  where d' (x:xs) (y:ys) pc | x < y     = False
                            | otherwise = d' xs ys (pc + if x > y then 1 else 0)
        d' _      (_:_)  _              = False
        d' (_:_)  _      _              = True
        d' _      _      pc             = gtf || pc > 0 -- if flag set or positive ct, it dominates

-- a has a hyper operation in its base one more than b's base.  We are dealing with positive hyper expressions here
-- ToDo: what if there are hyper expressions embedded
comp1Diff :: Canon -> Canon -> Bool -> Ordering
comp1Diff a' b' cF = if cF then r else flp r -- EQ in this context means inconclusive
  where hLA@(aB:aE:_) = cGetHyperList a'
        (lA2, lB2) = (length hLA, makeCanon $ toInteger $ length $ cGetHyperList b')
        flp r'     = case r' of
                     GT -> LT
                     LT -> GT
                     c  -> c

        r          | lA2 < ml6 = LT -- larger embedded hexation in pentated b
                   | lA2 > 2   = GT -- tower for the larger hyperoperation. e.g. 6 <<<^>>> 7 <<<^>>> 3
                                    -- would be larger than any pentation tower
                                    -- The above is equivalent to: 6 <<^>> (6 <<<^>>> 7 <<<^>>> 3 - 1)
                   | aE > lB2  = GT -- The "exponent" for the larger is greater than the length of the smaller
                                    -- For instance: 5 <<^>> 7 <<^>> 8 would be less than 6 <<<^>>> 4.
                   | aE < lB2  = LT
                     -- e.g. Downgrade a =  6 [6,3] to 5 [6,6,6] and compare it to b (aE == lB)
                   | otherwise = compare (simpleHX (cGetHyperOp b') (replicate (fromInteger $ cToI aE) aB)) b'

        ml6        = maxHypLen cHexOpLevel b'

-- ToDo:adapt this so it finds the maximum chunk?
-- maximum length of list based on hyper operation. Assumed to be the maximum in the expression
maxHypLen :: Canon -> Canon -> Int
maxHypLen h c = mhl c 0
                where mhl c' mx | cHyperExprAny c' = if cGetHyperOp c' == h
                                                     then max mx (length cL)
                                                     else (foldl1 max $ map (maxHypLen h) cL)
                                | otherwise        = 0
                                where cL = cGetHyperList c'
hyperOpCutoff :: Canon
hyperOpCutoff = cTetrOpLevel

-- unsigned values are assumed.  This checks if s is less than d or less than a subexpression of d
exprDomination :: Canon -> Canon -> Bool
-- exprDomination d s | trace ("exprDomination: (s=" ++ show s ++ ") and (d=" ++ show d ++ ")") False = undefined
exprDomination d s = eD d s False -- The flag indicates what whether we are already embedded or not in the structure

eD :: Canon -> Canon -> Bool -> Bool
-- eD d' s' b' | trace ("eD: (d' = " ++ show d' ++ ", s' = " ++ show s' ++ ", b' = " ++ show b' ++ ")") False = undefined
eD d' s' b' | notBoth s' d' && not b'     = s' < d'   -- first level check
            | notBoth s' d' && b'         = s' <= d'
            | s' == d'                    = b' -- equality shows domination if at an inner level 
            | s' /= sRp                   = eD dRp sRp b'
            | rC                          = rC
            | b' && (compare d' s' /= LT) = True -- (if inside the nested expression).  Could be expensive.
            | otherwise                   = False
            -- at last check if individual items in list dominate
            where notBoth x y = not (cMaxHyperOp x >= hyperOpCutoff  && cMaxHyperOp y >= hyperOpCutoff)
                  (sRs, dRs) = if b' && (cHyperSum s'   || cHyperSum d')   then reduceSums s' d' else (s', d')
                  (sRp, dRp) = if b' && (cHyperProd sRs || cHyperProd dRs) then reduceProds sRs dRs else (sRs, dRs)
                  rC         = any (\e -> eD e s' False || eD e s' True) $ cGetHyperList d'

-- Fall back comparison function.  If the numbers are small enough and sufficiently close, 
-- they will be converted back to integers and compared.  We are dealing with positive hyper expressions here.
-- cCmp' a b | trace ("cCmp': (a=" ++ show a ++ ") and (b=" ++ show b ++ ")") False = undefined
cCmp' a b | aH == cPentOpLevel && bH == cTetrOpLevel && any cHyperExprAny (cGetHyperList b) && cSuperLogGT slb sla
                                 = LT -- pentation vs. nested tetration
          | bH == cPentOpLevel && aH == cTetrOpLevel && any cHyperExprAny (cGetHyperList a) && cSuperLogGT sla slb
                                 = GT -- nested tetration vs. pentation
          | aH >= cPentOpLevel && aH > bH -- Note: comp1Diff handles the case where aH = bH + 1
                                 = GT
          | bH >= cPentOpLevel && bH > aH
                                 = LT
          | aH <= cTetrOpLevel && bH <= cTetrOpLevel && cSuperLogGT sla slb
                                 = GT
          | aH <= cTetrOpLevel && bH <= cTetrOpLevel && cSuperLogGT slb sla
                                 = LT
          | bBh == cPentOpLevel && aBh == bBh
                                 = pCmp a b
          | aBh == cAddOpLevel || bBh == cAddOpLevel || cmpAddends /= EQ
                                 = cmpAddends
          | aBh == cMultOpLevel || bBh == cMultOpLevel || cmpFactors /= EQ
                                 = cmpFactors
          | aBh == bBh && aBh > cMultOpLevel && cmpHyperList /= EQ
                                 = cmpHyperList -- ToDo:  
          -- Note: super log is only practical <= level 10
          | cSuperLogGT sla slb  = GT -- These two checks will handle cases like: compare (5 <^> 8 <<^>> 6) (17 <<^>> 5)
          | cSuperLogGT slb sla  = LT
          | otherwise            = error $ "Unable to accurately compare a = " ++ show a ++ " and b = " ++ show b
          where (aH, bH)     = (cMaxHyperOp a, cMaxHyperOp b)
                (aBh, bBh)   = (cGetHyperOp a, cGetHyperOp b)
                (sla, slb)   = (fst $ cSuperLog a, fst $ cSuperLog b)
                cmpList f    = compare (sort $ f a) (sort $ f b)
                cmpAddends   = cmpList cGetAddends
                cmpFactors   = cmpList cGetFactors
                cmpHyperList = cmpList cGetHyperList

-- Only for pentation check
pCmp :: Canon -> Canon -> Ordering
pCmp a b | pA > pB = GT
         | pA < pB = LT
         | otherwise   = cSuperLogCmp sla' slb'
         where pTail x  = cApplyHy aBh (tail $ cGetHyperList x) False
               (pA, pB) = (pTail a, pTail b)
               sl x t   = fst $ cSuperLog $ simpleHX aBh (x:[t - m + 2])
               sla'     = sl (head $ cGetHyperList a) pA
               slb'     = sl (head $ cGetHyperList b) pB
               m        = min pA pB
               aBh      = cGetHyperOp a

-- | wrapper to create apply a hyperoperation to a list 
cApplyHy :: Canon -> [Canon] -> Bool -> Canon -- the Bool says whether to raise an error for a null list
cApplyHy ho a b = if length a == 0 && b
                 then error "cApplyHy: Null list passed. Specified as fatal condition by calling fcn"
                 else fst (cHyperOp ho a crCycloInitMap) -- This function will do any simplifications 

-- | Find the maximum hyperoperation embedded in a Canon
cMaxHyperOp :: Canon -> Canon
cMaxHyperOp = findSigHyOp max

-- | Find the minimum hyperoperation embedded in a Canon.  (If not at all, return zer0
cMinHyperOp :: Canon -> Canon
cMinHyperOp = findSigHyOp mHo
              where mHo a b | a == b    = a
                            | a == c0   = b
                            | b == c0   = a
                            | otherwise = min a b

-- Can be called with f = max or mHo
findSigHyOp :: (Canon -> Canon -> Canon) -> Canon -> Canon
findSigHyOp _ (Bare _ _)  = c0
findSigHyOp f (Can g _)   = foldl1 f $ map runningSig g
                            where runningSig (_, e) | e == c1   = cMultOpLevel
                                                    | otherwise = f cExpOpLevel (findSigHyOp f e) -- at least exp
findSigHyOp f (HX h hl _) = f h (foldl1 f $ map (findSigHyOp f) hl)

-- | QuotRem Function
cQuotRem :: Canon -> Canon -> CycloMap -> ((Canon, Canon), CycloMap)
cQuotRem x y m | cHyperExprAny x || cHyperExprAny y = ((hQ, c0), mR) -- ToDo: Handle non-zero modulus, say if x is a sum.
               | cIntegral x && cIntegral y         = ((gcrToC q', md'), m'')
               | otherwise                          = error "cQuotRem: Must both parameters must be integral."
               where (q', md', m'') = case gcrDiv (cToGCR x) gy of
                                      Left  _        -> (q,        md, m')
                                      Right quotient -> (quotient, c0, m)
                                      where gy       = cToGCR y
                                            md       = cMod x y
                                            q        = gcrDivStrict (cToGCR d) gy  -- equivalent to: (x - mod x y) / y.
                                            (d, m')  = cSubtract x md m
                     (hQ, mR)       = cDiv x y m

-- | Mod function
cMod :: Canon -> Canon -> Canon
-- cMod c m | trace ("cMod: (c=" ++ show c ++ "), m=" ++ show m ++ ")") False = undefined
cMod c m | not (cIntegral c) || not (cIntegral m)
                         = error "cMod: Must both parameters must be integral"
         | c < m         = c
         | m == cGCD c m = c0 -- c is a multiple of m. If m is a hyper expr, this all we can do for now
         | otherwise     = makeCanon $ cModI c (cToI m)

-- | Mod function between a Canon and integer.  This is usually called by cMod
cModI :: Canon -> Integer -> Integer
-- cModI c m | trace ("cModI: (c=" ++ show c ++ "), m=" ++ show m ++ ")") False = undefined
cModI _   0       = error "cModI: Divide by zero error when computing n mod 0"
cModI _   1       = 0
cModI _   (-1)    = 0
cModI Pc1 PIntPos = 1
cModI Pc0 _       = 0
cModI c   m       | cn && mn         = -1 * cma
                  | (cn && not mn) ||
                    (mn && not cn)   = signum m * ((abs m) - cma)
                  | otherwise        = cModI' c m
                  where (cn, mn, cma)             = (cNegative c, m < 0, cModI' (abs c) (abs m))
                        -- cModI' b m' | trace ("cModI' (b=" ++ show b ++ "), m'=" ++ show m' ++ ")") False = undefined
                        cModI' (Bare n _)      m' = mod n m'
                        cModI' (Can c' _)      m' = if c == makeCanon m' then 0 else mod (product $ map pM c') m'
                                                    where pM (b,e) = if (mod b m' == 0) then 0 else (pmI b (mmt e) m')
                                                          mmt e = cModI e (totient m') -- optimization
                        cModI' (HX PoA cL _)   m' = mod (sum $ map (\ce -> cModI ce m') cL) m'
                        cModI' h@(HX PoM cL _) m' = if (cModI (product $ cGetBases h) m' == 0)
                                                    then 0 -- simple check if the bases are a multiple of the modulus
                                                    else mod (product $ map (\ce -> cModI ce m') cL) m'
                        cModI' (HX PoE cL _)   m' = cModI (foldr1 (<^) (b':tail cL)) m' -- convert it a power tower
                                                    where b' = makeCanon $ cModI (head cL) m'
                        cModI' (HX h cL _)     m' | h == cTetrOpLevel && length cL == 2 &&
                                                    not (cHyperExprAny (cL !! 1)) && totient twrHeight > m'
                                                              = cModHyTwr (head cL) m' twrHeight -- exp
                                                  | otherwise = cModHyper (head cL) m' -- to infinity and beyond :)
                                                  where twrHeight = cToI $ cL !! 1

                        -- https://www.quora.com/What-would-be-the-remainder-if-Grahams-number-were-divided-by-2-4-5-6-7-8-9-or-10
                        -- ToDo : Optimize this for larger m especially powers of 10 to show trailing digits
                        -- cModHyper b m' | trace ("cModHyper: (b=" ++ show b ++ "), m'=" ++ show m' ++ ")") False = undefined
                        cModHyper b m' | (all (\e -> elem e bB) $ cGetBases $ mC') = 0 -- the base of a hyper expression must be multiple of m' 
                                       | otherwise                                 = cToI $ f mC'
                                       where (bB, mC') = (cGetBases b, makeCanon m')
                                             -- f mC | trace ("f: (mC=" ++ show mC ++ ")") False = undefined
                                             f mC | mC == c2   = if cEven b then c0 else c1
                                                  | otherwise  = cMod (b <^ f phi) mC
                                                  where phi = fst $ cPhi mC crCycloInitMap

                        -- ToDo: Optimize: This runs in linear time. It could leverage the information above if "f phi" is low enough
                        -- cModHyTwr b m' s | trace ("cModHyTwr: (b=" ++ show b ++ "), m'=" ++ show m' ++ ", s = " ++ show s ++ ")") False = undefined
                        cModHyTwr b m' s           | r == 0    = 0
                                                   | otherwise = cToI $ cm' (s-1) r
                                                   where r        = makeCanon $ cModI b m'
                                                         cm' y lv | y == 0    = nv -- at end
                                                                  | otherwise = cm' (y-1) nv
                                                                  where nv = makeCanon $ cModI (r <^ lv) m'
-- | Totient functions
cTotient, cPhi :: Canon -> CycloMap -> (Canon, CycloMap)
cTotient c m | (not $ cIntegral c) || cNegative c = error "Not defined for non-integral or negative numbers"
             | not $ cSimplified c                      = error "cTotient Can't compute if number not completely factored"
             | c == c0                            = (c0, m)
             | otherwise                          = f (cToGCR c) c1 m
             where f []         prd m' = (prd, m')
                   f ((p,e):gs) prd m' = f gs wp mw
                   -- f is equivalent to the crTotient function but with threading of CycloMap 
                   -- => product $ map (\(p,e) -> (p-1) * p^(e-1)) cr
                                         where cp           = makeCanon p
                                               -- "Canon-ize" cp above.  Generally, this should be a prime already
                                               (pM1, mp)    = cSubtract cp c1 m'
                                               (eM1, me)    = cSubtract e c1 mp
                                               (pxeM1, mpm) = cExp cp eM1 False me
                                               (nprd, mprd) = cMult pM1 pxeM1 mpm
                                               (wp, mw)     = cMult prd nprd  mprd

cPhi = cTotient


-- | The thinking around the hyperoperators is that they should look progressively scarier :)
-- | They range from level 4 / tetration (<^>) to level 50 (~~~~~^~~~~~). Please read .odp file for the naming convention.
infixr <^>, <<^>>, <<<^>>>, <<<<^>>>>, <<<<<^>>>>>, |<^>|,                                  -- 4-9
       ~^~, ~<^>~, ~<<^>>~, ~<<<^>>>~, ~<<<<^>>>>~,                                         -- 10-14
       ~|^|~, ~|<^>|~, ~|<<^>>|~, ~|<<<^>>>|~, ~|<<<<^>>>>|~,                               -- 15-19
       ~~^~~, ~~<^>~~, ~~<<^>>~~, ~~<<<^>>>~~, ~~<<<<^>>>>~~,                               -- 20-24
       ~~|^|~~, ~~|<^>|~~, ~~|<<^>>|~~, ~~|<<<^>>>|~~, ~~|<<<<^>>>>|~~,                     -- 25-29
       ~~~^~~~, ~~~<^>~~~, ~~~<<^>>~~~, ~~~<<<^>>>~~~, ~~~<<<<^>>>>~~~,                     -- 30-34
       ~~~|^|~~~, ~~~|<^>|~~~, ~~~|<<^>>|~~~, ~~~|<<<^>>>|~~~, ~~~|<<<<^>>>>|~~~,           -- 35-39
       ~~~~^~~~~, ~~~~<^>~~~~, ~~~~<<^>>~~~~, ~~~~<<<^>>>~~~~, ~~~~<<<<^>>>>~~~~,           -- 40-44
       ~~~~|^|~~~~, ~~~~|<^>|~~~~, ~~~~|<<^>>|~~~~, ~~~~|<<<^>>>|~~~~, ~~~~|<<<<^>>>>|~~~~, -- 45-49
       ~~~~~^~~~~~                                                                          -- FIFTY

(<^>), (<<^>>), (<<<^>>>), (<<<<^>>>>), (<<<<<^>>>>>), (|<^>|),                                  -- 4-9
  (~^~), (~<^>~), (~<<^>>~), (~<<<^>>>~), (~<<<<^>>>>~),                                         -- 10-14
  (~|^|~), (~|<^>|~), (~|<<^>>|~), (~|<<<^>>>|~), (~|<<<<^>>>>|~),                               -- 15-19
  (~~^~~), (~~<^>~~), (~~<<^>>~~), (~~<<<^>>>~~), (~~<<<<^>>>>~~),                               -- 20-24
  (~~|^|~~), (~~|<^>|~~), (~~|<<^>>|~~), (~~|<<<^>>>|~~), (~~|<<<<^>>>>|~~),                     -- 25-29
  (~~~^~~~), (~~~<^>~~~), (~~~<<^>>~~~), (~~~<<<^>>>~~~), (~~~<<<<^>>>>~~~),                     -- 30-34
  (~~~|^|~~~), (~~~|<^>|~~~), (~~~|<<^>>|~~~), (~~~|<<<^>>>|~~~), (~~~|<<<<^>>>>|~~~),           -- 35-39
  (~~~~^~~~~), (~~~~<^>~~~~), (~~~~<<^>>~~~~), (~~~~<<<^>>>~~~~), (~~~~<<<<^>>>>~~~~),           -- 40-44
  (~~~~|^|~~~~), (~~~~|<^>|~~~~), (~~~~|<<^>>|~~~~), (~~~~|<<<^>>>|~~~~), (~~~~|<<<<^>>>>|~~~~), -- 45-49
  (~~~~~^~~~~~)                                                                                  -- FIFTY
    :: Canon -> Canon -> Canon

a         <^>         b = cTetration a b
a        <<^>>        b = cPentation a b
a       <<<^>>>       b = cHexation  a b
a      <<<<^>>>>      b = cHeptation a b
a     <<<<<^>>>>>     b = cOctation  a b
a        |<^>|        b = cNonation  a b
a         ~^~         b = cApplyHy (makeCanon 10) [a,b] True
a        ~<^>~        b = cApplyHy (makeCanon 11) [a,b] True
a       ~<<^>>~       b = cApplyHy (makeCanon 12) [a,b] True
a      ~<<<^>>>~      b = cApplyHy (makeCanon 13) [a,b] True
a     ~<<<<^>>>>~     b = cApplyHy (makeCanon 14) [a,b] True
a        ~|^|~        b = cApplyHy (makeCanon 15) [a,b] True
a       ~|<^>|~       b = cApplyHy (makeCanon 16) [a,b] True
a      ~|<<^>>|~      b = cApplyHy (makeCanon 17) [a,b] True
a     ~|<<<^>>>|~     b = cApplyHy (makeCanon 18) [a,b] True
a    ~|<<<<^>>>>|~    b = cApplyHy (makeCanon 19) [a,b] True
a        ~~^~~        b = cApplyHy (makeCanon 20) [a,b] True
a       ~~<^>~~       b = cApplyHy (makeCanon 21) [a,b] True
a      ~~<<^>>~~      b = cApplyHy (makeCanon 22) [a,b] True
a     ~~<<<^>>>~~     b = cApplyHy (makeCanon 23) [a,b] True
a    ~~<<<<^>>>>~~    b = cApplyHy (makeCanon 24) [a,b] True
a       ~~|^|~~       b = cApplyHy (makeCanon 25) [a,b] True
a      ~~|<^>|~~      b = cApplyHy (makeCanon 26) [a,b] True
a     ~~|<<^>>|~~     b = cApplyHy (makeCanon 27) [a,b] True
a    ~~|<<<^>>>|~~    b = cApplyHy (makeCanon 28) [a,b] True
a   ~~|<<<<^>>>>|~~   b = cApplyHy (makeCanon 29) [a,b] True
a       ~~~^~~~       b = cApplyHy (makeCanon 30) [a,b] True
a      ~~~<^>~~~      b = cApplyHy (makeCanon 31) [a,b] True
a     ~~~<<^>>~~~     b = cApplyHy (makeCanon 32) [a,b] True
a    ~~~<<<^>>>~~~    b = cApplyHy (makeCanon 33) [a,b] True
a   ~~~<<<<^>>>>~~~   b = cApplyHy (makeCanon 34) [a,b] True
a      ~~~|^|~~~      b = cApplyHy (makeCanon 35) [a,b] True
a     ~~~|<^>|~~~     b = cApplyHy (makeCanon 36) [a,b] True
a    ~~~|<<^>>|~~~    b = cApplyHy (makeCanon 37) [a,b] True
a   ~~~|<<<^>>>|~~~   b = cApplyHy (makeCanon 38) [a,b] True
a  ~~~|<<<<^>>>>|~~~  b = cApplyHy (makeCanon 39) [a,b] True
a      ~~~~^~~~~      b = cApplyHy (makeCanon 40) [a,b] True
a     ~~~~<^>~~~~     b = cApplyHy (makeCanon 41) [a,b] True
a    ~~~~<<^>>~~~~    b = cApplyHy (makeCanon 42) [a,b] True
a   ~~~~<<<^>>>~~~~   b = cApplyHy (makeCanon 43) [a,b] True
a  ~~~~<<<<^>>>>~~~~  b = cApplyHy (makeCanon 44) [a,b] True
a     ~~~~|^|~~~~     b = cApplyHy (makeCanon 45) [a,b] True
a    ~~~~|<^>|~~~~    b = cApplyHy (makeCanon 46) [a,b] True
a   ~~~~|<<^>>|~~~~   b = cApplyHy (makeCanon 47) [a,b] True
a  ~~~~|<<<^>>>|~~~~  b = cApplyHy (makeCanon 48) [a,b] True
a ~~~~|<<<<^>>>>|~~~~ b = cApplyHy (makeCanon 49) [a,b] True
a     ~~~~~^~~~~~     b = cApplyHy (makeCanon 50) [a,b] True

cTetration, cPentation, cHexation, cHeptation, cOctation, cNonation :: Canon -> Canon -> Canon

-- | Tetration Function - Level 4
cTetration a b = cApplyHy cTetrOpLevel [a,b] True

-- | Pentation Function - Level 5
cPentation a b = cApplyHy cPentOpLevel [a,b] True

-- | Hexation Function - Level 6
cHexation a b  = cApplyHy cHexOpLevel  [a,b] True

-- | Heptation Function - Level 7
cHeptation a b = cApplyHy cHeptOpLevel [a,b] True

-- | Octation Function -- Level 8
cOctation a b  = cApplyHy cOctOpLevel  [a,b] True

-- | Nonation Function -- Level 9
cNonation a b  = cApplyHy cNonOpLevel  [a,b] True

-- | Hyperoperation List Operators.  On display, the towers will have single caret operators interspersed.
infixr 9 <^^>, <<^^>>, <<<^^>>>, <<<<^^>>>>, <<<<<^^>>>>>, |<^^>|

(<^^>), (<<^^>>), (<<<^^>>>), (<<<<^^>>>>), (<<<<<^^>>>>>), (|<^^>|) :: Canon -> [Canon] -> Canon

a     <^^>     b = fst $ cTetrationL a b crCycloInitMap
a    <<^^>>    b = fst $ cPentationL a b crCycloInitMap
a   <<<^^>>>   b = fst $ cHexationL  a b crCycloInitMap
a  <<<<^^>>>>  b = fst $ cHeptationL a b crCycloInitMap
a <<<<<^^>>>>> b = fst $ cOctationL  a b crCycloInitMap
a    |<^^>|    b = fst $ cNonationL  a b crCycloInitMap

cTetrationL, cPentationL, cHexationL, cHeptationL, cOctationL, cNonationL
   :: Canon -> [Canon] -> CycloMap -> (Canon, CycloMap)

-- | Tetration List Function
cTetrationL a b m = cHyperOp cTetrOpLevel (a:b) m

-- | Pentation List Function
cPentationL a b m = cHyperOp cPentOpLevel (a:b) m

-- | Hexation List Function
cHexationL a b m  = cHyperOp cHexOpLevel  (a:b) m

-- | Heptation List Function
cHeptationL a b m = cHyperOp cHeptOpLevel (a:b) m

-- | Octation List Function
cOctationL a b m  = cHyperOp cOctOpLevel (a:b) m

-- | Nonation List Function
cNonationL a b m  = cHyperOp cNonOpLevel (a:b) m

-- | Generalized Hyperoperation Function (https://en.wikipedia.org/wiki/Hyperoperation)
cHyperOp :: Canon -> [Canon] -> CycloMap -> (Canon, CycloMap)
-- cHyperOp n l _ | trace ("cHyperOp: (ho=" ++ show n ++ "), l=" ++ show l ++ ")") False = undefined
cHyperOp n l@(a:b:cs) m
   | any (not . cIntegral) (n:l)    = error "cHyperOp requires the 1st 2 parameters to be integral at this time."
   | b < cN1 && n > cExpOpLevel     = error $ hyperLvlError b n
   | n > c2 && any cNegative (b:cs) = error "cHyperOp: At this time, all trailing entries must be >= 0 when using exponentiation or greater."
   | cNegative a && n > c3          = error "cHyperOp: At this time, the base must be >= 0 when using tetration or greater."
   | cNegative a && n == c3         = (if oddPwr then negate absHe else absHe, m)
   | n < c0                         = error "cHyperOp: Requires the level n >= 0"
   | any (== c0) l                  = if n == cAddOpLevel then filterV c0
                                                          else (if n == cMultOpLevel then (c0, m) else stripVs c0)
   | any (== c1) l && n > cAddOpLevel
                                    = if n == cMultOpLevel then filterV c1 else stripVs c1
   | (a /= c0 && a /= c1 && b > c1 && not (a == c2 && b == c2)) ||
     n == c1 || n == c2             = tryToDemoteOrPromote
   | null cs'                       = cHyperOpSpecial (toInteger n) a b m
   | otherwise                      = error "Can not handle special cases with more than 2 params at this time"
   where -- ToDo: Weave in the cycloMap
         -- Note: This tetration demotion logic is closely tied to the cSuperLogCutoff
         -- The idea that anything internally considered as a hyperexpression must be greater than
         -- the cutoff which is currently 10^10^5.  Even 22934 ^ 22934
         absHe                      = fst $ cHyperOp n ((abs a):b:cs) m
         oddPwr                     = cOdd $ fst $ cHyperOp n (b:cs) m
         tryToDemoteOrPromote
           | n == cAddOpLevel  = (sum l, m)
           | n == cMultOpLevel = (product l, m)
           | hyperFree && n == cExpOpLevel  = (foldr1 (<^) l, m) -- Note: The underlying function calls cHyperOp for hyper expressions
           | n == cPentOpLevel && l == [c3, c3] -- expand to 3 <^> 3 <^> 3 so it can be reduced
             = (c3 <^> c3 <^> c3, m)
           | null cs && n == cTetrOpLevel && b == 2
             = (a <^ a, m) -- tetration to exp
           | null cs && n > cTetrOpLevel  && b == 2
             = if cGetHyperOp a == nM1
               then (cApplyHy nM1 (a:(cGetHyperList a)) True, m) -- e.g. (3<^>4) <<^>> 2 => (3<^>4)<^>3<^>4
               else (cApplyHy nM1 [a,a] True, m)          -- e.g. can't append: (3<<^>>4) <<^>> 2 = (3<<^>>4)<<^>>(3<<^>>4)
           | a == 2 &&
             (
              ((null cs &&
                ((n == 5 && b == 3) ||
                 (n == 4 && b == 4))
               ) ||
               (length cs == 1 && head cs == 2 && n == 4 && b == 2)
              )
             )
             = (makeCanon (65536 :: Integer), m) -- 2^2^2^2 = 2 <^> 4 = 2 <^> 2 <^> 2 = 2 <<^>> 3
           | a == 2 && b == 3 && null cs -- 2 <<<^>>> 3 = 2 <<^>> (2 <<^>> 2) = 2 <<^>> 4 -- Special demotion case for 2
             = (cApplyHy nM1 [a, c4] True, m)
           | a == 2 && b == 4 && null cs && n == 5
             = (cApplyHy nM1 [a, cApplyHy n [a, b - 1] True] True, m) -- another demotion: 2 <<^>> 4 = 2 <^> 65536. Both help with comparisons
           | null cs &&
             ((a <= 6 && n == 4 && b == 3) ||
              (a == 3 && n == 5 && b == 2))
             = (a <^ a <^ a, m)
           | ((lL > 2 && n > cMultOpLevel) || (lL >= 2 && n <= cMultOpLevel)) && sameVal l
             -- e.g. (1 + 5<^>7) ^ (1 + 5<^>7) ^ (1 + 5<^>7) = (1+ 5<^>7) <^> 3
             = (promotedC, m)
           | otherwise
             = (cleanup b, m)
           where nM1            = n - c1
                 hyperFree      = not $ any cHyperExprAny l
                 sameVal (x:xs) = s' xs
                                  where s' (v:vs) | v == x    = s' vs
                                                  | otherwise = False
                                        s' _      = True
                 sameVal _      = error "cHyperOp: List with at least two items expected"
                 (lL, lenC)     = (length l, makeCanon $ toInteger lL)
                 promotedC      = case n of
                                  1 -> (head l) * lenC
                                  2 -> (head l) <^ lenC
                                  _ -> cApplyHy (n+1) [head l, lenC] True

         cs' = if b == c1 then [] else cs -- blank out cs if b == 1 -- ToDo : always correct? 
         defHypEx = HX n l IntC -- this just takes the input and creates a HyExp. Might not be what's returned later

         filterV v = (cApplyHy n (filter (/= v) l) False, m)
         stripVs v = (cApplyHy n nl False, m)
                     where nl            = if v == c0 then s l []
                                                      else (fst $ span (/= v) l) -- e.g. [2,3,1,4,5] -> [2,3]
                           s (x:xs) wl = if x == c0
                                         then (if (ct0 xs 0) == 1
                                               then wl -- two trailing zeros evaulate to 1
                                               else (if length wl > 0 then init wl else [])
                                              )
                                         else s xs (wl ++ [x])
                                         where ct0 (y:ys) ct = if y == c0 then ct0 ys (ct+1) else ct
                                               ct0 _      ct = ct :: Integer
                           s _      _  = error "Logic error in strip0: should not get to the end"

                     -- Examples [2,3,4,0,5] => 0^5 = 0 so [2,3,4,0] -> [2,3,1] -> [2,3]
                     -- for 0    [2,3,4,0,0] => 0^0 = 1 so [2,3,4,1] -> [2,3,4]
                     --          [2,3,0,0,0] => [2,3,0,1] -> [2,3,0] -> [2,1] -> [2]

         -- Upgrade Chain Example Below n = 4, a = 7, b = HX (n+1) [a, 13] IntC => HX 5 [7,13] IntC
         -- Then, the answer should be HX (n+1) [a,t+1] IntC = HX 5 [7,14] IntC 
         -- 7 <^> (7 <<^>> 13) simplifies to 7 <<^>> 14
         -- Function for regular cases
         -- cleanup n'  | trace ("cleanup: Processing: (ho=" ++ show n' ++ ")") False = undefined 
         cleanup (HX h cL@(a':e:xs) _)
           | a == a' && h == n + c1 && null xs && null cs
                                            = cApplyHy h [a, e + c1] False --  Upgrade Chain 
           | h == n && null cs              = cApplyHy h (a:cL) False -- combine into longer chain: 5<^>(7<^>7) = 5<^>7<^>7
           | n == eL && cGetHyperOp a == mL = distProdForExpo
           | otherwise                      = defHypEx
         cleanup _
           | n == eL && cGetHyperOp a == mL = distProdForExpo
           | otherwise                      = defHypEx

         distProdForExpo = computeExpr mL $ map (\p -> f (p:es)) $ cGetHyperList b' -- dist expo if it can't be upgraded
           where (b':es)  = l
                 f l'@(x:xs) | cGetHyperOp x == eL = computeExpr eL [bX, eXEval * computeExpr eL xs] -- (x^a)^b = x^(a*b) 
                             | cHyperExprAny x     = computeExpr eL l'
                             | otherwise           = foldr1 (<^) l'
                             where (bX:eX) = cGetHyperList x
                                   eXEval  = computeExpr eL eX
                 f _      = error "Logic Error: Empty list found in cleanup"

         (mL, eL) = (cMultOpLevel, cExpOpLevel)

cHyperOp h (a:_)  m  | h < c0 || not (cIntegral h) = error "cHyperOp: Hyper operator must be >= 0 and integral"
                     | otherwise                   = (a, m)
cHyperOp h l      m  | h < cAddOpLevel || not (cIntegral h)
                                    = error "cHyperOp: Nullary value not defined if hyper operator is lower than addition"
                     | h == cAddOpLevel = (sum l, m)
                     | otherwise        = (product l, m)

hyperLvlError :: Canon -> Canon -> String
hyperLvlError b n = "cHyperOp: Hyperexpr not defined when b < -1 and n is beyond exponentiation. b = " ++
                    show b ++ ", n = " ++ show n ++ "."

-- go through the map and flatten any sums/products in the list
-- take the list. partition it by having "hyper" expressions or not.  Collapse the non-hyper entries
cFlattenAndGroup :: Canon -> [Canon]
--cFlattenAndGroup c | trace ("cFlattenAndGroup: Processing: (c=" ++ show c ++ ")") False = undefined 
cFlattenAndGroup c = cFlattenAndGroup' c cMaxExpoToExpand

cFlattenAndGroup' :: Canon -> Canon -> [Canon]
cFlattenAndGroup' c mx
  | n1 == cAddOpLevel || n1 == cMultOpLevel = fAndG
  | otherwise                               = [c]
  where n1        = cGetHyperOp c -- hyper op from input
        (cA,n,cL) = (abs c, cGetHyperOp cA, cGetHyperList cA)
        fAndG     = fmt (gF nH) (sF h)
                    where (gF, tF, sF)  | n == cAddOpLevel = (sum,     tryFlatSum,  sortByHpo)
                                        | otherwise        = (product, tryFlatProd, id)
                          (h, nH)       = partition cHyperExprAny $ concat $ map tF cL
                          fmt nonHC hyL | n == cAddOpLevel && nonHC == c0  = hyL
                                        | n == cMultOpLevel && nonHC == c1 = hyL
                                        | otherwise                        = (nonHC:hyL)
                          tryFlatSum v  | cGetHyperOp v' == cAddOpLevel = cGetHyperList v'
                                        | otherwise                     = [v']
                                        where v' = fst $ cConvertToSum' v mx
                          tryFlatProd v | cGetHyperOp v == cMultOpLevel  = cGetHyperList v
                                        | otherwise                      = [v]
        -- When operating on a sum, we can flatten some products and distribute them
        -- ToDo: Factor algebraic expressions with hyperoperations.

-- Elements with more hyper expressions in base are sorted first.  The lists of hyper ops are sorted in descending
-- order.  Products of equal "hyper length" will then be compared by the lists.
sortByHpo :: [Canon] -> [Canon]
-- sortByHpo v | trace ("sortByHpo: Processing v = " ++ show v ++ ".") False = undefined
sortByHpo l' | length l' == 1 = l'
             | otherwise      = filter (/= c0) $ map collHy $ groupBy (\x y -> snd x == snd y) $
                                sortBy sHPO $ map hpo $ map combineProd l'  -- This groups by hyOps, bases pair
             where collHy z = combineSum $ computeExpr cAddOpLevel (map fst z)

-- allows for crude sorting without doing any heavy lifting
type CanonInfo = ([Canon], ([[Canon]], [Canon])) -- ([bases], ([["exponents"]],[hyper ops'])) 

combineProd, combineSum :: Canon -> Canon
-- combineProd c | trace ("combineProd: Processing c = " ++ show c ++ ".") False = undefined
combineProd c | cGetHyperOp c' == cMultOpLevel = simpleHX c2 (map fst $ reverse $ sortBy sHPO $ map hpo $ cGetHyperList c')
              | otherwise                      = c'
              where c' = if cNegative c then negate aCm else aCm
                         where aCm = combine cMultOpLevel $ abs c

combineSum  c = combine cAddOpLevel c

combine :: Canon -> Canon -> Canon
-- combine h c | trace ("combine: Processing h = " ++ show h ++ ", c = " ++ show c ++ ".") False = undefined
combine h c | length (cGetHyperList c) < 2 || cGetHyperOp c /= h
                               = c
            | nH == nullary    = computeExpr h cLc
            | h == cAddOpLevel = computeExpr h (cLc ++ [nH]) -- leave non-hyper expressions at the end
            | otherwise        = computeExpr h (nH:cLc)
            where (nH, cL') = (if h == cMultOpLevel then prepM else prepA) c
                  cLc       = if null cL' then [] else (combine' (tail cL') [head cL'] []) -- can be null for sums
                              -- use the quadratic check logic and group them together
                  -- factors (multiplicands)
                  -- prepM c | trace ("prepM: Processing c=" ++ show c ++ ".") False = undefined
                  prepM (HX PoE (b:es) _) = (c1, [(b, computeExpr nxtOp es)])
                  prepM c'@(HX PoM _   _) = (fld nHe, concat $ map (snd . prepM) hE)
                                            where (hE, nHe) = partition cHyperExpr $ cFlattenAndGroup c'
                  prepM c'@(HX _ _     _) = (c1, [(c', c1)])
                  prepM c'                = (c', [])

                  -- addends
                  prepA (HX PoM l  _) = (c0, [(computeExpr nxtOp hE, product nHe)])
                                        where (hE, nHe) = partition cHyperExpr l
                  prepA (HX PoA l  _) = (fld nHe, concat $ map (snd . prepA) hE)
                                        where (hE, nHe) = partition cHyperExpr l
                  prepA c'@(HX _ _ _) = (c0, [(c', c1)])
                  prepA c'            = (c', [])

                  -- combine' c l wL | trace ("combine': Processing c=" ++ show c ++ ", l=" ++ show l ++", wL=" ++ show wL ++ ".") False = undefined
                  combine' l@((xB,xE):xs)    (yP@(yB,yE):ys)   wL
                    | xB == yB  = combine' xs (wL ++ combinedTerm ++ ys) []
                    | otherwise = combine' l ys (yP:wL)
                    where combinedTerm = if (xE + yE == c0) then [] else [(xB, xE + yE)]
                  combine' (xP:xs)           _                 wL
                    = combine' xs (xP:wL) []
                  combine' _                 y                 _
                    = map f y -- this is the simplified list
                      where f (b,e)              | e == c1                = b
                                                 | cGetHyperOp e == nxtOp = computeExpr nxtOp (b:cGetHyperList e)
                                                 | otherwise              = computeExpr nxtOp [b, e]

                  (fld, nullary,nxtOp) | h == cAddOpLevel       = (sum,     c0, cMultOpLevel)
                                       | otherwise              = (product, c1, cExpOpLevel)


-- ToDo: Modify so that there are pairs of numbers when there are repeated exponents?  Or is this close enough?
hpo :: Canon -> (Canon, CanonInfo)
hpo c' = (c', h' (abs c'))
        where h' c@(HX PoM l2 _) = (getHyperBases c, (reverse $ sort $ concat e2, reverse $ sort $ filter (\h -> h /= c0) $  concat h2))
                                   where (e2, h2) = unzip $ map spHyOp $ filter cHyperExpr l2
              h' c@(HX _   _  _) = (getHyperBases c, spHyOp c) -- Use the back hyperOp for now
              h' _               = ([],  ([[]], [])) -- nothing to consider in sorting

getHyperBases :: Canon -> [Canon]
getHyperBases c        = cGetBases' False False True c

sHPO :: (Canon, CanonInfo) -> (Canon, CanonInfo) -> Ordering
sHPO (_,(b1,(e1,hl1))) (_,(b2,(e2,hl2))) | hl1 > hl2 = LT
                                         | hl1 < hl2 = GT
                                         | otherwise = case compare hl2 hl1 of -- rev sort the hyper ops
                                                       EQ  -> case compare b1 b2 of  -- and then the bases if needed
                                                              EQ   -> case compare (length e1) (length e2) of
                                                                      EQ   -> compare e1 e2
                                                                      cmpE -> cmpE
                                                              cmpB -> cmpB
                                                       cmp -> cmp

-- give greater weight to hyper expressions raised to an exponent. ToDo: verify soundness
spHyOp :: Canon -> ([[Canon]], [Canon])
-- spHyOp c | trace ("spHyOp: Processing: (" ++ show c ++ ")") False = undefined
spHyOp c               | h == cExpOpLevel && (cHyperExpr $ head hL) = (replicate nR $ tHl, replicate nR hH)
                       | h == cMultOpLevel                          = (filter (/= []) $ sort $ concat e', sort $ concat h') -- handle product 
                       | otherwise = ([tHl], [h])
                       where (h, hL)     = (cGetHyperOp c, cGetHyperList c)
                             hH          = cGetHyperOp $ head hL
                             nR          = if l > 2 || e > 1000 then 1000 else (fromInteger $ cToI e) -- ToDo: handle edge case when grouping
                                           where l = length $ cGetHyperList $ head hL
                                                 e = head $ tail hL
                             (e', h')    = unzip $ map spHyOp $ filter cHyperExpr hL
                             tHl         | h == cExpOpLevel && length bHl > 1 = tail bHl
                                         | otherwise                          = if length hL > 1 then tail hL else []
                                           where bHl = cGetHyperList $ head hL

-- Function for special cases:                 
-- Note: When n (first param) is zero, that is known as "succession"
--   Cases when a is zero ...
cHyperOpSpecial :: Integer -> Canon -> Canon -> CycloMap -> (Canon, CycloMap)
cHyperOpSpecial 0 Pc0 b'   m = cAdd b' c1 m
cHyperOpSpecial 1 Pc0 b'   m = (b', m)
cHyperOpSpecial 2 Pc0 _    m = (c0, m)
cHyperOpSpecial 3 Pc0 b'   m = (if b' == c0 then c1 else c0, m)
cHyperOpSpecial _ Pc0 b'   m = (if cOdd b' then c0 else c1, m)
--   Cases when b is zero ...
cHyperOpSpecial 0 _   Pc0  m = (c1, m)
cHyperOpSpecial 1 a'  Pc0  m = (a', m)
cHyperOpSpecial 2 _   Pc0  m = (c0, m)
cHyperOpSpecial _ _   Pc0  m = (c1, m)
--   Cases when b is -1 ...
cHyperOpSpecial 0 _   PcN1 m = (c0, m)
cHyperOpSpecial 1 a'  PcN1 m = cSubtract a' c1 m
cHyperOpSpecial 2 a'  PcN1 m = (cNegate a', m)
cHyperOpSpecial 3 a'  PcN1 m = (cReciprocal a', m)
cHyperOpSpecial _ _   PcN1 m = (c0, m)
--   Other Cases ...
cHyperOpSpecial h Pc2 Pc2  m | h == 0    = (smallCanons !! 3, m)
                             | otherwise = (smallCanons !! 4, m) -- recursive identity
cHyperOpSpecial _ Pc1 _    m = (c1, m)
cHyperOpSpecial _ a'  Pc1  m = (a', m)
cHyperOpSpecial _ _   _    _ = error "Can't compute this hyperoperation.  b must be >= -1.  Not a 'special' case"

-- | Return the list of canons from a hyper expression
cGetHyperList :: Canon -> [Canon]
cGetHyperList (HX _ cL _) = cL
cGetHyperList _           = []

-- | Return the level of hyperoperation from a hyper expression.
cGetHyperOp :: Canon -> Canon
cGetHyperOp (HX h _ _) = h
cGetHyperOp _          = c0

-- | Exponentiation and root operator declarations
infixr 9 <^, >^

(<^), (>^) :: Canon -> Canon -> Canon

a <^ b = fst $ cExp a b True crCycloInitMap
r >^ n = cRoot n r

-- | Convert a Canon back to its underlying rep (if possible).
cToCR :: Canon -> CR_
cToCR (Can c v)      | v /= IrrC = gcrToCR c
                     | otherwise        = error "cToCR: Cannot convert irrational canons to underlying data structure"
cToCR (Bare 1 _ )    = cr1
cToCR (Bare n NSim)  = fst $ crFromI n
cToCR (Bare n Simp)  = [(n,1)] -- not ideal
cToCR c              = gcrToCR $ cToGCR c -- this could be EXTREMELY expensive for hyper-expressions.

-- | Convert generalized canon rep to Canon.
gcrToC :: GCR_ -> Canon
gcrToC g | gcrBare g = Bare (gcrToI g) Simp
         | otherwise = Can g (gcrCVT g)

-- | For generalized canon rep, determine the CanonValueType.   
gcrCVT :: GCR_ -> CanonValueType
gcrCVT POne = IntC
gcrCVT g    = g' g IntC -- start Integral, can only get "worse"
              where g' _           IrrC = IrrC -- short-circuits once irrational canon is found
                    g' POne        v    = v
                    g' ((_,ce):cs) v    = g' cs (dcv v ce) -- check the exponents for expr's value type
                    g' _           _    = error "gcrCVT : Logic error. Patterns should have been exhaustive"

                    -- checking exponents
                    dcv IrrC _            = IrrC
                    dcv _    (Can _ IrrC) = IrrC
                    dcv _    (Can _ NirC) = IrrC
                    dcv IntC (Bare  n _)  = if n < 0 then NirC else IntC
                    dcv v    (Bare  _ _)  = v
                    dcv v    c            = if cNegative c then NirC else v

-- | Define some small canons for convenience
cN1, c0, c1, c2, c3, c4, c5, c6, c7, c8, c9 :: Canon
(cN1:c0:c1:c2:c3:c4:c5:c6:c7:c8:c9:_) = map makeCanon [-1..maxHyperOpDispLevel]

impossibleHyperValue :: Canon
impossibleHyperValue = cN1 -- used internally as a sentinel

-- | Convert Canon to Integer if possible.
cToI :: Canon -> Integer
cToI (Bare i _ )       = i
cToI c@(Can g v)  | v == IntC && (cHyperExpr c || cSuperLogGT (fst $ cSuperLog c) cSuperLogCutoff)
                             = error $ tooBigError c
                  | v == IntC = gcrToI g
                  | otherwise = error $ nonIntError c
cToI h@(HX _ _ v) | v == IntC = error $ tooBigError h -- always too big.  cHyperOp is in sync with cSuperLogCutoff
                  | otherwise = error $ nonIntError h

tooBigError, nonIntError :: Canon -> String
tooBigError c = "This expression is too large to be converted to an integer: " ++ show c
nonIntError c = "Can't convert a non-integral canon to an integer: " ++ show c

-- | Convert Canon To Double.
cToD :: Canon -> Double
cToD (Bare i _) = fromIntegral i
cToD (Can c _)  = gcrToD c
cToD (HX _ _ _) = error "This hyper-expression is too large to convert to a double"

-- | Multiply Function: Generally speaking, this will be much cheaper than addition/subtraction which requires factoring.
--   You are usually just merging lists of prime, exponent pairs and adding exponents where common primes are found.
--   This notion is the crux of the library.
--
--   Note: This can be used instead of the '*' operator if you want to maintain a CycloMap for performance
--   reasons.
cMult :: Canon -> Canon -> CycloMap -> (Canon, CycloMap)
cMult Pc0 _   m = (c0, m)
cMult _   Pc0 m = (c0, m)
cMult Pc1 y   m = (y, m)
cMult x   Pc1 m = (x, m)
cMult x   y   m | not (cHyperExprAny x) && not (cHyperExprAny y)
                            = (gcrToC g, m')
                | otherwise = (multH x y, m) -- This attempts to do deeper combining and can be problematic (head $ cMultiplicative x y Mult, m) 
                where (g,  m') = gcrMult (cToGCR x) (cToGCR y) m

-- | Addition and subtraction is generally much more expensive because it requires refactorization.
--   There is logic to look for algebraic forms which can greatly reduce simplify factorization.
--   Note: This can be used instead of the +/- operators if you want to maintain a CycloMap for performance
--   reasons.
cAdd, cSubtract :: Canon -> Canon -> CycloMap -> (Canon, CycloMap)
cAdd      = cApplyAdtvOp True
cSubtract = cApplyAdtvOp False

-- | Internal Function to compute sum or difference based on first param.  Much heavy lifting under the hood here.
cApplyAdtvOp :: Bool -> Canon -> Canon -> CycloMap -> (Canon, CycloMap)
-- cApplyAdtvOp _ x y _ | trace ("cApplyAdtvOp: Processing: (" ++ show x ++ ") and (" ++ show y ++ ")") False = undefined
cApplyAdtvOp _     x   Pc0 m = (x, m)
cApplyAdtvOp True  Pc0 y   m = (y, m)         -- True -> (+)
cApplyAdtvOp False Pc0 y   m = (negate y, m)  -- False -> (-) 
cApplyAdtvOp b     x   y   m | not b && x == y          = (c0, m)
                             | b &&     x == (negate y) = (c0, m)
                             | not hax && not hay       = (r, m')
                             | otherwise                = (addH x (if b then y else negate y), m)
                             where (hax, hay) = (cHyperExprAny x, cHyperExprAny y)
                                   gcd'       = cGCD x y -- non-hyper
                                   (x', y')   = (x / gcd', y / gcd')
                                   r          | tooBigToAdd x' || tooBigToAdd y'
                                                          = simpleHX cAddOpLevel [x, if b then y else (negate y)]
                                              | otherwise = gcd' * (crToC c False)
                                   (c, m')    = crApplyAdtvOptConv b (cToCR x') (cToCR y') m -- costly bit                               

tooBigToAdd :: Canon -> Bool
tooBigToAdd c@(Can _ _) | cHyperExprAny c = True
                        | otherwise       = cSuperLogGT (fst $ cSuperLog c) cSuperLogCutoff
tooBigToAdd (HX _ _ _)  = True
tooBigToAdd (Bare _ _)  = False

-- | Exponentiation: This does allow for negative exponentiation if the Bool flag is True.
--   Note: This can be used instead of the exponentiation operator if you want to maintain a CycloMap for performance
--   reasons.
cExp :: Canon -> Canon -> Bool -> CycloMap -> (Canon, CycloMap)
-- cExp c e _ _ | trace ("cExp: Processing: " ++ show c ++ " <^ " ++ show e ++ ".") False = undefined
cExp c e b m | cNegative e && (not b)
               = error "Per param flag, negative exponentiation is not allowed here."
             | cIrrational c && cIrrational e
               = error "cExp: Raising an irrational number to an irrational power is not currently supported."
             | otherwise = cExp' c e
             where cExp' _   Pc0 = (c1, m)
                   cExp' Pc1 _   = (c1, m)
                   cExp' Pc0 _   | cNegative e = error "0^e where e < 0 gives a div by zero error"
                                 | otherwise   = (c0, m)
                   cExp' _   Pc1 = (c,  m) -- just return the value
                   cExp' _   _   | cHyperExprAny c || cHyperExprAny e  = (cApplyHy cExpOpLevel [c,e] True, m)
                                 | otherwise                           = (gcrToC g, mg)
                                 where (g, mg) = gE (cToGCR c) e m

                   gE g' e' m' | gcrNegative g'
                                 = case cValueType e' of  -- gcr exponentiation
                                   IntC -> if cOdd e' then (gcreN1:absTail, m'')
                                                      else (absTail, m'')
                                   NirC -> if cOdd d then (gcreN1:absTail, m'')
                                                     else error "gE: Imaginary numbers not supported"
                                   IrrC     -> error "gE: Raising neg numbers to irr. powers not supported"
                               | otherwise
                                 = f g' m' -- equivalent to multiplying each exp by e' (with CycloMap threaded)
                               where (absTail, m'')  = gE (gcrAbs g') e' m'
                                     (_, d)          = cSplit e' -- even denom generates an imag. number
                                     f []         mf = ([], mf)
                                     f ((p,x):gs) mf = (fp, mf')
                                                       where (prd, mx) = cMult e' x mf
                                                             (t, mn)   = f gs mx
                                                             (fp, mf') = gcrMult [(p, prd)] t mn

-- | Functions to check if a canon is negative/positive
cNegative, cPositive :: Canon -> Bool

-- cNegative c | trace ("cNegative: (l=" ++ show c ++ "))") False = undefined
cNegative (Bare n _   ) = n < 0
cNegative (Can c  _   ) = gcrNegative c
cNegative (HX PoA cL _) | lp == 0                       = True
                        | ln == 0                       = False
                        | otherwise                     = (cCmp pH nH == LT)
                        where (posCL, negCL') = partition cPositive cL
                              negCL = map negate negCL'
                              lp    = length posCL
                              ln    = length negCL
                              pH    = cApplyHy cAddOpLevel posCL True
                              nH    = cApplyHy cAddOpLevel negCL True
                              -- ToDo: Are there cases where combineSum could be used. Convert To Sum caused loops because it calls cNegative

cNegative (HX PoM cL _) = cNegative $ head cL
cNegative (HX _   _  _) = False -- tetration and beyond can only result in positive numbers

cPositive (Bare n   _  ) = n > 0
cPositive (Can  c   _  ) = gcrPositive c
cPositive h@(HX PoA _ _) = not $ cNegative h -- zero is not possible in a hyper-expression.
cPositive h@(HX PoM _ _) = not $ cNegative h -- same for products
cPositive (HX   _   _ _) = True -- tetration and beyond can only result in positive numbers

-- | Functions for negation, absolute value and signum
cNegate, cAbs, cSignum :: Canon -> Canon

-- cNegate c | trace ("cNegate: Processing: v=("++show c ++ ")") False = undefined
cNegate (Bare 0 _)      = c0
cNegate (Bare 1 _)      = cN1
cNegate (Bare (-1) _)   = c1
cNegate (Bare x Simp)   = Can (gcreN1 : [(x, c1)]) IntC -- prepend a "-1", not ideal
cNegate (Bare x NSim)   = Bare (-1 * x) NSim
cNegate (Can x v)       = gcrNegateCanonical x v

-- HyperOp case: Product of canons. 
cNegate h@(HX PoA cL _) | cNegative h = simpleHX cAddOpLevel (reverse $ map negate cL) -- only should happen internally
                        | otherwise   = simpleHX cMultOpLevel [cN1,h]
cNegate (HX PoM cL _)   | hD == cN1           = cApplyHy cMultOpLevel (tail cL) True
                        | nhH && cNegative hD = simpleHX cMultOpLevel ((abs hD):(tail cL))    -- change the leading term which should not
                        | nhH && cPositive hD = simpleHX cMultOpLevel ((negate hD):(tail cL)) -- be hyper (if exists) in a product
                        | otherwise           = simpleHX cMultOpLevel (cN1:cL) -- prepend to existing list/product 
                        where (hD, nhH) = (head cL, not $ cHyperExpr hD)

cNegate he@(HX _ _ _)   = simpleHX cMultOpLevel [cN1, he]
                          -- prepend a negative one to existing expression, making a new 2-element expr.
                          -- this applies to hyper sums which internally will always be kept positive

cAbs x | cNegative x = cNegate x
       | otherwise   = x

--cSignum c | trace ("cSignum: (c = " ++ show c ++ ")") False = undefined
cSignum (Bare 0 _)      = c0
cSignum g | cNegative g = cN1
          | otherwise   = c1

-- This internal function works for either gcrGCD or gcrLCM.
cLGApply :: (GCR_ -> GCR_ -> GCR_) -> Canon -> Canon -> Canon
cLGApply f x   y   | cNegative x ||
                     cNegative y = gcrToC $ f (cToGCR $ cAbs x) (cToGCR $ cAbs y)
                   | otherwise   = gcrToC $ f (cToGCR x)        (cToGCR y)

-- | This function tries to convert a hyper expression to "canonical" form.  It is rather limited
--   due to the way power towers branch for composite numbers in canonical form. Conversions can be used for non-integral division.
tryToCanonizeHyperExpr :: Canon -> Maybe Canon
tryToCanonizeHyperExpr c@(HX _ _ _)
  | cHyperSumAny c || cMaxHyperOp c > cTetrOpLevel || cMaxTetrLevel > 10 = Nothing
  | otherwise                                                             = Just $ conv c
  where cMaxTetrLevel = mtl c0 c
        mtl wM (HX h l@(x:xs) _) | h == cTetrOpLevel = foldl1 max [wM, mtl wM x, cApplyHy h xs True]
                                 | otherwise         = foldl1 max (wM:(map (mtl wM) l))
        mtl wM _                 = wM
        conv (HX PoM l _)        = product $ map conv l
        conv (HX PoE l _)        = foldr1 (<^) $ map conv l
        conv (HX h l@(b:x:_)  _) | h /= c4          = error "Logic error: Only tetration allowed here"
                                 | length l /= 2    = error "Logic error: Tetration list must only have two elements"
                                 | hB < c4          = convToTwr l
                                 | hB == c4 && simpleHyperExpr b && cMaxTetrBase <= 10 -- Note: Quite limited
                                                    = nestedTetr x
                                 | otherwise        = foldr1 (<^) $ replicate (fromInteger $ cToI $ l !! 1) (conv $ l !! 0)
                                 where (hB, bHl, bT) = (cGetHyperOp b, cGetHyperList b, convToTwr bHl)
                                       cMaxTetrBase  = mtl c0 b
                                       convToTwr l'  = foldr1 (<^) $ replicate (fromInteger $ cToI $ l' !! 1) (conv $ l' !! 0)
                                       nestedTetr oe | oe == 2   = b <^ b
                                                     | otherwise = bT <^ nestedTetr (oe - 1)
                                       -- only relevant to tetration and above
                                       simpleHyperExpr c'@(HX h' l' _) | h' < cTetrOpLevel || not (cIntegral c') ||
                                                                         length l' /= 2 || not (any cHyperExprAny l')
                                                                                   = True
                                                                       | otherwise = False
                                       simpleHyperExpr _               = False

        conv c'                 = c' -- non-hyper expA
tryToCanonizeHyperExpr c = Just c

-- | Div function : Multiply by the reciprocal.
cDiv :: Canon -> Canon -> CycloMap -> (Canon, CycloMap)
cDiv _   Pc0 _ = error "cDiv: Division by zero error"
cDiv Pc0 _   m = (c0, m)
cDiv x   y   m
  | not (cHyperExprAny x) && not (cHyperExprAny y)
                                 = cMult (cReciprocal y) x m -- multiply by the reciprocal
  | y' == c1                     = (x', m) -- x is a multiple of y (One or both is a hyper expr)
  | otherwise                    = case tryHyperDiv x y m of
                                   Right r -> r
                                   Left s  -> error s
  where (x', y') = reduceProds x y

-- do not call this directly.  It assumes hyper operations 
tryHyperDiv :: Canon -> Canon -> CycloMap -> Either String (Canon, CycloMap)
tryHyperDiv x y m
  | fmx /= hyDef && fmy /= hyDef
    = if (cCanonical fQ && cIntegral fQ && cHyperExprAny fQ)
      --canonical yet has "hyper exponents".  Convert quotient to hyper expression.
      then Right (cConvertToHyperExpr fQ, m')
      else Right (fQ, m')
  | otherwise
    = Left ("At this time, one can only divide hyper expressions when x is a multiple of y, non-sums or limited tetrations: x = "
           ++ show x ++ ", y = " ++ show y)
  where fmch v             = fromMaybe hyDef (tryToCanonizeHyperExpr v)
        (hyDef, fmx, fmy)  = (impossibleHyperValue, fmch x, fmch y)
        (fQ, m')           = cDiv fmx fmy m -- feed the canonical reps back into the function

-- Converts an integral "Canonical" canon to a hyper product. Error if the canon is not integral  Otherwise, it leaves the canon as is. 
-- ToDo: What if the result is not a hyper expr after going through the function?
cConvertToHyperExpr :: Canon -> Canon
cConvertToHyperExpr c | not (cIntegral c)               = error "Cannot convert a non-integral canon to a hyper expression"
                      | cCanonical c && cHyperExprAny c = cApplyHy cMultOpLevel ((product nHe):hE) False
                      | otherwise                       = c
                      where (hE, nHe) = partition cHyperExpr $ map hF $ cToGCR c
                            hF (p, e) = if e == c1 then pC else (cApplyHy cExpOpLevel [pC, e] True) where pC = makeCanon p

-- | Compute reciprocal (by negating exponents or equivalent).
cReciprocal :: Canon -> Canon
cReciprocal x | not (cHyperExprAny x) = fst $ cExp x cN1 True crCycloInitMap  -- raise number to (-1)st power
              | fmx /= hyDef          = cReciprocal fmx
              | otherwise             = error $ "At this time, one can only take reciprocals of hyper expressions which are " ++
                                                "non-sums and limited tetrations."
              where fmch v        = fromMaybe hyDef (tryToCanonizeHyperExpr v)
                    (hyDef, fmx)  = (impossibleHyperValue, fmch x)

-- | Functions to check if a Canon is Integral, (Ir)Rational, "Simplified", a prime or a prime tower
cIntegral, cIrrational, cRational, cSimplified, cPrime, cIsPrimeTower :: Canon -> Bool

cIntegral   c = cValueType c == IntC
cIrrational c = cValueType c == IrrC
cRational   c = not $ cIrrational c

cSimplified (Bare _ Simp) = True
cSimplified (Bare _ NSim) = False
cSimplified (Can  c _)    = gcrSimplified c
cSimplified c@(HX h l _)  = h /= cAddOpLevel && ((cHyperProd c && all cSimplified l) || (cSimplified $ head l))

cPrime c = cSimplified c && c > c1 -- Simp includes 0, -1

cIsPrimeTower c          = cPrimeTowerLevel c > 0 -- x^x would not be, but x^x^x would be

-- | Utility functions regarding hyperoperations.  "Any" functions search the entire expression
cHyperExpr, cHyperExprAny, cHyperSum, cHyperSumAny, cHyperProd, cHyperExpo :: Canon -> Bool

cHyperExpr    = cHyperPredCheck (>= cAddOpLevel) False
cHyperExprAny = cHyperPredCheck (>= cAddOpLevel) True

cHyperSum (HX h (j:k:cs) _) = h == cAddOpLevel ||
                              (h == cMultOpLevel && j == cN1 && cGetHyperOp k == cAddOpLevel && null cs)
cHyperSum _                 = False

cHyperSumAny = cHyperPredCheck (== cAddOpLevel) True -- when looking any we can just go by hyper op

cHyperProd c@(HX PoM _ _) = not $ cHyperSum c -- Note: a negative sum is not considered a product
cHyperProd _              = False;

cHyperExpo = cHyperPredCheck (== cExpOpLevel) False -- checks if this is an exponential expression

-- | Takes a predicate related to the hyper operation.  It will search recursively if the 2nd flag is set.
cHyperPredCheck :: (Canon -> Bool) -> Bool -> Canon -> Bool
cHyperPredCheck f b c | f (cGetHyperOp c) = True
                      | not b             = False -- don't do the any check
                      | otherwise         = cHP' c
                      where cHP' (HX _ l _) = any (cHyperPredCheck f b) l
                            cHP' (Can g _)  = any (cHyperPredCheck f b) $ map snd g
                            cHP' _          = False

-- | cNumerator and cDenominator are for processing "rational" canon reps.
cNumerator, cDenominator :: Canon -> Canon

cNumerator (Can c _ ) = gcrToC $ filter (\x -> cPositive $ snd x) c -- filter positive exponents
cNumerator b          = b

cDenominator (Can c _ ) = gcrToC $ map (\(p,e) -> (p, cN1*e)) $ filter (\(_,e) -> cNegative e) c -- negate neg expnts
cDenominator _          = c1  -- ToDo: For now, hyper expressions are always integral 

-- ToDo : Tweak cQuasiCanonize to make this function obsolete.  The 2nd param isn't part of the QC function.
-- cNestExpTail can be used whether or not the base is a hyper expression.  It unravels tetration and beyond.
-- For example: 7 <<<^>>> 8 = 7 <^ (7 <^> (-1 + 7 <<^>> (-1 + 7 <<<^>>> 7)).  The expr after <^ would be the exp. tail
cNestExpTail :: Canon -> Bool -> Canon
cNestExpTail c'@(HX h (b:xs) IntC) bF
  | h == cAddOpLevel= c1
  | h < cExpOpLevel = error errorMsg
  | otherwise       = if bF then baseTail b * eH else eH -- If the flag is set, process the base as well.
  where expTail      = cApplyHy h xs True
        eH           = expRec h expTail
        expRec h' e' | h' == cExpOpLevel = e' -- otherwise, recursively demote down
                     | otherwise         = expRec (h' - c1) newE
                                           -- e.g. x<^>y<^>z = x^(x<^>((y<^>z)-1))
                     where newE          = cApplyHy h' [b, e' - c1] True
        baseTail (HX PoA _ _)   = c1
        baseTail c@(HX PoM _ _) = error $ nonPrimePowerError c  -- Limited but cQuasiCanonize kind of supplants this fcn
        baseTail c@(HX _   _ _) = cNestExpTail c bF
        baseTail c@(Can g _)    | length g > 1 = error $ nonPrimePowerError c
                                | otherwise    = snd $ head g -- the exponent
        baseTail (Bare _ Simp)  = c1
        baseTail c              = error $ nonPrimePowerError c
        errorMsg = "nestedExpTail: requires a hyper expression at level >= exponentiation: " ++ show c'
cNestExpTail _ _     = c1

-- | Break code into a canonized 
cCleanup :: Canon -> Canon
cCleanup = cHyperize . cQuasiCanonize

-- | Split the hyperoperation into a cleaned-up numerator and denominator pair (if denom is 1).  This still represents an integral value.  e.g. 3 <^> 7 / 3 <^> 4
cCleanupAsNumDenPair :: Canon -> (Canon,Canon)
cCleanupAsNumDenPair c = (n,d)
  where (n, d)   = (cHyperize $ pr nL, cHyperize $ pr dL)
        qc       = cQuasiCanonize c
        pr cL    = simpleHX cMultOpLevel $ map expDemote $ filter (\(_, e) -> e /= c0) cL
        (nL, dL) = unzip $ map (\(p,(eP,eN)) -> ((p, eP), (p, eN)) ) $ map (\(p,e) -> (p, spl e)) $ map (\c' -> expPromote c') $ cGetFactors qc
        spl c'   = (simpleHX cAddOpLevel pos, simpleHX cAddOpLevel (map negate neg))
                   where (pos, neg) = partition cPositive $ cGetAddends c' -- positive and negative entries in exponent sum expression

-- | Hyperize will take a Canon in quasi-canonized form and try to clean it up in a tidier expression
-- Example: 7 ^ ( 1 + 2 * (49 <^> 7) = 7 * 49 <^> 8.  ToDo: Enhancement: Partial hyperizing?
cHyperize :: Canon -> Canon
cHyperize c | not (cQuasiCanonized c) || (h /= cExpOpLevel && h /= cMultOpLevel) || null iM
                        = c
            | any cNegative $ concat $ map (\(_,e) -> cGetAddends e) $ map expPromote $ cGetFactors c -- 
                        = c -- For example, we can't cleanup 3 <^> 5 / 3 <^> 4 = 3 ^ (3<^>4 - 3<^>3) into a simple expression
            | not (null $ cGetBases' False True False $ simpleHX cMultOpLevel iM) -- in-scope bases are non-unique so not valid
                        = c
            | not (foldl1 (&&) $ map snd process)                             -- not all "tail-convertible")
                        = c
            | not (foldl1 (&&) $ map (\(_,l) -> allTheSame $ map snd l) grp)  -- not all multipliers are the same
                        = c
            | null grp' || not (foldl1 (&&) $ map snd grp')                   -- not all elements of each base accounted for
                        = c
            | otherwise = iSp * oSp
            where h        = cGetHyperOp c
                  (iM, oM) = partition (\m -> cGetHyperOp m == cExpOpLevel) $ cGetFactors c

                  process = map (\l -> hypMap (l !! 0, l !! 1)) $ map cGetHyperList iM
                  oSp     = product (oM ++ (map (snd . snd . fst) process)) -- everything that could not be rolled up
                  grp     = grpExpr $ concat $ map (\((p,(eMap,_)),_) -> map (\((_,t),m)-> (t, (p, m))) eMap) process
                  grp'    = map (\(e,l) -> ((e, snd $ head l), cBaseRadical e == product (map fst l))) grp
                  iSp     = product $ map (\((e,m),_) -> cApplyHy cExpOpLevel [e, m] True) grp' -- in scope product

                  allTheSame l@(x:_:_) = and $ map (== x) (tail l)
                  allTheSame _         = True

                  grpExpr l@(_:_:_) = gE' l []
                  grpExpr ((e,p):_) = [(e, [p])]
                  grpExpr _         = error $ "Blank list passed to grpExpr when processing c = " ++ show c

                  gE' l@((xf,_):_) wL = gE' nM ((xf, map snd m):wL) -- all the add'l base info for that expression
                                        where (m,nM) = partition (\e -> xf == fst e) l
                  gE' _            wL = wL

-- Called by hyperize at this point, the constants should have been removed
hypMap :: (Canon, Canon) -> ((Canon, ([((Canon, Canon), Canon)], Canon)), Bool) -- ToDo: Better to change this to a Maybe
hypMap (p, e) = ((p, (mV', osProd)), not $ any (\((_,t),_) -> t == impossibleHyperValue) mV')
  where (iS, oS) = partition candPred $ cGetAddends e -- only process
        osProd   = computeExpr cMultOpLevel (map (\x -> p <^ x) oS)
        mV'      = mV p iS

-- mV is short for mapped values
mV :: Canon -> [Canon] -> [((Canon, Canon), Canon)]
mV p iS | null iS   = []
        | otherwise = map (hypCheck p) $ cGetAddends $ grpAndSrtList p iS

hypCheck :: Canon -> Canon -> ((Canon, Canon), Canon)
hypCheck p c = ((c, liftedTail), p') -- e.g. p == 13 for (3 <<^>> 4) <^ 13
               where (fs, base)  = (cGetFactors c, head $ cGetHyperList $ head $ fs)
                     liftedTail  | b' /= c1  = impossibleHyperValue -- p must be a "clean" multiple of b
                                 | otherwise = tryLiftTail $ head fs
                     (_, p', b') = simpleReduce (product $ tail fs) (qcBase p base) False -- 

-- group and sort list of canons 
grpAndSrtList :: Canon -> [Canon] -> Canon
-- grpAndSrtList p iS | trace ("grpAndSrtList: (p = " ++ show p ++ ", iS = " ++ show iS ++ ")") False = undefined
grpAndSrtList p iS = simpleHX cAddOpLevel $ map s $ cGetAddends $ factorSumIter True $ simpleHX cAddOpLevel $ map m' iS
                     where m' a     = applyFcnForHy a cMultOpLevel cFlattenAndGroup
                           s  a     = applyFcnForHy a cMultOpLevel (srt p)

-- sort the portions of the product so that the first item's base "derivative" will equal the product of the tail
srt :: Canon -> Canon -> [Canon]
srt p a' = ((reverse $ sortOn (nestLevel p) cs) ++ ncs)
           where (cs, ncs) = partition (\e -> candPred e && elem p (cGetBases e)) $ cGetFactors a'

candPred :: Canon -> Bool
candPred c'@(HX PoM _ _) = any candPred $ cGetHyperList c'
candPred c'              = powSq c' || cGetHyperOp c' == cTetrOpLevel
                           where powSq (HX PoE (b:e:xs) _) = null xs && b == e -- some item raised to itself
                                 powSq _                   = False

-- 7 ^ {7 <^> {7 <<^>> (2^2) - 1}} would be lifted to Just 7 <<^>> 5.  Useful when hyperizing
tryLiftTail :: Canon -> Canon
-- tryLiftTail c | trace ("tryLiftTail: (c = " ++ show c ++ ")") False = undefined
tryLiftTail c | cGetHyperOp c < cExpOpLevel || length l < 2 || cGetHyperOp cLift == cExpOpLevel
                          = impossibleHyperValue
              | otherwise = cLift
              where (l, b, cLift) = (cGetHyperList c, head l, cApplyHy cExpOpLevel [b, c] True)

qcBase :: Canon -> Canon -> Canon
-- qcBase p c | trace ("qcBase: (p = " ++ show p ++ ", c = " ++ show c ++ ")") False = undefined
qcBase p c@(Bare n _) = if (n == cToI p) then c1 else error (errMsgQCB p c []) -- ToDo: Handle unfactored numbers
qcBase p c@(Can g _)  | cHyperExpr p || length pe == 0 = error (errMsgQCB p c [])
                      | otherwise                      = snd $ head pe
                      where pe = filter (\(p',_) -> p' == pI) g -- ToDo: Unfactored edge cases 
                            pI = cToI p
qcBase p c            | cGetHyperOp p == cAddOpLevel && p == c
                                      = c1
                      | length qce == 1 = snd $ head qce -- 3 <^ (3 <^> 4) -> 3 <^> 4
                      | otherwise       = error $ errMsgQCB p c qce
                      where qce = filter (\(b,_) -> p == b) $ map expPromote $ cGetFactors $ cQuasiCanonize c

errMsgQCB :: Canon -> Canon -> [(Canon, Canon)] -> String
errMsgQCB p c qce = "Logic error in qcBase: Canon: " ++ show c ++ " did not contain p = " ++
                    show p ++ ". Length = " ++ show (length qce)

-- Checks how embedded a prime (or sum) is in a hyper expression
nestLevel :: Canon -> Canon -> Int
nestLevel p c | cBare p || cGetHyperOp p == cAddOpLevel
                          = nL c 0
              | otherwise = error $ "nestLevel: Only for a prime or sum: " ++ show p ++ " when checking: " ++ show c
              where nL