-- -----------------------------------------------------------------------------
--
-- AbsSyn.hs, part of Alex
--
-- (c) Chris Dornan 1995-2000, Simon Marlow 2003
--
-- This module provides a concrete representation for regular expressions and
-- scanners.  Scanners are used for tokenising files in preparation for parsing.
--
-- ----------------------------------------------------------------------------}

module AbsSyn (
  Code, Directive(..), Scheme(..),
  wrapperCppDefs,
  Scanner(..),
  RECtx(..),
  RExp(..), nullable,
  DFA(..), State(..), SNum, StartCode, Accept(..),
  RightContext(..), showRCtx,
  encodeStartCodes, extractActions,
  Target(..),
  UsesPreds(..), usesPreds,
  StrType(..)
  ) where

import CharSet     ( CharSet, Encoding )
import Data.Maybe  ( fromJust )
import Data.Map    ( Map )
import Data.IntMap ( IntMap )
import Util        ( str, nl )
import qualified Data.Map as Map
import qualified Data.Set as Set

infixl 4 :||
infixl 5 :%%

-- -----------------------------------------------------------------------------
-- Abstract Syntax for Alex scripts

type Code = String

data Directive
   = WrapperDirective String            -- use this wrapper
   | EncodingDirective Encoding         -- use this encoding
   | ActionType String                  -- Type signature of actions,
                                        -- with optional typeclasses
   | TypeClass String
   | TokenType String
   deriving StartCode -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
(StartCode -> Directive -> ShowS)
-> (Directive -> String)
-> ([Directive] -> ShowS)
-> Show Directive
forall a.
(StartCode -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StartCode -> Directive -> ShowS
showsPrec :: StartCode -> Directive -> ShowS
$cshow :: Directive -> String
show :: Directive -> String
$cshowList :: [Directive] -> ShowS
showList :: [Directive] -> ShowS
Show

data StrType = Str | Lazy | Strict | StrictText
  deriving StrType -> StrType -> Bool
(StrType -> StrType -> Bool)
-> (StrType -> StrType -> Bool) -> Eq StrType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrType -> StrType -> Bool
== :: StrType -> StrType -> Bool
$c/= :: StrType -> StrType -> Bool
/= :: StrType -> StrType -> Bool
Eq

instance Show StrType where
  show :: StrType -> String
show StrType
Str = String
"String"
  show StrType
Lazy = String
"ByteString.ByteString"
  show StrType
Strict = String
"ByteString.ByteString"
  show StrType
StrictText = String
"Data.Text.Text"

data Scheme
  = Default { Scheme -> Maybe (Maybe String, String)
defaultTypeInfo :: Maybe (Maybe String, String) }
  | GScan { Scheme -> Maybe (Maybe String, String)
gscanTypeInfo :: Maybe (Maybe String, String) }
  | Basic { Scheme -> StrType
basicStrType :: StrType,
            Scheme -> Maybe (Maybe String, String)
basicTypeInfo :: Maybe (Maybe String, String) }
  | Posn { Scheme -> StrType
posnStrType :: StrType,
           Scheme -> Maybe (Maybe String, String)
posnTypeInfo :: Maybe (Maybe String, String) }
  | Monad { Scheme -> StrType
monadStrType :: StrType,
            Scheme -> Bool
monadUserState :: Bool,
            Scheme -> Maybe (Maybe String, String)
monadTypeInfo :: Maybe (Maybe String, String) }

wrapperCppDefs :: Scheme -> Maybe [String]
wrapperCppDefs :: Scheme -> Maybe [String]
wrapperCppDefs Default {} = Maybe [String]
forall a. Maybe a
Nothing
wrapperCppDefs GScan {} = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_GSCAN"]
wrapperCppDefs Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
Str } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_BASIC"]
wrapperCppDefs Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
Lazy } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_BASIC_BYTESTRING"]
wrapperCppDefs Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
Strict } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_STRICT_BYTESTRING"]
wrapperCppDefs Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
StrictText } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_STRICT_TEXT"]
wrapperCppDefs Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
Str } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_POSN"]
wrapperCppDefs Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
Lazy } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_POSN_BYTESTRING"]
wrapperCppDefs Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
Strict } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_POSN_BYTESTRING"]
wrapperCppDefs Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
StrictText } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_POSN_STRICT_TEXT"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Str,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
False } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Strict,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
False } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_BYTESTRING"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Lazy,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
False } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_BYTESTRING"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
StrictText,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
False } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_STRICT_TEXT"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Str,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
True } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD", String
"ALEX_MONAD_USER_STATE"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Strict,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
True } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_BYTESTRING", String
"ALEX_MONAD_USER_STATE"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
Lazy,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
True } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_BYTESTRING", String
"ALEX_MONAD_USER_STATE"]
wrapperCppDefs Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
StrictText,
                       monadUserState :: Scheme -> Bool
