{-# OPTIONS -fallow-incoherent-instances #-}

module Autolib.Symbol where

import Autolib.ToDoc
import Autolib.Reader
import Text.ParserCombinators.Parsec.Expr 

import Data.Maybe ( isJust )
import Autolib.Set
import Autolib.Hash
import Autolib.Util.Size

import GHC.Int ( Int16 )

class ( Size s, Hash s, Eq s, Ord s, ToDoc s, Show s, Reader s ) 
      => Symbol s where
    arity :: s -> Int
    arity s
s = Int
1

    set_arity :: Int -> s -> s
    set_arity Int
a s
s = [Char] -> s
forall a. HasCallStack => [Char] -> a
error [Char]
"Symbol.set_arity undefined"

    -- | default: not as operator, i. e. prefix notation with parentheses
    -- if @Just p@, then for binary ops: use infix notation;
    -- for unary ops, use prefix notation without parentheses
    -- (allows  "! ! x")
    precedence :: s -> Maybe Int
    precedence s
_ = Maybe Int
forall a. Maybe a
Nothing 

    assoc :: s -> Assoc
    assoc s
_ = Assoc
AssocNone

    pool :: [ s ]
    pool = [Char] -> [s]
forall a. HasCallStack => [Char] -> a
error [Char]
"Symbol.pool undefined"

    symbol_toDoc :: s -> Doc
    symbol_toDoc = s -> Doc
forall a. ToDoc a => a -> Doc
toDoc

    symbol_reader :: Parser s
    symbol_reader = Parser s
forall a. Reader a => Parser a
atomic_reader

    -- | use to create a directory name
    stringify :: [ s ] -> String
    stringify = [Char] -> [s] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Symbol.stringify not implemented"

    -- | used for SRS output
    toDoc_list :: [ s ] -> Doc
    toDoc_list = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([s] -> [Doc]) -> [s] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> Doc) -> [s] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map s -> Doc
forall a. ToDoc a => a -> Doc
toDoc 


unused :: Symbol s
       => Int -> Set s -> [s]
unused :: forall s. Symbol s => Int -> Set s -> [s]
unused Int
n Set s
cs =
        let fs :: [s]
fs = (s -> Bool) -> [s] -> [s]
forall a. (a -> Bool) -> [a] -> [a]
filter ( \ s
c -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ s
c s -> Set s -> Bool
forall {a}. Ord a => a -> Set a -> Bool
`elementOf` Set s
cs ) [s]
forall s. Symbol s => [s]
pool
        in  if [s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [s]
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n 
            then [Char] -> [s]
forall a. HasCallStack => [Char] -> a
error [Char]
"no more unused symbols available"
            else Int -> [s] -> [s]
forall a. Int -> [a] -> [a]
take Int
n [s]
fs

-- | unary: omit parens around argument
-- binary: use infix notation
is_operator :: Symbol s => s -> Bool
is_operator :: forall s. Symbol s => s -> Bool
is_operator s
s = s -> Bool
forall s. Symbol s => s -> Bool
is_binary_operator s
s Bool -> Bool -> Bool
|| s -> Bool
forall s. Symbol s => s -> Bool
is_unary_operator s
s

is_binary_operator :: Symbol s => s -> Bool
is_binary_operator :: forall s. Symbol s => s -> Bool
is_binary_operator s
s = 
    ( Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall s. Symbol s => s -> Int
arity s
s ) Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ( s -> Maybe Int
forall s. Symbol s => s -> Maybe Int
precedence s
s )

is_unary_operator  :: Symbol s => s -> Bool
is_unary_operator :: forall s. Symbol s => s -> Bool
is_unary_operator s
s = 
    ( Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== s -> Int
forall s. Symbol s => s -> Int
arity s
s ) Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust ( s -> Maybe Int
forall s. Symbol s => s -> Maybe Int
precedence s
s )

is_constant :: Symbol s => s -> Bool
is_constant :: forall s. Symbol s => s -> Bool
is_constant = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (s -> Int) -> s -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Int
forall s. Symbol s => s -> Int
arity

------------------------------------------------------------------------

instance Symbol () 

{-
instance ( HeightC h, Show a, Symbol a ) => Symbol (Aged h a) where
    arity = arity . it
    set_arity a = itmap (set_arity a)  
-}

instance Symbol Char where
    arity :: Char -> Int
arity Char
c = Int
1
    symbol_toDoc :: Char -> Doc
symbol_toDoc = Char -> Doc
forall {a}. IsString a => Char -> Type a
Autolib.ToDoc.char
    symbol_reader :: Parser Char
symbol_reader = Parser Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum
    pool :: [Char]
pool = [ Char
'#', Char
'%' ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z' ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z' ] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [ Char
'0' .. Char
'9' ]
    stringify :: [Char] -> [Char]
stringify  = [Char] -> [Char]
forall a. a -> a
id
    toDoc_list :: [Char] -> Doc
toDoc_list = [Char] -> Doc
text

instance Symbol Int where
    pool :: [Int]
pool = [ Int
0 .. ]

instance ( Symbol a, Symbol b ) => Symbol (a, b)

instance Symbol Bool where  pool :: [Bool]
pool = [ Bool
False, Bool
True ]
instance Size Bool where size :: Bool -> Int
size Bool
_ = Int
1

{-
instance ( Size h, HeightC h ) => Symbol h
-}