-- |
-- Module      : CAS.Dumb.Symbols.ASCII
-- Copyright   : (c) Justus Sagemüller 2017
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
-- Single-letter variable symbols.
--
-- Defining such variables on the top level, while convenient for brevity, is a bit
-- troublesome because such are often used as local variables in Haskell code. It is
-- recommended to use "CAS.Dumb.Symbols.Unicode.MathLatin_RomanGreek__BopomofoGaps"
-- instead of this module.

{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE CPP                   #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UnicodeSyntax         #-}

module CAS.Dumb.Symbols.ASCII (
          module CAS.Dumb.Symbols
        , ASCII, Symbol, Expression, Pattern
        -- * “Constant variable” symbols
        -- ** Lowercase letters
        , a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z
        -- ** Uppercase letters
        -- $uppercaseCaveat
#if __GLASGOW_HASKELL__ > 801
        , pattern A, pattern B, pattern C, pattern D, pattern E, pattern F, pattern G, pattern H, pattern I, pattern J, pattern K, pattern L, pattern M, pattern N, pattern O, pattern P, pattern Q, pattern R, pattern S, pattern T, pattern U, pattern V, pattern W, pattern X, pattern Y, pattern Z
#endif
        -- * Pattern-matching variable symbols
        , _a,_b,_c,_d,_e,_f,_g,_h,_i,_j,_k,_l,_m,_n,_o,_p,_q,_r,_s,_t,_u,_v,_w,_x,_y,_z
        -- * Auxiliary
        , Expression', ASCIISymbols(..)
        ) where

import CAS.Dumb.Tree
import CAS.Dumb.Symbols
import CAS.Dumb.Symbols.PatternGenerator

import Data.Void
import Data.Monoid
import Control.Arrow

data ASCII
instance SymbolClass ASCII where
  type SCConstraint ASCII = ASCIISymbols
  fromCharSymbol :: forall (p :: * -> *) c.
(Functor p, SCConstraint ASCII c) =>
p ASCII -> Char -> c
fromCharSymbol p ASCII
_ = forall c. ASCIISymbols c => Char -> c
fromASCIISymbol

type Symbol = SymbolD ASCII
type Expression' γ s² s¹ c = CAS' γ s² s¹ (Symbol c)
type Expression c = Expression' Void (Infix c) (Encapsulation c) c
type Pattern c = Expression' GapId (Infix c) (Encapsulation c) c


instance Unwieldy c => Unwieldy (Symbol c) where
  unwieldiness :: Symbol c -> Unwieldiness
unwieldiness (NatSymbol Integer
i) = Unwieldiness
0.24127 forall a. Num a => a -> a -> a
+ forall a. Num a => Integer -> a
fromInteger (forall a. Num a => a -> a
abs Integer
i)
  unwieldiness (PrimitiveSymbol Char
c)
    | Char
cforall a. Ord a => a -> a -> Bool
>=Char
'a' Bool -> Bool -> Bool
&& Char
cforall a. Ord a => a -> a -> Bool
<=Char
'z'  = Unwieldiness
1.17236 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> GapId
fromEnum Char
'z' forall a. Num a => a -> a -> a
- GapId
ucp)forall a. Fractional a => a -> a -> a
/Unwieldiness
49.4530
    | Char
cforall a. Ord a => a -> a -> Bool
>=Char
'A' Bool -> Bool -> Bool
&& Char
cforall a. Ord a => a -> a -> Bool
<=Char
'Z'  = Unwieldiness
1.17211 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> GapId
fromEnum Char
'Z' forall a. Num a => a -> a -> a
- GapId
ucp)forall a. Fractional a => a -> a -> a
/Unwieldiness
49.4571
    | Bool
otherwise         = Unwieldiness
1.24551 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral GapId
ucp forall a. Fractional a => a -> a -> a
/ Unwieldiness
52792.42
                                  forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (GapId
ucpforall a. Integral a => a -> a -> a
`mod`GapId
136)forall a. Fractional a => a -> a -> a
/Unwieldiness
9722.3
   where ucp :: GapId
ucp = forall a. Enum a => a -> GapId
fromEnum Char
c
  unwieldiness (StringSymbol c
s) = forall e. Unwieldy e => e -> Unwieldiness
unwieldiness c
s

makeSymbols ''Expression' ['a'..'z']

_a,_b,_c,_d,_e,_f,_g,_h,_i,_j,_k,_l,_m,_n,_o,_p,_q,_r,_s,_t,_u,_v,_w,_x,_y,_z
    :: CAS' GapId s² s¹ s⁰