monadUserState = Bool
True } = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String
"ALEX_MONAD_STRICT_TEXT", String
"ALEX_MONAD_USER_STATE"]

-- TODO: update this comment
--
-- A `Scanner' consists of an association list associating token names with
-- regular expressions with context.  The context may include a list of start
-- codes, some leading context to test the character immediately preceding the
-- token and trailing context to test the residual input after the token.
--
-- The start codes consist of the names and numbers of the start codes;
-- initially the names only will be generated by the parser, the numbers being
-- allocated at a later stage.  Start codes become meaningful when scanners are
-- converted to DFAs; see the DFA section of the Scan module for details.

data Scanner = Scanner { Scanner -> String
scannerName   :: String,
                         Scanner -> [RECtx]
scannerTokens :: [RECtx] }
  deriving StartCode -> Scanner -> ShowS
[Scanner] -> ShowS
Scanner -> String
(StartCode -> Scanner -> ShowS)
-> (Scanner -> String) -> ([Scanner] -> ShowS) -> Show Scanner
forall a.
(StartCode -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: StartCode -> Scanner -> ShowS
showsPrec :: StartCode -> Scanner -> ShowS
$cshow :: Scanner -> String
show :: Scanner -> String
$cshowList :: [Scanner] -> ShowS
showList :: [Scanner] -> ShowS
Show

data RECtx = RECtx { RECtx -> [(String, StartCode)]
reCtxStartCodes :: [(String,StartCode)],
                     RECtx -> Maybe CharSet
reCtxPreCtx     :: Maybe CharSet,
                     RECtx -> RExp
reCtxRE         :: RExp,
                     RECtx -> RightContext RExp
reCtxPostCtx    :: RightContext RExp,
                     RECtx -> Maybe String
reCtxCode       :: Maybe Code
                   }

data RightContext r
  = NoRightContext
  | RightContextRExp r
  | RightContextCode Code
  deriving (RightContext r -> RightContext r -> Bool
(RightContext r -> RightContext r -> Bool)
-> (RightContext r -> RightContext r -> Bool)
-> Eq (RightContext r)
forall r. Eq r => RightContext r -> RightContext r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall r. Eq r => RightContext r -> RightContext r -> Bool
== :: RightContext r -> RightContext r -> Bool
$c/= :: forall r. Eq r => RightContext r -> RightContext r -> Bool
/= :: RightContext r -> RightContext r -> Bool
Eq, Eq (RightContext r)
Eq (RightContext r)
-> (RightContext r -> RightContext r -> Ordering)
-> (RightContext r -> RightContext r -> Bool)
-> (RightContext r -> RightContext r -> Bool)
-> (RightContext r -> RightContext r -> Bool)
-> (RightContext r -> RightContext r -> Bool)
-> (RightContext r -> RightContext r -> RightContext r)
-> (RightContext r -> RightContext r -> RightContext r)
-> Ord (RightContext r)
RightContext r -> RightContext r -> Bool
RightContext r -> RightContext r -> Ordering
RightContext r -> RightContext r -> RightContext r
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {r}. Ord r => Eq (RightContext r)
forall r. Ord r => RightContext r -> RightContext r -> Bool
forall r. Ord r => RightContext r -> RightContext r -> Ordering
forall r.
Ord r =>
RightContext r -> RightContext r -> RightContext r
$ccompare :: forall r. Ord r => RightContext r -> RightContext r -> Ordering
compare :: RightContext r -> RightContext r -> Ordering
$c< :: forall r. Ord r => RightContext r -> RightContext r -> Bool
< :: RightContext r -> RightContext r -> Bool
$c<= :: forall r. Ord r => RightContext r -> RightContext r -> Bool
<= :: RightContext r -> RightContext r -> Bool
$c> :: forall r. Ord r => RightContext r -> RightContext r -> Bool
> :: RightContext r -> RightContext r -> Bool
$c>= :: forall r. Ord r => RightContext r -> RightContext r -> Bool
>= :: RightContext r -> RightContext r -> Bool
$cmax :: forall r.
Ord r =>
RightContext r -> RightContext r -> RightContext r
max :: RightContext r -> RightContext r -> RightContext r
$cmin :: forall r.
Ord r =>
RightContext r -> RightContext r -> RightContext r
min :: RightContext r -> RightContext r -> RightContext r
Ord, (forall a b. (a -> b) -> RightContext a -> RightContext b)
-> (forall a b. a -> RightContext b -> RightContext a)
-> Functor RightContext
forall a b. a -> RightContext b -> RightContext a
forall a b. (a -> b) -> RightContext a -> RightContext b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RightContext a -> RightContext b
fmap :: forall a b. (a -> b) -> RightContext a -> RightContext b
$c<$ :: forall a b. a -> RightContext b -> RightContext a
<$ :: forall a b. a -> RightContext b -> RightContext a
Functor)

instance Show RECtx where
  showsPrec :: StartCode -> RECtx -> ShowS
showsPrec StartCode
_ (RECtx [(String, StartCode)]
scs Maybe CharSet
_ RExp
r RightContext RExp
rctx Maybe String
code) =
        [(String, StartCode)] -> ShowS
showStarts [(String, StartCode)]
scs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RightContext RExp -> ShowS
forall r. Show r => RightContext r -> ShowS
showRCtx RightContext RExp
rctx ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> ShowS
showMaybeCode Maybe String
code

showMaybeCode :: Maybe String -> String -> String
showMaybeCode :: Maybe String -> ShowS
showMaybeCode Maybe String
Nothing = ShowS
forall a. a -> a
id
showMaybeCode (Just String
code) = String -> ShowS
showCode String
code

showCode :: String -> String -> String
showCode :: String -> ShowS
showCode String
code = String -> ShowS
showString String
" { " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
code ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" }"

showStarts :: [(String, StartCode)] -> String -> String
showStarts :: [(String, StartCode)] -> ShowS
showStarts [] = ShowS
forall a. a -> a
id
showStarts [(String, StartCode)]
scs = [(String, StartCode)] -> ShowS
forall a. Show a => a -> ShowS
shows [(String, StartCode)]
scs

showRCtx :: Show r => RightContext r -> String -> String
showRCtx :: forall r. Show r => RightContext r -> ShowS
showRCtx RightContext r
NoRightContext = ShowS
forall a. a -> a
id
showRCtx (RightContextRExp r
r) = (Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> ShowS
forall a. Show a => a -> ShowS
shows r
r
showRCtx (RightContextCode String
code) = String -> ShowS
showString String
"\\ " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showCode String
code

-- -----------------------------------------------------------------------------
-- DFAs

data DFA s a = DFA
  { forall s a. DFA s a -> [s]
dfa_start_states :: [s],
    forall s a. DFA s a -> Map s (State s a)
dfa_states       :: Map s (State s a)
  }

data State s a = State { forall s a. State s a -> [Accept a]
state_acc :: [Accept a],
                         forall s a. State s a -> IntMap s
state_out :: IntMap s -- 0..255 only
                       }

type SNum = Int

data Accept a
  = Acc { forall a. Accept a -> StartCode
accPrio       :: Int,
          forall a. Accept a -> Maybe a
accAction     :: Maybe a,
          forall a. Accept a -> Maybe CharSet
accLeftCtx    :: Maybe CharSet, -- cannot be converted to byteset at this point.
          forall a. Accept a -> RightContext StartCode
accRightCtx   :: RightContext SNum
    }
    deriving (Accept a -> Accept a -> Bool
(Accept a -> Accept a -> Bool)
-> (Accept a -> Accept a -> Bool) -> Eq (Accept a)
forall a. Eq a => Accept a -> Accept a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Accept a -> Accept a -> Bool
== :: Accept a -> Accept a -> Bool
$c/= :: forall a. Eq a => Accept a -> Accept a -> Bool
/= :: Accept a -> Accept a -> Bool
Eq,Eq (Accept a)
Eq (Accept a)
-> (Accept a -> Accept a -> Ordering)
-> (Accept a -> Accept a -> Bool)
-> (Accept a -> Accept a -> Bool)
-> (Accept a -> Accept a -> Bool)
-> (Accept a -> Accept a -> Bool)
-> (Accept a -> Accept a -> Accept a)
-> (Accept a -> Accept a -> Accept a)
-> Ord (Accept a)
Accept a -> Accept a -> Bool
Accept a -> Accept a -> Ordering
Accept a -> Accept a -> Accept a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Accept a)
forall a. Ord a => Accept a -> Accept a -> Bool
forall a. Ord a => Accept a -> Accept a -> Ordering
forall a. Ord a => Accept a -> Accept a -> Accept a
$ccompare :: forall a. Ord a => Accept a -> Accept a -> Ordering
compare :: Accept a -> Accept a -> Ordering
$c< :: forall a. Ord a => Accept a -> Accept a -> Bool
< :: Accept a -> Accept a -> Bool
$c<= :: forall a. Ord a => Accept a -> Accept a -> Bool
<= :: Accept a -> Accept a -> Bool
$c> :: forall a. Ord a => Accept a -> Accept a -> Bool
> :: Accept a -> Accept a -> Bool
$c>= :: forall a. Ord a => Accept a -> Accept a -> Bool
>= :: Accept a -> Accept a -> Bool
$cmax :: forall a. Ord a => Accept a -> Accept a -> Accept a
max :: Accept a -> Accept a -> Accept a
$cmin :: forall a. Ord a => Accept a -> Accept a -> Accept a
min :: Accept a -> Accept a -> Accept a
Ord)

-- debug stuff
instance Show (Accept a) where
  showsPrec :: StartCode -> Accept a -> ShowS
showsPrec StartCode
_ (Acc StartCode
p Maybe a
_act Maybe CharSet
_lctx RightContext StartCode
_rctx) = StartCode -> ShowS
forall a. Show a => a -> ShowS
shows StartCode
p --TODO

type StartCode = Int

-- -----------------------------------------------------------------------------
-- Predicates / contexts

-- we can generate somewhat faster code in the case that
-- the lexer doesn't use predicates
data UsesPreds = UsesPreds | DoesntUsePreds
  deriving UsesPreds -> UsesPreds -> Bool
(UsesPreds -> UsesPreds -> Bool)
-> (UsesPreds -> UsesPreds -> Bool) -> Eq UsesPreds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UsesPreds -> UsesPreds -> Bool
== :: UsesPreds -> UsesPreds -> Bool
$c/= :: UsesPreds -> UsesPreds -> Bool
/= :: UsesPreds -> UsesPreds -> Bool
Eq

usesPreds :: DFA s a -> UsesPreds
usesPreds :: forall s a. DFA s a -> UsesPreds
usesPreds DFA s a
dfa
    | (Accept a -> Bool) -> [Accept a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Accept a -> Bool
forall {a}. Accept a -> Bool
acceptHasCtx [ Accept a
acc | State s a
st  <- Map s (State s a) -> [State s a]
forall k a. Map k a -> [a]
Map.elems (DFA s a -> Map s (State s a)
forall s a. DFA s a -> Map s (State s a)
dfa_states DFA s a
dfa)
                             , Accept a
acc <- State s a -> [Accept a]
forall s a. State s a -> [Accept a]
state_acc State s a
st ]
    = UsesPreds
UsesPreds
    | Bool
otherwise
    = UsesPreds
DoesntUsePreds
  where
    acceptHasCtx :: Accept a -> Bool
acceptHasCtx Acc { accLeftCtx :: forall a. Accept a -> Maybe CharSet
accLeftCtx  = Maybe CharSet
Nothing
                     , accRightCtx :: forall a. Accept a -> RightContext StartCode
accRightCtx = RightContext StartCode
NoRightContext } = Bool
False
    acceptHasCtx Accept a
_                                    = Bool
True

-- -----------------------------------------------------------------------------
-- Regular expressions

-- `RExp' provides an abstract syntax for regular expressions.  `Eps' will
-- match empty strings; `Ch p' matches strings containing a single character
-- `c' if `p c' is true; `re1 :%% re2' matches a string if `re1' matches one of
-- its prefixes and `re2' matches the rest; `re1 :|| re2' matches a string if
-- `re1' or `re2' matches it; `Star re', `Plus re' and `Ques re' can be
-- expressed in terms of the other operators.  See the definitions of `ARexp'
-- for a formal definition of the semantics of these operators.

data RExp
  = Eps            -- ^ Empty.
  | Ch CharSet     -- ^ Singleton.
  | RExp :%% RExp  -- ^ Sequence.
  | RExp :|| RExp   -- ^ Alternative.
  | Star RExp      -- ^ Zero or more repetitions.
  | Plus RExp      -- ^ One  or more repetitions.
  | Ques RExp      -- ^ Zero or one  repetitions.

instance Show RExp where
  showsPrec :: StartCode -> RExp -> ShowS
showsPrec StartCode
_ RExp
Eps = String -> ShowS
showString String
"()"
  showsPrec StartCode
_ (Ch CharSet
_) = String -> ShowS
showString String
"[..]"
  showsPrec StartCode
_ (RExp
l :%% RExp
r)  = RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r
  showsPrec StartCode
_ (RExp
l :|| RExp
r)  = RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'|'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r
  showsPrec StartCode
_ (Star RExp
r) = RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'*'Char -> ShowS
forall a. a -> [a] -> [a]
:)
  showsPrec StartCode
_ (Plus RExp
r) = RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:)
  showsPrec StartCode
_ (Ques RExp
r) = RExp -> ShowS
forall a. Show a => a -> ShowS
shows RExp
r ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'?'Char -> ShowS
forall a. a -> [a] -> [a]
:)

-- | A regular expression is nullable if it matches the empty string.
nullable :: RExp -> Bool
nullable :: RExp -> Bool
nullable RExp
Eps       = Bool
True
nullable Ch{}      = Bool
False
nullable (RExp
l :%% RExp
r) = RExp -> Bool
nullable RExp
l Bool -> Bool -> Bool
&& RExp -> Bool
nullable RExp
r
nullable (RExp
l :||  RExp
r) = RExp -> Bool
nullable RExp
l Bool -> Bool -> Bool
|| RExp -> Bool
nullable RExp
r
nullable Star{}    = Bool
True
nullable (Plus RExp
r)  = RExp -> Bool
nullable RExp
r
nullable Ques{}    = Bool
True


{------------------------------------------------------------------------------
                          Abstract Regular Expression
------------------------------------------------------------------------------}


-- This section contains demonstrations; it is not part of Alex.

{-
-- This function illustrates `ARexp'. It returns true if the string in its
-- argument is matched by the regular expression.

