-- -----------------------------------------------------------------------------
--
-- Output.hs, part of Alex
--
-- (c) Simon Marlow 2003
--
-- Code-outputting and table-generation routines
--
-- ----------------------------------------------------------------------------}

module Output (outputDFA) where

import AbsSyn
import CharSet
import Util
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap

import Control.Monad.ST ( ST, runST )
import Data.Array ( Array )
import Data.Array.Base ( unsafeRead )
import Data.Array.ST ( STUArray, newArray, readArray, writeArray, freeze )
import Data.Array.Unboxed ( UArray, elems, (!), array, listArray )
import Data.Maybe (isJust)
import Data.Bits
import Data.Char ( ord, chr )
import Data.List ( maximumBy, sortBy, mapAccumR )
import qualified Data.List.NonEmpty as List1

-- -----------------------------------------------------------------------------
-- Printing the output

outputDFA :: Target -> Int -> String -> Scheme -> DFA SNum Code -> ShowS
outputDFA :: Target -> Int -> Code -> Scheme -> DFA Int Code -> ShowS
outputDFA Target
target Int
_ Code
_ Scheme
scheme DFA Int Code
dfa
  = ShowS -> [ShowS] -> ShowS
interleave_shows ShowS
nl
        [ShowS
outputBase, ShowS
outputTable, ShowS
outputCheck, ShowS
outputDefault,
         ShowS
outputAccept, ShowS
outputActions, ShowS
outputSigs]
  where
    ([Int]
base, [Int]
table, [Int]
check, [Int]
deflt, [[Accept Code]]
accept) = DFA Int Code -> ([Int], [Int], [Int], [Int], [[Accept Code]])
mkTables DFA Int Code
dfa

    intty :: Code
intty = case Target
target of
      Target
GhcTarget -> Code
"Int#"
      Target
HaskellTarget -> Code
"Int"

    table_size :: Int
table_size = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
table Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    n_states :: Int
n_states   = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
base Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

    base_nm :: Code
base_nm   = Code
"alex_base"
    table_nm :: Code
table_nm  = Code
"alex_table"
    check_nm :: Code
check_nm  = Code
"alex_check"
    deflt_nm :: Code
deflt_nm  = Code
"alex_deflt"
    accept_nm :: Code
accept_nm = Code
"alex_accept"
    actions_nm :: Code
actions_nm = Code
"alex_actions"

    outputBase :: ShowS
outputBase    = ([Int] -> Code) -> Code -> Int -> [Int] -> ShowS
forall {a}. Show a => ([a] -> Code) -> Code -> Int -> [a] -> ShowS
do_array [Int] -> Code
hexChars32 Code
base_nm  Int
n_states   [Int]
base
    outputTable :: ShowS
outputTable   = ([Int] -> Code) -> Code -> Int -> [Int] -> ShowS
forall {a}. Show a => ([a] -> Code) -> Code -> Int -> [a] -> ShowS
do_array [Int] -> Code
hexChars16 Code
table_nm Int
table_size [Int]
table
    outputCheck :: ShowS
outputCheck   = ([Int] -> Code) -> Code -> Int -> [Int] -> ShowS
forall {a}. Show a => ([a] -> Code) -> Code -> Int -> [a] -> ShowS
do_array [Int] -> Code
hexChars16 Code
check_nm Int
table_size [Int]
check
    outputDefault :: ShowS
outputDefault = ([Int] -> Code) -> Code -> Int -> [Int] -> ShowS
forall {a}. Show a => ([a] -> Code) -> Code -> Int -> [a] -> ShowS
do_array [Int] -> Code
hexChars16 Code
deflt_nm Int
n_states   [Int]
deflt

    formatArray :: String -> Int -> [ShowS] -> ShowS
    formatArray :: Code -> Int -> [ShowS] -> ShowS
formatArray Code
constructFunction Int
size [ShowS]
contents =
        Code -> ShowS
