{-# LANGUAGE MagicHash,
             UnboxedTuples, FlexibleInstances #-}

module TokenDef where

import UU.Scanner.Token
import UU.Scanner.GenToken
import UU.Scanner.Position
import UU.Parsing.MachineInterface(Symbol(..))
import Data.Char(isPrint,ord)
import HsToken
import CommonTypes

instance Symbol Token  where
 deleteCost :: Token -> Int#
deleteCost (Reserved String
key Pos
_) = case String
key of
                String
"DATA"         -> Int#
7#
                String
"EXT"          -> Int#
7#
                String
"ATTR"         -> Int#
7#
                String
"SEM"          -> Int#
7#
                String
"USE"          -> Int#
7#
                String
"INCLUDE"      -> Int#
7#
                String
_              -> Int#
5#
 deleteCost (ValToken EnumValToken
v String
_  Pos
_) = case EnumValToken
v of
                EnumValToken
TkError -> Int#
0#
                EnumValToken
_       -> Int#
5#

tokensToStrings :: [HsToken] -> [(Pos,String)]
tokensToStrings :: [HsToken] -> [(Pos, String)]
tokensToStrings
  = forall a b. (a -> b) -> [a] -> [b]
map HsToken -> (Pos, String)
tokenToString

tokenToString :: HsToken -> (Pos, String)
tokenToString :: HsToken -> (Pos, String)
tokenToString HsToken
tk
  = case HsToken
tk of
      AGLocal Identifier
var Pos
pos Maybe String
_        -> (Pos
pos, String
"@" forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
var)
      AGField Identifier
field Identifier
attr Pos
pos Maybe String
_ -> (Pos
pos, String
"@" forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
field forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ Identifier -> String
getName Identifier
attr)
      HsToken String
value Pos
pos        -> (Pos
pos, String
value)
      CharToken String
value Pos
pos      -> (Pos
pos, forall a. Show a => a -> String
show String
value)
      StrToken String
value Pos
pos       -> (Pos
pos, forall a. Show a => a -> String
show String
value)
      Err String
mesg Pos
pos             -> (Pos
pos, String
" ***" forall a. [a] -> [a] -> [a]
++ String
mesg forall a. [a] -> [a] -> [a]
++ String
"*** ")

showTokens :: [(Pos,String)] -> [String]
showTokens :: [(Pos, String)] -> [String]
showTokens [] = []
showTokens [(Pos, String)]
xs = forall a b. (a -> b) -> [a] -> [b]
map [(Pos, String)] -> String
showLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[(Pos, a)]] -> [[(Pos, a)]]
shiftLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [(Pos, a)] -> [[(Pos, a)]]
getLines forall a b. (a -> b) -> a -> b
$ [(Pos, String)]
xs

getLines :: [(Pos, a)] -> [[(Pos, a)]]
getLines :: forall a. [(Pos, a)] -> [[(Pos, a)]]
getLines []         = []
getLines ((Pos
p,a
t):[(Pos, a)]
xs) =       let ([(Pos, a)]
txs,[(Pos, a)]
rest)     = forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall {p} {b}. Position p => (p, b) -> Bool
sameLine [(Pos, a)]
xs
                                sameLine :: (p, b) -> Bool
sameLine (p
q,b
_) = forall p. Position p => p -> Int
line Pos
p forall a. Eq a => a -> a -> Bool
== forall p. Position p => p -> Int
line p
q
                            in ((Pos
p,a
t)forall a. a -> [a] -> [a]
:[(Pos, a)]
txs) forall a. a -> [a] -> [a]
: forall a. [(Pos, a)] -> [[(Pos, a)]]
getLines [(Pos, a)]
rest

shiftLeft :: [[(Pos, a)]] -> [[(Pos, a)]]
shiftLeft :: forall a. [[(Pos, a)]] -> [[(Pos, a)]]
shiftLeft [[(Pos, a)]]
lns =        let sh :: Int
sh = let m :: Int
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Num a => [a] -> [a]
checkEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>=Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall p. Position p => p -> Int
columnforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> a
head) forall a b. (a -> b) -> a -> b
$ [[(Pos, a)]]
lns
                                    checkEmpty :: [a] -> [a]
checkEmpty [] = [a
1]
                                    checkEmpty [a]
x  = [a]
x
                                in if Int
m forall a. Ord a => a -> a -> Bool
>= Int
1 then Int
mforall a. Num a => a -> a -> a
-Int
1 else Int
0
                           shift :: (Pos, b) -> (Pos, b)
shift (Pos
p,b
t) = (if forall p. Position p => p -> Int
column Pos
p forall a. Ord a => a -> a -> Bool
>= Int
1 then case Pos
p of (Pos Int
l Int
c String
f) -> Int -> Int -> String -> Pos
Pos Int
l (Int
c forall a. Num a => a -> a -> a
- Int
sh) String
f else Pos
p, b
t)
                       in forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (Pos, b) -> (Pos, b)
shift) [[(Pos, a)]]
lns

showLine :: [(Pos, [Char])] -> [Char]
showLine :: [(Pos, String)] -> String
showLine [(Pos, String)]
ts =        let f :: (a, String) -> (Int -> String) -> Int -> String
f (a
p,String
t) Int -> String
r = let ct :: Int
ct = forall p. Position p => p -> Int
column a
p
                                     in \Int
c -> Int -> String
spaces (Int
ctforall a. Num a => a -> a -> a
-Int
c) forall a. [a] -> [a] -> [a]
++ String
t forall a. [a] -> [a] -> [a]
++ Int -> String
r (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tforall a. Num a => a -> a -> a
+Int
ct)
                         spaces :: Int -> String
spaces Int
x | Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = String
""
                                  | Bool
otherwise = forall a. Int -> a -> [a]
replicate Int
x Char
' '
                     in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
Position a =>
(a, String) -> (Int -> String) -> Int -> String
f (forall a b. a -> b -> a
const String
"") [(Pos, String)]
ts Int
1

showStrShort :: String -> String
showStrShort :: String -> String
showStrShort String
xs = String
"\"" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
xs forall a. [a] -> [a] -> [a]
++ String
"\""
  where f :: Char -> String
f Char
'"' = String
"\\\""
        f Char
x   = Char -> String
showCharShort' Char
x

showCharShort :: Char -> String
showCharShort :: Char -> String
showCharShort Char
'\'' = String
"'" forall a. [a] -> [a] -> [a]
++ String
"\\'" forall a. [a] -> [a] -> [a]
++ String
"'"
showCharShort Char
c    = String
"'" forall a. [a] -> [a] -> [a]
++ Char -> String
showCharShort' Char
c forall a. [a] -> [a] -> [a]
++ String
"'"

showCharShort' :: Char -> String
showCharShort' :: Char -> String
showCharShort' Char
'\a'  = String
"\\a"
showCharShort' Char
'\b'  = String
"\\b"
showCharShort' Char
'\t'  = String
"\\t"
showCharShort' Char
'\n'  = String
"\\n"
showCharShort' Char
'\r'  = String
"\\r"
showCharShort' Char
'\f'  = String
"\\f"
showCharShort' Char
'\v'  = String
"\\v"
showCharShort' Char
'\\'  = String
"\\\\"
showCharShort' Char
x | Char -> Bool
isPrint Char
x = [Char
x]
                 | Bool
otherwise = Char
'\\' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (Char -> Int
ord Char
x)