recognise:: RExp -> String -> Bool
recognise re inp = any (==len) (ap_ar (arexp re) inp)
        where
        len = length inp


-- `ARexp' provides an regular expressions in abstract format.  Here regular
-- expressions are represented by a function that takes the string to be
-- matched and returns the sizes of all the prefixes matched by the regular
-- expression (the list may contain duplicates).  Each of the `RExp' operators
-- are represented by similarly named functions over ARexp.  The `ap' function
-- takes an `ARExp', a string and returns the sizes of all the prefixes
-- matching that regular expression.  `arexp' converts an `RExp' to an `ARexp'.


arexp:: RExp -> ARexp
arexp Eps = eps_ar
arexp (Ch p) = ch_ar p
arexp (re :%% re') = arexp re `seq_ar` arexp re'
arexp (re :|| re') = arexp re `bar_ar` arexp re'
arexp (Star re) = star_ar (arexp re)
arexp (Plus re) = plus_ar (arexp re)
arexp (Ques re) = ques_ar (arexp re)


star_ar:: ARexp -> ARexp
star_ar sc =  eps_ar `bar_ar` plus_ar sc

plus_ar:: ARexp -> ARexp
plus_ar sc = sc `seq_ar` star_ar sc

ques_ar:: ARexp -> ARexp
ques_ar sc = eps_ar `bar_ar` sc


-- Hugs abstract type definition -- not for GHC.

type ARexp = String -> [Int]
--      in ap_ar, eps_ar, ch_ar, seq_ar, bar_ar

ap_ar:: ARexp -> String -> [Int]
ap_ar sc = sc

eps_ar:: ARexp
eps_ar inp = [0]

ch_ar:: (Char->Bool) -> ARexp
ch_ar p "" = []
ch_ar p (c:rst) = if p c then [1] else []

seq_ar:: ARexp -> ARexp -> ARexp
seq_ar sc sc' inp = [n+m| n<-sc inp, m<-sc' (drop n inp)]

bar_ar:: ARexp -> ARexp -> ARexp
bar_ar sc sc' inp = sc inp ++ sc' inp
-}

