diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -3,49 +3,65 @@
\begin{code}
module Main where
+import Distribution.Verbosity
import Distribution.PackageDescription (PackageDescription(..))
-import Distribution.Simple.Setup ( BuildFlags(..), buildVerbose )
-import Distribution.Simple ( defaultMainWithHooks, defaultUserHooks, UserHooks(..) )
+import Distribution.Simple.Setup ( BuildFlags(..), buildVerbosity, fromFlagOrDefault )
+import Distribution.Simple ( defaultMainWithHooks, simpleUserHooks, UserHooks(..) )
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo(..) )
import Distribution.Simple.Program
import System.FilePath (())
-import System.IO.Error ( try )
+import Control.Exception ( IOException, try )
import System.Directory (removeFile)
main :: IO ()
-main = defaultMainWithHooks defaultUserHooks{ hookedPrograms = [perlProgram],
- postBuild = myPostBuild,
- postClean = myPostClean,
- copyHook = myCopy,
- instHook = myInstall }
-
-perlProgram = simpleProgram "perl"
+main = defaultMainWithHooks simpleUserHooks{ postBuild = myPostBuild,
+ postClean = myPostClean,
+ copyHook = myCopy,
+ instHook = myInstall }
-- hack to turn cpp-style '# 27 "GenericTemplate.hs"' into
-- '{-# LINE 27 "GenericTemplate.hs" #-}'.
-crazy_perl_regexp =
- "s/^#\\s+(\\d+)\\s+(\"[^\"]*\")/{-# LINE \\1 \\2 #-}/g;s/\\$(Id:.*)\\$/\\1/g"
+mungeLinePragma line = case symbols line of
+ ["#", number, string] | length string >= 2
+ && head string == '"'
+ && last string == '"'
+ -> case reads number of
+ [(n, "")] -> "{-# LINE " ++ show (n :: Int) ++ " " ++ string ++ " #-}"
+ _ -> line
+ -- Also convert old-style CVS lines, no idea why we do this...
+ ("--":"$":"Id":":":_) -> filter (/='$') line
+ ( "$":"Id":":":_) -> filter (/='$') line
+ _ -> line
+symbols :: String -> [String]
+symbols cs = case lex cs of
+ (sym, cs'):_ | not (null sym) -> sym : symbols cs'
+ _ -> []
+
myPostBuild _ flags _ lbi = do
- let runProgram p = rawSystemProgramConf (buildVerbose flags) p (withPrograms lbi)
+ let verbosity = fromFlagOrDefault normal (buildVerbosity flags)
+ runProgram p = rawSystemProgramConf verbosity p (withPrograms lbi)
cpp_template src dst opts = do
- runProgram ghcProgram (["-o", dst, "-E", "-cpp", "templates" src] ++ opts)
- runProgram perlProgram ["-i.bak", "-pe", crazy_perl_regexp, dst]
+ let tmp = dst ++ ".tmp"
+ runProgram ghcProgram (["-o", tmp, "-E", "-cpp", "templates" src] ++ opts)
+ writeFile dst . unlines . map mungeLinePragma . lines =<< readFile tmp
+ removeFile tmp
sequence_ ([ cpp_template "GenericTemplate.hs" dst opts | (dst,opts) <- templates ] ++
[ cpp_template "wrappers.hs" dst opts | (dst,opts) <- wrappers ])
-myPostClean _ _ _ _ = mapM_ (try . removeFile) all_template_files
+myPostClean _ _ _ _ = let try' = try :: IO a -> IO (Either IOException a)
+ in mapM_ (try' . removeFile) all_template_files
myInstall pkg_descr lbi hooks flags =
- instHook defaultUserHooks pkg_descr' lbi hooks flags
+ instHook simpleUserHooks pkg_descr' lbi hooks flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
myCopy pkg_descr lbi hooks copy_flags =
- copyHook defaultUserHooks pkg_descr' lbi hooks copy_flags
+ copyHook simpleUserHooks pkg_descr' lbi hooks copy_flags
where pkg_descr' = pkg_descr {
dataFiles = dataFiles pkg_descr ++ all_template_files
}
diff --git a/alex.cabal b/alex.cabal
--- a/alex.cabal
+++ b/alex.cabal
@@ -1,5 +1,5 @@
name: alex
-version: 3.0.1
+version: 3.0.2
license: BSD3
license-file: LICENSE
copyright: (c) Chis Dornan, Simon Marlow
@@ -58,7 +58,7 @@
source-repository head
type: git
- location: http://darcs.haskell.org/alex.git
+ location: https://github.com/simonmar/alex.git
flag small_base
description: Choose the new smaller, split-up base package.
diff --git a/dist/build/alex/alex-tmp/Parser.hs b/dist/build/alex/alex-tmp/Parser.hs
--- a/dist/build/alex/alex-tmp/Parser.hs
+++ b/dist/build/alex/alex-tmp/Parser.hs
@@ -21,7 +21,7 @@
import qualified Data.Array as Happy_Data_Array
import qualified GHC.Exts as Happy_GHC_Exts
--- parser produced by Happy Version 1.18.6
+-- parser produced by Happy Version 1.18.7
newtype HappyAbsSyn = HappyAbsSyn HappyAny
#if __GLASGOW_HASKELL__ >= 607
@@ -831,7 +831,8 @@
_ -> happyError' tk
})
-happyError_ tk = happyError' tk
+happyError_ 33# tk = happyError' tk
+happyError_ _ tk = happyError' tk
happyThen :: () => P a -> (a -> P b) -> P b
happyThen = ((>>=))
@@ -1053,9 +1054,10 @@
-- Error recovery (0# is the error token)
-- parse error if we are in recovery and we fail again
-happyFail 0# tk old_st _ stk =
+happyFail 0# tk old_st _ stk@(x `HappyStk` _) =
+ let (i) = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in
-- trace "failing" $
- happyError_ tk
+ happyError_ i tk
{- We don't need state discarding for our restricted implementation of
"error". In fact, it can cause some bogus parses, so I've disabled it
diff --git a/doc/alex.1.in b/doc/alex.1.in
--- a/doc/alex.1.in
+++ b/doc/alex.1.in
@@ -51,7 +51,7 @@
.TP
.BR \-d ", " \-\-debug
-Instructs Alex to generate a lexer which will output debugging messsages
+Instructs Alex to generate a lexer which will output debugging messages
as it runs.
.TP
diff --git a/doc/alex.xml b/doc/alex.xml
--- a/doc/alex.xml
+++ b/doc/alex.xml
@@ -41,9 +41,9 @@
Alex can always be obtained from its home page. The latest
- source code lives in the fptools CVS
- repository; instructions on accessing that repository are here.
+ source code lives in the git
+ repository on GitHub.
+
Release Notes for version 3.0
diff --git a/src/Info.hs b/src/Info.hs
--- a/src/Info.hs
+++ b/src/Info.hs
@@ -15,8 +15,6 @@
import qualified Data.IntMap as IntMap
import Util
-import Data.Array
-
-- -----------------------------------------------------------------------------
-- Generate a human readable dump of the state machine
@@ -60,6 +58,6 @@
outputLCtx (Just set)
= paren (show set ++) . char '^'
- outputArr arr
- = str "Array.array " . shows (bounds arr) . space
- . shows (assocs arr)
+ -- outputArr arr
+ -- = str "Array.array " . shows (bounds arr) . space
+ -- . shows (assocs arr)
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -40,7 +40,6 @@
import System.Environment ( getProgName, getArgs )
import System.Exit ( ExitCode(..), exitWith )
import System.IO ( stderr, Handle, IOMode(..), openFile, hClose, hPutStr, hPutStrLn )
-import System.IO ( hSetBuffering, BufferMode(..) )
#if __GLASGOW_HASKELL__ >= 612
import System.IO ( hGetContents, hSetEncoding, utf8 )
#endif
diff --git a/src/NFA.hs b/src/NFA.hs
--- a/src/NFA.hs
+++ b/src/NFA.hs
@@ -163,7 +163,7 @@
newtype NFAM a = N {unN :: SNum -> MapNFA -> Encoding -> (SNum, MapNFA, a)}
instance Monad NFAM where
- return a = N $ \s n e -> (s,n,a)
+ return a = N $ \s n _ -> (s,n,a)
m >>= k = N $ \s n e -> case unN m s n e of
(s', n', a) -> unN (k a) s' n' e
@@ -181,7 +181,7 @@
bds@(_,hi) = bounds ar
newState :: NFAM SNum
-newState = N $ \s n e -> (s+1,n,s)
+newState = N $ \s n _ -> (s+1,n,s)
getEncoding :: NFAM Encoding
getEncoding = N $ \s n e -> (s,n,e)
@@ -214,6 +214,7 @@
u <- newState
byteEdge from (byteSetRange (x+1) (y-1)) u
anyBytes u (length xs) to
+bytesEdge _ _ _ _ = undefined -- hide compiler warning
charEdge :: SNum -> CharSet -> SNum -> NFAM ()
charEdge from charset to = do
@@ -225,7 +226,7 @@
byteEdge :: SNum -> ByteSet -> SNum -> NFAM ()
-byteEdge from charset to = N $ \s n e -> (s, addEdge n, ())
+byteEdge from charset to = N $ \s n _ -> (s, addEdge n, ())
where
addEdge n =
case Map.lookup from n of
@@ -237,7 +238,7 @@
epsilonEdge :: SNum -> SNum -> NFAM ()
epsilonEdge from to
| from == to = return ()
- | otherwise = N $ \s n e -> (s, addEdge n, ())
+ | otherwise = N $ \s n _ -> (s, addEdge n, ())
where
addEdge n =
case Map.lookup from n of
@@ -245,7 +246,7 @@
Just (NSt acc eps trans) -> Map.insert from (NSt acc (to:eps) trans) n
accept :: SNum -> Accept Code -> NFAM ()
-accept state new_acc = N $ \s n e -> (s, addAccept n, ())
+accept state new_acc = N $ \s n _ -> (s, addAccept n, ())
where
addAccept n =
case Map.lookup state n of
diff --git a/src/Output.hs b/src/Output.hs
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -20,7 +20,7 @@
import Data.Array ( Array )
import Data.Array.Base ( unsafeRead )
import Data.Array.ST ( STUArray, newArray, readArray, writeArray, freeze )
-import Data.Array.Unboxed ( UArray, bounds, assocs, elems, (!), array, listArray )
+import Data.Array.Unboxed ( UArray, elems, (!), array, listArray )
import Data.Bits
import Data.Char ( ord, chr )
import Data.List ( maximumBy, sortBy, groupBy )
@@ -103,9 +103,9 @@
outputRCtx (RightContextCode code)
= str code
- outputArr arr
- = str "array " . shows (bounds arr) . space
- . shows (assocs arr)
+ -- outputArr arr
+ -- = str "array " . shows (bounds arr) . space
+ -- . shows (assocs arr)
-- -----------------------------------------------------------------------------
-- Generating arrays.
diff --git a/src/ParseMonad.hs b/src/ParseMonad.hs
--- a/src/ParseMonad.hs
+++ b/src/ParseMonad.hs
@@ -39,6 +39,7 @@
alexGetChar (_,_,[],[]) = Nothing
alexGetChar (p,_,[],(c:s)) = let p' = alexMove p c in p' `seq`
Just (c, (p', c, [], s))
+alexGetChar (_, _ ,_ : _, _) = undefined -- hide compiler warning
alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)
alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))
diff --git a/templates/wrappers.hs b/templates/wrappers.hs
--- a/templates/wrappers.hs
+++ b/templates/wrappers.hs
@@ -56,7 +56,8 @@
[Byte], -- pending bytes on current char
String) -- current input string
-ignorePendingBytes (p,c,ps,s) = (p,c,s)
+ignorePendingBytes :: AlexInput -> AlexInput
+ignorePendingBytes (p,c,ps,s) = (p,c,[],s)
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (p,c,bs,s) = c
diff --git a/tests/Makefile b/tests/Makefile
--- a/tests/Makefile
+++ b/tests/Makefile
@@ -36,6 +36,9 @@
all :: $(ALL_TESTS)
+.PHONY: clean
+clean:
+ rm -f *.o *.hi *.bin
interact:
ghci -cpp -i../src -i../dist/build/autogen -i../dist/build/alex/alex-tmp Main -fbreak-on-exception
diff --git a/tests/simple.x b/tests/simple.x
--- a/tests/simple.x
+++ b/tests/simple.x
@@ -30,17 +30,17 @@
{
{- we can now have comments in source code? -}
-word (p,_,input) len = return (take len input)
+word (p,_,_,input) len = return (take len input)
-both (p,_,input) len = return ("BOTH:"++ take len input)
+both (p,_,_,input) len = return ("BOTH:"++ take len input)
-eol (p,_,input) len = return ("EOL:"++ take len input)
+eol (p,_,_,input) len = return ("EOL:"++ take len input)
-bol (p,_,input) len = return ("BOL:"++ take len input)
+bol (p,_,_,input) len = return ("BOL:"++ take len input)
-parenword (p,_,input) len = return (map toUpper (take len input))
+parenword (p,_,_,input) len = return (map toUpper (take len input))
-magic (p,_,input) len = return "PING!"
+magic (p,_,_,input) len = return "PING!"
alexEOF = return "stopped."
diff --git a/tests/unicode.x b/tests/unicode.x
--- a/tests/unicode.x
+++ b/tests/unicode.x
@@ -23,11 +23,11 @@
{
-string (p,_,input) len = return "string!"
+string (p,_,_,input) len = return "string!"
-other (p,_,input) len = return (take len input)
+other (p,_,_,input) len = return (take len input)
-character (p,_,input) len = return "PING!"
+character (p,_,_,input) len = return "PING!"
alexEOF = return "stopped."