Improve the performance by ~30% for lexers that don't use predicates

By specialising slightly for the case where left and right contexts
are not used we can simplify the processing of accept actions in
alex_scan_tkn.

When we have left or right contexts we end up with chains of AlexAcc
values and we have to do a traversal of these chains. When there are
no left or right contexts then these chains are always length 1 which
makes the traversal non-recursive. This change improves the performance
singnificantly, (presumably because by being non-recursive ghc can
inline and transform further).

The 30% improvement measurment was from a lexer for .cabal files, but
I don't think there is anything special about that example so would
expect similar improvements for other lexers that don't use contexts.

The change is only implemented for the -g case, but that's fine since
that's what you'd use if you care about performance, and whether it'd
be an improvement for other compilers is anyone's guess.

Setup.lhs

@@ -73,6 +73,7 @@ templates :: [(FilePath,[String])]
 templates = [
   ("AlexTemplate",           []),
   ("AlexTemplate-ghc",       ["-DALEX_GHC"]),
+  ("AlexTemplate-ghc-nopred",["-DALEX_GHC", "-DALEX_NOPRED"]),
   ("AlexTemplate-ghc-debug", ["-DALEX_GHC","-DALEX_DEBUG"]),
   ("AlexTemplate-debug",     ["-DALEX_DEBUG"])
  ]

src/AbsSyn.hs

@@ -17,7 +17,8 @@ module AbsSyn (
   DFA(..), State(..), SNum, StartCode, Accept(..),
   RightContext(..), showRCtx,
   encodeStartCodes, extractActions,
-  Target(..)
+  Target(..),
+  UsesPreds(..), usesPreds
   ) where
 
 import CharSet ( CharSet )
@@ -117,6 +118,25 @@ instance Show (Accept a) where
 
 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
+
+usesPreds :: DFA s a -> UsesPreds
+usesPreds dfa
+    | any acceptHasCtx [ acc | st  <- Map.elems (dfa_states dfa)
+                             , acc <- state_acc st ]
+    = UsesPreds
+    | otherwise
+    = DoesntUsePreds
+  where
+    acceptHasCtx Acc { accLeftCtx  = Nothing
+                     , accRightCtx = NoRightContext } = False
+    acceptHasCtx _                                    = True
+
 -- -----------------------------------------------------------------------------
 -- Regular expressions
 

src/Main.hs

@@ -140,7 +140,6 @@ alex cli file basename script = do
         | otherwise            = UTF8
 
    template_dir  <- templateDir getDataDir cli
-   let template_name = templateFile template_dir target cli
 
    -- open the output file; remove it if we encounter an error
    bracketOnError 
@@ -168,6 +167,7 @@ alex cli file basename script = do
    let dfa = scanner2dfa encoding scanner_final scs
        min_dfa = minimizeDFA dfa
        nm  = scannerName scanner_final
+       usespreds = usesPreds min_dfa
 
 
    put_info "\nStart codes\n"
@@ -188,6 +188,7 @@ alex cli file basename script = do
    hPutStr out_h (actions "")
 
    -- add the template
+   let template_name = templateFile template_dir target usespreds cli
    tmplt <- alexReadFile template_name
    hPutStr out_h tmplt
 
@@ -256,9 +257,9 @@ templateDir def cli
       [] -> def
       ds -> return (last ds)
 
-templateFile :: FilePath -> Target -> [CLIFlags] -> FilePath
-templateFile dir target cli
-  = dir ++ "/AlexTemplate" ++ maybe_ghc ++ maybe_debug
+templateFile :: FilePath -> Target -> UsesPreds -> [CLIFlags] -> FilePath
+templateFile dir target usespreds cli
+  = dir ++ "/AlexTemplate" ++ maybe_ghc ++ maybe_debug ++ maybe_nopred
   where 
 	maybe_ghc = case target of
                       GhcTarget -> "-ghc"
@@ -268,6 +269,12 @@ templateFile dir target cli
 	  | OptDebugParser `elem` cli  = "-debug"
 	  | otherwise		       = ""
 
+	maybe_nopred =
+	  case usespreds of
+	    DoesntUsePreds | not (null maybe_ghc)
+	                  && null maybe_debug -> "-nopred"
+	    _                                 -> ""
+
 wrapperFile :: FilePath -> [Directive] -> IO (Maybe FilePath)
 wrapperFile dir directives =
   case [ f | WrapperDirective f <- directives ] of

templates/GenericTemplate.hs

@@ -176,6 +176,7 @@ alex_scan_tkn user orig_input len input s last_acc =
 	check_accs (AlexAccNone) = last_acc
 	check_accs (AlexAcc a  ) = AlexLastAcc a input IBOX(len)
 	check_accs (AlexAccSkip) = AlexLastSkip  input IBOX(len)
+#ifndef ALEX_NOPRED
 	check_accs (AlexAccPred a predx rest)
 	   | predx user orig_input IBOX(len) input
 	   = AlexLastAcc a input IBOX(len)
@@ -186,6 +187,7 @@ alex_scan_tkn user orig_input len input s last_acc =
 	   = AlexLastSkip input IBOX(len)
 	   | otherwise
 	   = check_accs rest
+#endif
 
 data AlexLastAcc a
   = AlexNone
@@ -201,6 +203,7 @@ data AlexAcc a user
   = AlexAccNone
   | AlexAcc a
   | AlexAccSkip
+#ifndef ALEX_NOPRED
   | AlexAccPred a   (AlexAccPred user) (AlexAcc a user)
   | AlexAccSkipPred (AlexAccPred user) (AlexAcc a user)
 
@@ -228,6 +231,7 @@ alexRightContext IBOX(sc) user _ _ input =
 	-- TODO: there's no need to find the longest
 	-- match when checking the right context, just
 	-- the first match will do.
+#endif
 
 -- used by wrappers
 iUnbox IBOX(i) = i