-- -----------------------------------------------------------------------------
-- Utils

-- Map the available start codes onto [1..]

encodeStartCodes:: Scanner -> (Scanner,[StartCode],ShowS)
encodeStartCodes :: Scanner -> (Scanner, [StartCode], ShowS)
encodeStartCodes Scanner
scan = (Scanner
scan', StartCode
0 StartCode -> [StartCode] -> [StartCode]
forall a. a -> [a] -> [a]
: ((String, StartCode) -> StartCode)
-> [(String, StartCode)] -> [StartCode]
forall a b. (a -> b) -> [a] -> [b]
map (String, StartCode) -> StartCode
forall a b. (a, b) -> b
snd [(String, StartCode)]
name_code_pairs, ShowS
sc_hdr)
        where
        scan' :: Scanner
scan' = Scanner
scan{ scannerTokens :: [RECtx]
scannerTokens = (RECtx -> RECtx) -> [RECtx] -> [RECtx]
forall a b. (a -> b) -> [a] -> [b]
map RECtx -> RECtx
mk_re_ctx (Scanner -> [RECtx]
scannerTokens Scanner
scan) }

        mk_re_ctx :: RECtx -> RECtx
mk_re_ctx (RECtx [(String, StartCode)]
scs Maybe CharSet
lc RExp
re RightContext RExp
rc Maybe String
code)
          = [(String, StartCode)]