[CAS' GapId s² s¹ s⁰
_a,CAS' GapId s² s¹ s⁰
_b,CAS' GapId s² s¹ s⁰
_c,CAS' GapId s² s¹ s⁰
_d,CAS' GapId s² s¹ s⁰
_e,CAS' GapId s² s¹ s⁰
_f,CAS' GapId s² s¹ s⁰
_g,CAS' GapId s² s¹ s⁰
_h,CAS' GapId s² s¹ s⁰
_i,CAS' GapId s² s¹ s⁰
_j,CAS' GapId s² s¹ s⁰
_k,CAS' GapId s² s¹ s⁰
_l,CAS' GapId s² s¹ s⁰
_m,CAS' GapId s² s¹ s⁰
_n,CAS' GapId s² s¹ s⁰
_o,CAS' GapId s² s¹ s⁰
_p,CAS' GapId s² s¹ s⁰
_q,CAS' GapId s² s¹ s⁰
_r,CAS' GapId s² s¹ s⁰
_s,CAS' GapId s² s¹ s⁰
_t,CAS' GapId s² s¹ s⁰
_u,CAS' GapId s² s¹ s⁰
_v,CAS' GapId s² s¹ s⁰
_w,CAS' GapId s² s¹ s⁰
_x,CAS' GapId s² s¹ s⁰
_y,CAS' GapId s² s¹ s⁰
_z]
    = forall γ s² s¹ s⁰. γ -> CAS' γ s² s¹ s⁰
Gap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> GapId
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a'..Char
'z']

-- $uppercaseCaveat
-- These are only available in GHC>8.2. The ability to use uppercase letters as variables
-- hinges on a hack using GHC's still recent
-- <https://ghc.haskell.org/trac/ghc/wiki/PatternSynonyms pattern synonyms> feature.
--
-- You can use the "CAS.Dumb.Symbols.ASCII.Qualified"
-- module if this causes you any trouble; there, all symbols are prefixed with
-- @sym@ and therefore the uppercase ones are still normal lowercase names
-- in the Haskell code.
#if __GLASGOW_HASKELL__ > 801
makeSymbols ''Expression' ['A'..'Z']
#endif

instance (ASCIISymbols c, RenderableEncapsulations c)
      => Show (CAS (Infix c) (Encapsulation c) (Symbol c)) where
  showsPrec :: GapId -> CAS (Infix c) (Encapsulation c) (Symbol c) -> ShowS
showsPrec GapId
p = forall c σ.
(ASCIISymbols c, SymbolClass σ, SCConstraint σ c) =>
GapId -> AlgebraExpr σ c -> ShowS
showsPrecASCIISymbol GapId
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c σ γ.
(RenderableEncapsulations c, SymbolClass σ, SCConstraint σ c) =>
CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)
-> CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)
fixateAlgebraEncaps
   where 
instance ∀ c . (ASCIISymbols c, RenderableEncapsulations c, Monoid c)
       => Show (CAS' GapId (Infix c) (Encapsulation c) (Symbol c)) where
  showsPrec :: GapId -> CAS' GapId (Infix c) (Encapsulation c) (Symbol c) -> ShowS
showsPrec GapId
p = forall c σ.
(ASCIISymbols c, SymbolClass σ, SCConstraint σ c) =>
GapId -> AlgebraExpr σ c -> ShowS
showsPrecASCIISymbol GapId
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c σ γ.
(RenderableEncapsulations c, SymbolClass σ, SCConstraint σ c) =>
CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)
-> CAS' γ (Infix c) (Encapsulation c) (SymbolD σ c)
fixateAlgebraEncaps
   where purgeGaps :: CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps (Symbol Symbol c
s) = forall γ s² s¹ s⁰. s⁰ -> CAS' γ s² s¹ s⁰
Symbol Symbol c
s
         purgeGaps (Function Encapsulation c
f CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
e) = forall γ s² s¹ s⁰. s¹ -> CAS' γ s² s¹ s⁰ -> CAS' γ s² s¹ s⁰
Function Encapsulation c
f forall a b. (a -> b) -> a -> b
$ CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
e
         purgeGaps (Operator Infix c
o CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
x CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
y) = forall γ s² s¹ s⁰.
s² -> CAS' γ s² s¹ s⁰ -> CAS' γ s² s¹ s⁰ -> CAS' γ s² s¹ s⁰
Operator Infix c
o (CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
x) (CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
y)
         purgeGaps (OperatorChain CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
x [(Infix c, CAS' GapId (Infix c) (Encapsulation c) (Symbol c))]
ys) = forall γ s² s¹ s⁰.
CAS' γ s² s¹ s⁰ -> [(s², CAS' γ s² s¹ s⁰)] -> CAS' γ s² s¹ s⁰
OperatorChain (CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGaps CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
x) (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second CAS' GapId (Infix c) (Encapsulation c) (Symbol c)
-> AlgebraExpr ASCII c
purgeGapsforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(Infix c, CAS' GapId (Infix c) (Encapsulation c) (Symbol c))]
ys)
         purgeGaps (Gap GapId
gid) = forall γ s² s¹ s⁰. s⁰ -> CAS' γ s² s¹ s⁰
Symbol (forall σ c. c -> SymbolD σ c
StringSymbol forall a b. (a -> b) -> a -> b
$ forall c. ASCIISymbols c => Char -> c
fromASCIISymbol Char
'_'
                                                    forall a. Semigroup a => a -> a -> a
<>forall c. ASCIISymbols c => Char -> c
fromASCIISymbol (forall a. Enum a => GapId -> a
toEnum GapId
gid) )
                              :: (CAS (Infix c) (Encapsulation c) (Symbol c))