str Code
constructFunction
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" (0 :: Int, " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
size ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"  [ "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> ShowS
interleave_shows (Code -> ShowS
str Code
"\n  , ") [ShowS]
contents
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"\n  ]"

    do_array :: ([a] -> Code) -> Code -> Int -> [a] -> ShowS
do_array [a] -> Code
hex_chars Code
nm Int
upper_bound [a]
ints = -- trace ("do_array: " ++ nm) $
     case Target
target of
      Target
GhcTarget ->
          Code -> ShowS
str Code
nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: AlexAddr\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" = AlexA#\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"  \"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str ([a] -> Code
hex_chars [a]
ints) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"\"#\n"

      Target
_ ->
          Code -> ShowS
str Code
nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int Int\n"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" = "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> Int -> [ShowS] -> ShowS
formatArray Code
"Data.Array.listArray" Int
upper_bound ((a -> ShowS) -> [a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map a -> ShowS
forall a. Show a => a -> ShowS
shows [a]
ints)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl

    outputAccept :: ShowS
    outputAccept :: ShowS
outputAccept =
      -- Don't emit explicit type signature as it contains unknown user type,
      -- see: https://github.com/simonmar/alex/issues/98
      -- str accept_nm . str " :: Array Int (AlexAcc " . str userStateTy . str ")\n"
        Code -> ShowS
str Code
accept_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" = "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> Int -> [ShowS] -> ShowS
formatArray Code
"Data.Array.listArray" Int
n_states ((Int, [ShowS]) -> [ShowS]
forall a b. (a, b) -> b
snd ((Int -> [Accept Code] -> (Int, ShowS))
-> Int -> [[Accept Code]] -> (Int, [ShowS])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR Int -> [Accept Code] -> (Int, ShowS)
outputAccs Int
0 [[Accept Code]]
accept))
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl

    gscanActionType :: Code -> ShowS
gscanActionType Code
res =
        Code -> ShowS
str Code
"AlexPosn -> Char -> String -> Int -> ((Int, state) -> "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
res ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") -> (Int, state) -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
res

    outputActions :: ShowS
outputActions = ShowS
signature ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body
      where
        (Int
nacts, [[ShowS]]
acts) = (Int -> [Accept Code] -> (Int, [ShowS]))
-> Int -> [[Accept Code]] -> (Int, [[ShowS]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR Int -> [Accept Code] -> (Int, [ShowS])
outputActs Int
0 [[Accept Code]]
accept
        actionsArray :: ShowS
        actionsArray :: ShowS
actionsArray = Code -> Int -> [ShowS] -> ShowS
formatArray Code
"Data.Array.array" Int
nacts ([[ShowS]] -> [ShowS]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ShowS]]
acts)
        body :: ShowS
        body :: ShowS
body = Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
actionsArray ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
        signature :: ShowS
        signature :: ShowS
signature = case Scheme
scheme of
          Default { defaultTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
defaultTypeInfo = Just (Maybe Code
Nothing, Code
actionty) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actionty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Default { defaultTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
defaultTypeInfo = Just (Just Code
tyclasses, Code
actionty) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Data.Array.Array Int (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actionty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
gscanTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
gscanTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Data.Array.Array Int ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty,
                  basicTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
basicTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty,
                  basicTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
basicTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Data.Array.Array Int ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
                 posnTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
posnTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
                 posnTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
posnTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Data.Array.Array Int (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
                  monadTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
monadTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
            let
              actintty :: Code
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then Code
"Int64" else Code
"Int"
            in
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: Data.Array.Array Int (AlexInput -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
          Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
                  monadTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
monadTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
            let
              actintty :: Code
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then Code
"Int64" else Code
"Int"
            in
              Code -> ShowS
str Code
actions_nm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Data.Array.Array Int (AlexInput -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
          Scheme
_ ->
              -- No type signature: we don't know what the type of the actions is.
              -- str accept_nm . str " :: Data.Array.Array Int (Accept Code)\n"
              ShowS
forall a. a -> a
id


    outputSigs :: ShowS
outputSigs
        = case Scheme
scheme of
          Default { defaultTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
defaultTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: () -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Default { defaultTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
defaultTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => () -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
gscanTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: () -> AlexInput -> Int -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexReturn (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
gscanTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => () -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
gscanActionType Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty,
                  basicTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
basicTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: () -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty,
                  basicTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
basicTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => () -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
                 posnTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
posnTypeInfo = Just (Maybe Code
Nothing, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: () -> AlexInput -> Int -> AlexReturn (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: AlexInput -> Int -> AlexReturn (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
                 posnTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
posnTypeInfo = Just (Just Code
tyclasses, Code
toktype) } ->
              Code -> ShowS
str Code
"alex_scan_tkn :: () -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => () -> AlexInput -> Int -> AlexReturn (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => AlexInput -> Int -> AlexReturn (AlexPosn -> "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (StrType -> Code
forall a. Show a => a -> Code
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Monad { monadTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
monadTypeInfo = Just (Maybe Code
Nothing, Code
toktype),
                  monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
                  monadUserState :: Scheme -> Bool
monadUserState = Bool
userState } ->
            let
              actintty :: Code
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then Code
"Int64" else Code
"Int"
              userStateTy :: Code
userStateTy | Bool
userState = Code
"AlexUserState"
                          | Bool
otherwise = Code
"()"
            in
              Code -> ShowS
str Code
"alex_scan_tkn :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
userStateTy
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
userStateTy
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexMonadScan :: Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Monad { monadTypeInfo :: Scheme -> Maybe (Maybe Code, Code)
monadTypeInfo = Just (Just Code
tyclasses, Code
toktype),
                  monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
                  monadUserState :: Scheme -> Bool
monadUserState = Bool
userState } ->
            let
              actintty :: Code
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then Code
"Int64" else Code
"Int"
              userStateTy :: Code
userStateTy | Bool
userState = Code
"AlexUserState"
                          | Bool
otherwise = Code
"()"
            in
              Code -> ShowS
str Code
"alex_scan_tkn :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
userStateTy
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
intty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexLastAcc -> (AlexLastAcc, AlexInput)\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScanUser :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
userStateTy ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => AlexInput -> Int -> AlexReturn ("
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
actintty
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" -> Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"))\n"
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"alexMonadScan :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
tyclasses
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
") => Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
toktype ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
")\n"
          Scheme
_ ->
              Code -> ShowS
str Code
""

    outputAccs :: Int -> [Accept Code] -> (Int, ShowS)
    outputAccs :: Int -> [Accept Code] -> (Int, ShowS)
outputAccs Int
idx [] = (Int
idx, Code -> ShowS
str Code
"AlexAccNone")
    outputAccs Int
idx (Acc Int
_ Maybe Code
Nothing Maybe CharSet
Nothing RightContext Int
NoRightContext : [])
      = (Int
idx, Code -> ShowS
str Code
"AlexAccSkip")
    outputAccs Int
idx (Acc Int
_ (Just Code
_) Maybe CharSet
Nothing RightContext Int
NoRightContext : [])
      = (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Code -> ShowS
str Code
"AlexAcc " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (Int -> Code
forall a. Show a => a -> Code
show Int
idx))
    outputAccs Int
idx (Acc Int
_ Maybe Code
Nothing Maybe CharSet
lctx RightContext Int
rctx : [Accept Code]
rest)
      = let (Int
idx', ShowS
rest') = Int -> [Accept Code] -> (Int, ShowS)
outputAccs Int
idx [Accept Code]
rest
        in (Int
idx', Code -> ShowS
str Code
"AlexAccSkipPred" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren (Maybe CharSet -> RightContext Int -> ShowS
forall {a}. Show a => Maybe CharSet -> RightContext a -> ShowS
outputPred Maybe CharSet
lctx RightContext Int
rctx)
                 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren ShowS
rest')
    outputAccs Int
idx (Acc Int
_ (Just Code
_) Maybe CharSet
lctx RightContext Int
rctx : [Accept Code]
rest)
      = let (Int
idx', ShowS
rest') = Int -> [Accept Code] -> (Int, ShowS)
outputAccs Int
idx [Accept Code]
rest
        in (Int
idx' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Code -> ShowS
str Code
"AlexAccPred" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (Int -> Code
forall a. Show a => a -> Code
show Int
idx') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren (Maybe CharSet -> RightContext Int -> ShowS
forall {a}. Show a => Maybe CharSet -> RightContext a -> ShowS
outputPred Maybe CharSet
lctx RightContext Int
rctx)
                      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> ShowS
paren ShowS
rest')

    outputActs :: Int -> [Accept Code] -> (Int, [ShowS])
    outputActs :: Int -> [Accept Code] -> (Int, [ShowS])
outputActs Int
idx =
      let
        outputAct :: a -> Accept Code -> (a, ShowS)
outputAct a
_ (Acc Int
_ Maybe Code
Nothing Maybe CharSet
_ RightContext Int
_) = Code -> (a, ShowS)
forall a. HasCallStack => Code -> a
error Code
"Shouldn't see this"
        outputAct a
inneridx (Acc Int
_ (Just Code
act) Maybe CharSet
_ RightContext Int
_) =
          (a
inneridx a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, ShowS -> ShowS
paren (a -> ShowS
forall a. Show a => a -> ShowS
shows a
inneridx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
"," ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
act))
      in
        (Int -> Accept Code -> (Int, ShowS))
-> Int -> [Accept Code] -> (Int, [ShowS])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR Int -> Accept Code -> (Int, ShowS)
forall {a}. (Num a, Show a) => a -> Accept Code -> (a, ShowS)
outputAct Int
idx ([Accept Code] -> (Int, [ShowS]))
-> ([Accept Code] -> [Accept Code])
-> [Accept Code]
-> (Int, [ShowS])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accept Code -> Bool) -> [Accept Code] -> [Accept Code]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Acc Int
_ Maybe Code
act Maybe CharSet
_ RightContext Int
_) -> Maybe Code -> Bool
forall a. Maybe a -> Bool
isJust Maybe Code
act)

    outputPred :: Maybe CharSet -> RightContext a -> ShowS
outputPred (Just CharSet
set) RightContext a
NoRightContext
        = CharSet -> ShowS
outputLCtx CharSet
set
    outputPred Maybe CharSet
Nothing RightContext a
rctx
        = RightContext a -> ShowS
forall {a}. Show a => RightContext a -> ShowS
outputRCtx RightContext a
rctx
    outputPred (Just CharSet
set) RightContext a
rctx
        = CharSet -> ShowS
outputLCtx CharSet
set
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str Code
" `alexAndPred` "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RightContext a -> ShowS
forall {a}. Show a => RightContext a -> ShowS
outputRCtx RightContext a
rctx

    outputLCtx :: CharSet -> ShowS
outputLCtx CharSet
set = Code -> ShowS
str Code
"alexPrevCharMatches" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code -> ShowS
str (CharSet -> Code
charSetQuote CharSet
set)

    outputRCtx :: RightContext a -> ShowS
outputRCtx RightContext a
NoRightContext = ShowS
forall a. a -> a
id
    outputRCtx (RightContextRExp a
sn)
        = Code -> ShowS
str Code
"alexRightContext " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShowS
forall a. Show a => a -> ShowS
shows a
sn
    outputRCtx (RightContextCode Code
code)
        = Code -> ShowS
str Code
code

    -- outputArr arr
        -- = str "Data.Array.array " . shows (bounds arr) . space
        -- . shows (assocs arr)

-- -----------------------------------------------------------------------------
-- Generating arrays.

-- Here we use the table-compression algorithm described in section
-- 3.9 of the dragon book, which is a common technique used by lexical
-- analyser generators.

-- We want to generate:
--
--    base :: Array SNum Int
--              maps the current state to an offset in the main table
--
--    table :: Array Int SNum
--              maps (base!state + char) to the next state
--
--    check :: Array Int SNum
--              maps (base!state + char) to state if table entry is valid,
--              otherwise we use the default for this state
--
--    default :: Array SNum SNum
--              default production for this state
--
--    accept :: Array SNum [Accept Code]
--              maps state to list of accept codes for this state
--
-- For each state, we decide what will be the default symbol (pick the
-- most common).  We now have a mapping Char -> SNum, with one special
-- state reserved as the default.


mkTables :: DFA SNum Code
         -> (
              [Int],            -- base
              [Int],            -- table
              [Int],            -- check
              [Int],            -- default
              [[Accept Code]]   -- accept
            )
mkTables :: DFA Int Code -> ([Int], [Int], [Int], [Int], [[Accept Code]])
mkTables DFA Int Code
dfa = -- trace (show (defaults)) $
               -- trace (show (fmap (length . snd)  dfa_no_defaults)) $
  ( UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
base_offs,
     Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
max_off (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
table),
     Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
max_off (UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
check),
     UArray Int Int -> [Int]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Int Int
defaults,
     [[Accept Code]]
accept
  )
 where
        accept :: [[Accept Code]]
accept   = [ [Accept Code]
as | State [Accept Code]
as IntMap Int
_ <- Array Int (State Int Code) -> [State Int Code]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems Array Int (State Int Code)
dfa_arr ]

        state_assocs :: [(Int, State Int Code)]
state_assocs = Map Int (State Int Code) -> [(Int, State Int Code)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (DFA Int Code -> Map Int (State Int Code)
forall s a. DFA s a -> Map s (State s a)
dfa_states DFA Int Code
dfa)
        n_states :: Int
n_states = [(Int, State Int Code)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, State Int Code)]
state_assocs
        top_state :: Int
top_state = Int
n_states Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        dfa_arr :: Array SNum (State SNum Code)
        dfa_arr :: Array Int (State Int Code)
dfa_arr = (Int, Int) -> [(Int, State Int Code)] -> Array Int (State Int Code)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0,Int
top_state) [(Int, State Int Code)]
state_assocs

        -- fill in all the error productions
        expand_states :: [[(Int, Int)]]
expand_states =
           [ State Int Code -> [(Int, Int)]
forall {b} {a}. Num b => State b a -> [(Int, b)]
expand (Array Int (State Int Code)
dfa_arrArray Int (State Int Code) -> Int -> State Int Code
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
state) | Int
state <- [Int
0..Int
top_state] ]

        expand :: State b a -> [(Int, b)]
expand (State [Accept a]
_ IntMap b
out) =
           [(Int
i, IntMap b -> Int -> b
forall {a}. Num a => IntMap a -> Int -> a
lookup' IntMap b
out Int
i) | Int
i <- [Int
0..Int
0xff]]
           where lookup' :: IntMap a -> Int -> a
lookup' IntMap a
out' Int
i = case Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap a
out' of
                                        Maybe a
Nothing -> -a
1
                                        Just a
s  -> a
s

        defaults :: UArray SNum SNum
        defaults :: UArray Int Int
defaults = (Int, Int) -> [Int] -> UArray Int Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
top_state) (([(Int, Int)] -> Int) -> [[(Int, Int)]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, Int)] -> Int
best_default [[(Int, Int)]]
expand_states)

        -- find the most common destination state in a given state, and
        -- make it the default.
        best_default :: [(Int,SNum)] -> SNum
        best_default :: [(Int, Int)] -> Int
best_default [(Int, Int)]
prod_list
           | [(Int, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, Int)]
sorted = -Int
1
           | Bool
otherwise   = (Int, Int) -> Int
forall a b. (a, b) -> b
snd (NonEmpty (Int, Int) -> (Int, Int)
forall a. NonEmpty a -> a
List1.head ((NonEmpty (Int, Int) -> NonEmpty (Int, Int) -> Ordering)
-> [NonEmpty (Int, Int)] -> NonEmpty (Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy NonEmpty (Int, Int) -> NonEmpty (Int, Int) -> Ordering
forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
t a -> t a -> Ordering
lengths [NonEmpty (Int, Int)]
eq))
           where sorted :: [(Int, Int)]
sorted  = ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, Int) -> (Int, Int) -> Ordering
forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
compareSnds [(Int, Int)]
prod_list
                 compareSnds :: (a, a) -> (a, a) -> Ordering
compareSnds (a
_,a
a) (a
_,a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
                 eq :: [NonEmpty (Int, Int)]
eq = ((Int, Int) -> (Int, Int) -> Bool)
-> [(Int, Int)] -> [NonEmpty (Int, Int)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
List1.groupBy (\(Int
_,Int
a) (Int
_,Int
b) -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b) [(Int, Int)]
sorted
                 lengths :: t a -> t a -> Ordering
lengths  t a
a t a
b = t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
b

        -- remove all the default productions from the DFA
        dfa_no_defaults :: [(Int, [(Int, Int)])]
dfa_no_defaults =
          [ (Int
s, Int -> [(Int, Int)] -> [(Int, Int)]
forall {a} {a}.
(Integral a, Num a) =>
Int -> [(a, Int)] -> [(a, Int)]
prods_without_defaults Int
s [(Int, Int)]
out)
          | (Int
s, [(Int, Int)]
out) <- [Int] -> [[(Int, Int)]] -> [(Int, [(Int, Int)])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [[(Int, Int)]]
expand_states
          ]

        prods_without_defaults :: Int -> [(a, Int)] -> [(a, Int)]
prods_without_defaults Int
s [(a, Int)]
out
          = [ (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
c, Int
dest) | (a
c,Int
dest) <- [(a, Int)]
out, Int
dest Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= UArray Int Int
defaultsUArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!Int
s ]

        (UArray Int Int
base_offs, UArray Int Int
table, UArray Int Int
check, Int
max_off)
           = (forall s.
 ST s (UArray Int Int, UArray Int Int, UArray Int Int, Int))
-> (UArray Int Int, UArray Int Int, UArray Int Int, Int)
forall a. (forall s. ST s a) -> a
runST (Int
-> Int
-> [(Int, [(Int, Int)])]
-> ST s (UArray Int Int, UArray Int Int, UArray Int Int, Int)
forall s.
Int
-> Int
-> [(Int, [(Int, Int)])]
-> ST s (UArray Int Int, UArray Int Int, UArray Int Int, Int)
genTables Int
n_states Int
255 [(Int, [(Int, Int)])]
dfa_no_defaults)


genTables
         :: Int                         -- number of states
         -> Int                         -- maximum token no.
         -> [(SNum,[(Int,SNum)])]       -- entries for the table
         -> ST s (UArray Int Int,       -- base
                  UArray Int Int,       -- table
                  UArray Int Int,       -- check
                  Int                   -- highest offset in table
            )

genTables :: forall s.
Int
-> Int
-> [(Int, [(Int, Int)])]
-> ST s (UArray Int Int, UArray Int Int, UArray Int Int, Int)
genTables Int
n_states Int
max_token [(Int, [(Int, Int)])]
entries = do

  STUArray s Int Int
base       <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
n_statesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0
  STUArray s Int Int
table      <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
mAX_TABLE_SIZE) Int
0
  STUArray s Int Int
check      <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
mAX_TABLE_SIZE) (-Int
1)
  STUArray s Int Int
off_arr    <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (-Int
max_token, Int
mAX_TABLE_SIZE) Int
0

  Int
max_off    <- STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, [(Int, Int)])]
-> Int
-> ST s Int
forall s.
STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, [(Int, Int)])]
-> Int
-> ST s Int
genTables' STUArray s Int Int
base STUArray s Int Int
table STUArray s Int Int
check STUArray s Int Int
off_arr [(Int, [(Int, Int)])]
entries Int
max_token

  UArray Int Int
base'      <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
base
  UArray Int Int
table'     <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
table
  UArray Int Int
check'     <- STUArray s Int Int -> ST s (UArray Int Int)
forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
freeze STUArray s Int Int
check
  (UArray Int Int, UArray Int Int, UArray Int Int, Int)
-> ST s (UArray Int Int, UArray Int Int, UArray Int Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Int
base', UArray Int Int
table',UArray Int Int
check',Int
max_offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

  where mAX_TABLE_SIZE :: Int
mAX_TABLE_SIZE = Int
n_states Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
max_token Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)


genTables'
         :: STUArray s Int Int          -- base
         -> STUArray s Int Int          -- table
         -> STUArray s Int Int          -- check
         -> STUArray s Int Int          -- offset array
         -> [(SNum,[(Int,SNum)])]       -- entries for the table
         -> Int                         -- maximum token no.
         -> ST s Int                    -- highest offset in table

genTables' :: forall s.
STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, [(Int, Int)])]
-> Int
-> ST s Int
genTables' STUArray s Int Int
base STUArray s Int Int
table STUArray s Int Int
check STUArray s Int Int
off_arr [(Int, [(Int, Int)])]
entries Int
max_token
        = [(Int, [(Int, Int)])] -> Int -> Int -> ST s Int
fit_all [(Int, [(Int, Int)])]
entries Int
0 Int
1
  where

         fit_all :: [(Int, [(Int, Int)])] -> Int -> Int -> ST s Int
fit_all [] Int
max_off Int
_ = Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
max_off
         fit_all ((Int, [(Int, Int)])
s:[(Int, [(Int, Int)])]
ss) Int
max_off Int
fst_zero = do
           (Int
off, Int
new_max_off, Int
new_fst_zero) <- (Int, [(Int, Int)]) -> Int -> Int -> ST s (Int, Int, Int)
fit (Int, [(Int, Int)])
s Int
max_off Int
fst_zero
           STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
off_arr Int
off Int
1
           [(Int, [(Int, Int)])] -> Int -> Int -> ST s Int
fit_all [(Int, [(Int, Int)])]
ss Int
new_max_off Int
new_fst_zero

         -- fit a vector into the table.  Return the offset of the vector,
         -- the maximum offset used in the table, and the offset of the first
         -- entry in the table (used to speed up the lookups a bit).
         fit :: (Int, [(Int, Int)]) -> Int -> Int -> ST s (Int, Int, Int)
fit (Int
_,[]) Int
max_off Int
fst_zero = (Int, Int, Int) -> ST s (Int, Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0,Int
max_off,Int
fst_zero)

         fit (Int
state_no, state :: [(Int, Int)]
state@((Int
t,Int
_):[(Int, Int)]
_)) Int
max_off Int
fst_zero = do
                 -- start at offset 1 in the table: all the empty states
                 -- (states with just a default reduction) are mapped to
                 -- offset zero.
           Int
off <- Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
findFreeOffset (-Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fst_zero) STUArray s Int Int
check STUArray s Int Int
off_arr [(Int, Int)]
state
           let new_max_off :: Int
new_max_off | Int
furthest_right Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
max_off = Int
furthest_right
                           | Bool
otherwise                = Int
max_off
               furthest_right :: Int
furthest_right = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
max_token

           --trace ("fit: state " ++ show state_no ++ ", off " ++ show off ++ ", elems " ++ show state) $ do

           STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
base Int
state_no Int
off
           Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s ()
forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s ()
addState Int
off STUArray s Int Int
table STUArray s Int Int
check [(Int, Int)]
state
           Int
new_fst_zero <- STUArray s Int Int -> Int -> ST s Int
forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
check Int
fst_zero
           (Int, Int, Int) -> ST s (Int, Int, Int)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
off, Int
new_max_off, Int
new_fst_zero)


-- Find a valid offset in the table for this state.
findFreeOffset :: Int
               -> STUArray s Int Int
               -> STUArray s Int Int
               -> [(Int, Int)]
               -> ST s Int
findFreeOffset :: forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
findFreeOffset Int
off STUArray s Int Int
check STUArray s Int Int
off_arr [(Int, Int)]
state = do

  -- offset 0 isn't allowed
  if Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then ST s Int
try_next else do

    -- don't use an offset we've used before
    Int
b <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
off_arr Int
off
    if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then ST s Int
try_next else do

      -- check whether the actions for this state fit in the table
      Bool
ok <- Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
fits Int
off [(Int, Int)]
state STUArray s Int Int
check
      if Bool
ok then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
off else ST s Int
try_next
  where
    try_next :: ST s Int
try_next = Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s Int
findFreeOffset (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) STUArray s Int Int
check STUArray s Int Int
off_arr [(Int, Int)]
state

-- This is an inner loop, so we use some strictness hacks, and avoid
-- array bounds checks (unsafeRead instead of readArray) to speed
-- things up a bit.
fits :: Int -> [(Int,Int)] -> STUArray s Int Int -> ST s Bool
fits :: forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
fits Int
off [] STUArray s Int Int
check = Int
off Int -> ST s Bool -> ST s Bool
forall a b. a -> b -> b
`seq` STUArray s Int Int
check STUArray s Int Int -> ST s Bool -> ST s Bool
forall a b. a -> b -> b
`seq` Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True -- strictness hacks
fits Int
off ((Int
t,Int
_):[(Int, Int)]
rest) STUArray s Int Int
check = do
  Int
i <- STUArray s Int Int -> Int -> ST s Int
forall i. Ix i => STUArray s i Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int
check (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t)
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 then Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
             else Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
forall s. Int -> [(Int, Int)] -> STUArray s Int Int -> ST s Bool
fits Int
off [(Int, Int)]
rest STUArray s Int Int
check

addState :: Int -> STUArray s Int Int -> STUArray s Int Int -> [(Int, Int)]
         -> ST s ()
addState :: forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s ()
addState Int
_   STUArray s Int Int
_     STUArray s Int Int
_     [] = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
addState Int
off STUArray s Int Int
table STUArray s Int Int
check ((Int
t,Int
val):[(Int, Int)]
state) = do
   STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
table (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t) Int
val
   STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
check (Int
offInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t) Int
t
   Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s ()
forall s.
Int
-> STUArray s Int Int
-> STUArray s Int Int
-> [(Int, Int)]
-> ST s ()
addState Int
off STUArray s Int Int
table STUArray s Int Int
check [(Int, Int)]
state

findFstFreeSlot :: STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot :: forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
table Int
n = do
         Int
i <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
table Int
n
         if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                    else STUArray s Int Int -> Int -> ST s Int
forall s. STUArray s Int Int -> Int -> ST s Int
findFstFreeSlot STUArray s Int Int
table (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-----------------------------------------------------------------------------
-- Convert an integer to a 16-bit number encoded in \xNN\xNN format suitable
-- for placing in a string (copied from Happy's ProduceCode.lhs)

hexChars16 :: [Int] -> String
hexChars16 :: [Int] -> Code
hexChars16 [Int]
acts = [Code] -> Code
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> Code) -> [Int] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Code
conv16 [Int]
acts)
  where
    conv16 :: Int -> Code
conv16 Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0x7fff Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< -Int
0x8000
                = ShowS
forall a. HasCallStack => Code -> a
error (Code
"Internal error: hexChars16: out of range: " Code -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Code
forall a. Show a => a -> Code
show Int
i)
             | Bool
otherwise
                = Int -> Code
hexChar16 Int
i

hexChars32 :: [Int] -> String
hexChars32 :: [Int] -> Code
hexChars32 [Int]
acts = [Code] -> Code
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Int -> Code) -> [Int] -> [Code]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Code
conv32 [Int]
acts)
  where
    conv32 :: Int -> Code
conv32 Int
i = Int -> Code
hexChar16 (Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff) Code -> ShowS
forall a. [a] -> [a] -> [a]
++
                Int -> Code
hexChar16 ((Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xffff)

hexChar16 :: Int -> String
hexChar16 :: Int -> Code
hexChar16 Int
i = Int -> Code
toHex (Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)
                 Code -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Code
toHex ((Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)  -- force little-endian

toHex :: Int -> String
toHex :: Int -> Code
toHex Int
i = [Char
'\\',Char
'x', Int -> Char
hexDig (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16), Int -> Char
hexDig (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
16)]

hexDig :: Int -> Char
hexDig :: Int -> Char
hexDig Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9    = Int -> Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'0')
         | Bool
otherwise = Int -> Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a')