-> Maybe CharSet
-> RExp
-> RightContext RExp
-> Maybe String
-> RECtx
RECtx (((String, StartCode) -> (String, StartCode))
-> [(String, StartCode)] -> [(String, StartCode)]
forall a b. (a -> b) -> [a] -> [b]
map (String, StartCode) -> (String, StartCode)
forall {b}. (String, b) -> (String, StartCode)
mk_sc [(String, StartCode)]
scs) Maybe CharSet
lc RExp
re RightContext RExp
rc Maybe String
code

        mk_sc :: (String, b) -> (String, StartCode)
mk_sc (String
nm,b
_) = (String
nm, if String
nmString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"0" then StartCode
0
                                       else Maybe StartCode -> StartCode
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Map String StartCode -> Maybe StartCode
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
nm Map String StartCode
code_map))

        sc_hdr :: ShowS
sc_hdr String
tl =
                case [(String, StartCode)]
name_code_pairs of
                  [] -> String
tl
                  (String
nm,StartCode
_):[(String, StartCode)]
rst -> String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, StartCode) -> ShowS)
-> String -> [(String, StartCode)] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String, StartCode) -> ShowS
forall {b}. (String, b) -> ShowS
f String
t [(String, StartCode)]
rst
                        where
                        f :: (String, b) -> ShowS
f (String
nm', b
_) String
t' = String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t'
                        t :: String
t = String
" :: Int\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((String, StartCode) -> ShowS)
-> String -> [(String, StartCode)] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String, StartCode) -> ShowS
forall {a}. Show a => (String, a) -> ShowS
fmt_sc String
tl [(String, StartCode)]
name_code_pairs
                where
                fmt_sc :: (String, a) -> ShowS
fmt_sc (String
nm,a
sc) String
t = String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
sc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t

        code_map :: Map String StartCode
code_map = [(String, StartCode)] -> Map String StartCode
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, StartCode)]
name_code_pairs

        name_code_pairs :: [(String, StartCode)]
name_code_pairs = [String] -> [StartCode] -> [(String, StartCode)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
nms [StartCode
1..]

        nms :: [String]
nms = Set String -> [String]
forall a. Set a -> [a]
Set.toAscList (Set String -> [String])
-> ([String] -> Set String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                [ String
nm
                | RECtx{ reCtxStartCodes :: RECtx -> [(String, StartCode)]
reCtxStartCodes = [(String, StartCode)]
scs } <- Scanner -> [RECtx]
scannerTokens Scanner
scan
                , (String
nm, StartCode
_) <- [(String, StartCode)]
scs
                , String
nm String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"0"
                ]


-- Grab the code fragments for the token actions, and replace them
-- with function names of the form alex_action_$n$.  We do this
-- because the actual action fragments might be duplicated in the
-- generated file.

extractActions :: Scheme -> Scanner -> (Scanner,ShowS)
extractActions :: Scheme -> Scanner -> (Scanner, ShowS)
extractActions Scheme
scheme Scanner
scanner = (Scanner
scanner{scannerTokens :: [RECtx]
scannerTokens = [RECtx]
new_tokens}, ShowS
decl_str ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl)
 where
  ([RECtx]
new_tokens, [Maybe ShowS]
decls) = [(RECtx, Maybe ShowS)] -> ([RECtx], [Maybe ShowS])
forall a b. [(a, b)] -> ([a], [b])
unzip ((RECtx -> String -> (RECtx, Maybe ShowS))
-> [RECtx] -> [String] -> [(RECtx, Maybe ShowS)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RECtx -> String -> (RECtx, Maybe ShowS)
f (Scanner -> [RECtx]
scannerTokens Scanner
scanner) [String]
act_names)

  f :: RECtx -> String -> (RECtx, Maybe ShowS)
f r :: RECtx
r@(RECtx{ reCtxCode :: RECtx -> Maybe String
reCtxCode = Just String
code }) String
name
        = (RECtx
r{reCtxCode :: Maybe String
reCtxCode = String -> Maybe String
forall a. a -> Maybe a
Just String
name}, ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (String -> String -> ShowS
mkDecl String
name String
code))
  f r :: RECtx
r@(RECtx{ reCtxCode :: RECtx -> Maybe String
reCtxCode = Maybe String
Nothing }) String
_
        = (RECtx
r{reCtxCode :: Maybe String
reCtxCode = Maybe String
forall a. Maybe a
Nothing}, Maybe ShowS
forall a. Maybe a
Nothing)

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

  mkDecl :: String -> String -> ShowS
mkDecl  String
fun String
code = String -> ShowS
mkTySig String
fun
                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ShowS
mkDef String
fun String
code

  mkDef :: String -> String -> ShowS
mkDef   String
fun String
code = String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
code ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl

  mkTySig :: String -> ShowS
mkTySig String
fun = case Scheme
scheme of
    Default { defaultTypeInfo :: Scheme -> Maybe (Maybe String, String)
defaultTypeInfo = Just (Maybe String
Nothing, String
actionty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
actionty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Default { defaultTypeInfo :: Scheme -> Maybe (Maybe String, String)
defaultTypeInfo = Just (Just String
tyclasses, String
actionty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
") => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
actionty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe String, String)
gscanTypeInfo = Just (Maybe String
Nothing, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
gscanActionType String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    GScan { gscanTypeInfo :: Scheme -> Maybe (Maybe String, String)
gscanTypeInfo = Just (Just String
tyclasses, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
") => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
gscanActionType String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty, basicTypeInfo :: Scheme -> Maybe (Maybe String, String)
basicTypeInfo = Just (Maybe String
Nothing, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str (StrType -> String
forall a. Show a => a -> String
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Basic { basicStrType :: Scheme -> StrType
basicStrType = StrType
strty,
            basicTypeInfo :: Scheme -> Maybe (Maybe String, String)
basicTypeInfo = Just (Just String
tyclasses, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
") => " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str (StrType -> String
forall a. Show a => a -> String
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
           posnTypeInfo :: Scheme -> Maybe (Maybe String, String)
posnTypeInfo = Just (Maybe String
Nothing, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: AlexPosn -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str (StrType -> String
forall a. Show a => a -> String
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Posn { posnStrType :: Scheme -> StrType
posnStrType = StrType
strty,
           posnTypeInfo :: Scheme -> Maybe (Maybe String, String)
posnTypeInfo = Just (Just String
tyclasses, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
") => AlexPosn -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
str (StrType -> String
forall a. Show a => a -> String
show StrType
strty) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
            monadTypeInfo :: Scheme -> Maybe (Maybe String, String)
monadTypeInfo = Just (Maybe String
Nothing, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      let
        actintty :: String
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then String
"Int64" else String
"Int"
      in
        String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
actintty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> Alex ("
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
")" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Monad { monadStrType :: Scheme -> StrType
monadStrType = StrType
strty,
            monadTypeInfo :: Scheme -> Maybe (Maybe String, String)
monadTypeInfo = Just (Just String
tyclasses, String
tokenty) } -> ShowS
nl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      let
        actintty :: String
actintty = if StrType
strty StrType -> StrType -> Bool
forall a. Eq a => a -> a -> Bool
== StrType
Lazy then String
"Int64" else String
"Int"
      in
        String -> ShowS
str String
fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" :: (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tyclasses ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
") =>"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" AlexInput -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
actintty
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
" -> Alex (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
tokenty ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
str String
")" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
nl
    Scheme
_ -> ShowS
forall a. a -> a
id

  act_names :: [String]
act_names = (StartCode -> String) -> [StartCode] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\StartCode
n -> String
"alex_action_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ StartCode -> String
forall a. Show a => a -> String
show (StartCode
n::Int)) [StartCode
0..]

  decl_str :: ShowS
  decl_str :: ShowS
decl_str = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id [ ShowS
decl | Just ShowS
decl <- [Maybe ShowS]
decls ]

-- -----------------------------------------------------------------------------
-- Code generation targets

data Target = GhcTarget | HaskellTarget
  deriving Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq