Merge pull request #153 from andreasabel/prettify-output

Prettify output (alex_action_n); enable CI for ghc 7.0.4; bump to 3.2.6; update README

Author: simonmar

.travis.yml

@@ -2,16 +2,16 @@
 
 # Keep the list of tested GHC versions in sync with `tested-with` in `alex.cabal`.
 env:
- - GHCVER=8.8.2
- - GHCVER=8.6.5
-# - GHCVER=7.0.4
+ - GHCVER=7.0.4
  - GHCVER=7.4.2
  - GHCVER=7.6.3
  - GHCVER=7.8.4
  - GHCVER=7.10.3
  - GHCVER=8.0.2
  - GHCVER=8.2.2
  - GHCVER=8.4.4
+ - GHCVER=8.6.5
+ - GHCVER=8.8.2
 
 before_install:
  - sudo add-apt-repository -y ppa:hvr/ghc

CHANGELOG.md

@@ -1,3 +1,5 @@
+## Changes in 3.2.6:
+
 ## Changes in 3.2.5:
 
  * Build fixes for GHC 8.8.x

README.md

@@ -9,19 +9,14 @@ documentation, see the doc directory.
 
 - <https://hackage.haskell.org/package/alex>
 
-Alex version 2.0 has changed fairly considerably since version 1.x,
-and the syntax is almost completely different.  For a detailed list of
-changes, see the release notes in the documentation.
+Alex is covered by a BSD-Style licence; see the licence file in
+the `doc` directory for details.
 
-Alex is now covered by a BSD-Style licence; see the licence file in
-the 'doc' directory for details.
+The sources are in the `src` directory and the documentation in the `doc`
+directory; various  examples are in the `examples` subdirectory.
 
-The sources are in the 'src' directory and the documentation in the 'doc'
-directory; various  examples are in the 'examples' subdirectory.
-
-The source code in the 'src' and 'examples' directories is intended
-for a Haskell 98 compiler with hierarchical modules.  It should work
-with GHC >= 5.04.
+The source code in the `src` and `examples` directories is intended to work
+with GHC >= 7.0.
 
 ## Build Instructions
 
@@ -51,7 +46,7 @@ Haskell Platform, or e.g. via (run this outside the Git repository!):
     $ cabal install alex happy
 
 which installs them into `${HOME}/.cabal/bin` by default (make sure
-they're in your `$PATH` for the next steps!).
+they are in your `$PATH` for the next steps!).
 
 ### Variant A
 
@@ -65,7 +60,7 @@ First you need to generate the pre-processed templates via
 And then you can install `alex` simply by invoking
 
     $ cabal install
-    
+
 from inside the Git folder.
 
 ### Variant B
@@ -78,7 +73,7 @@ new-run gen-alex-sdist` pre-preprocessing step):
     $ make sdist
     $ cabal install dist/alex-*.tar.gz
 
-For convenience, there's also a `make sdist-test` target which builds the
+For convenience, there is also a `make sdist-test` target which builds the
 source source tarball and runs the test-suite from within the source dist.
 
 ## Contributing & Reporting Issues
@@ -92,3 +87,5 @@ Chris Dornan:  [email protected]
 Isaac Jones:   [email protected]
 
 Simon Marlow:  [email protected]
+
+and [recent contributors](https://github.com/simonmar/alex/graphs/contributors).

alex.cabal

@@ -1,6 +1,6 @@
 cabal-version: >= 1.8
 name: alex
-version: 3.2.5
+version: 3.2.6
 -- don't forget updating changelog.md!
 license: BSD3
 license-file: LICENSE
@@ -23,6 +23,7 @@ build-type: Simple
 
 -- Keep the contents of `tested-with` in sync with `env` in `.travis.yml`.
 tested-with:
+        GHC == 7.0.4
         GHC == 7.4.2
         GHC == 7.6.3
         GHC == 7.8.4

src/AbsSyn.hs

@@ -320,7 +320,7 @@ encodeStartCodes scan = (scan', 0 : map snd name_code_pairs, sc_hdr)
 -- generated file.
 
 extractActions :: Scheme -> Scanner -> (Scanner,ShowS)
-extractActions scheme scanner = (scanner{scannerTokens = new_tokens}, decl_str)
+extractActions scheme scanner = (scanner{scannerTokens = new_tokens}, decl_str . nl)
  where
   (new_tokens, decls) = unzip (zipWith f (scannerTokens scanner) act_names)
 
@@ -333,61 +333,57 @@ extractActions scheme scanner = (scanner{scannerTokens = new_tokens}, decl_str)
       str "AlexPosn -> Char -> String -> Int -> ((Int, state) -> "
     . str res . str ") -> (Int, state) -> " . str res
 
-  mkDecl fun code = case scheme of
-    Default { defaultTypeInfo = Just (Nothing, actionty) } ->
-        str fun . str " :: " . str actionty . str "\n"
-      . str fun . str " = " . str code . nl
-    Default { defaultTypeInfo = Just (Just tyclasses, actionty) } ->
+  mkDecl  fun code = mkTySig fun
+                   . mkDef fun code
+
+  mkDef   fun code = str fun . str " = " . str code . nl
+
+  mkTySig fun = case scheme of
+    Default { defaultTypeInfo = Just (Nothing, actionty) } -> nl .
+        str fun . str " :: " . str actionty . nl
+    Default { defaultTypeInfo = Just (Just tyclasses, actionty) } -> nl .
       str fun . str " :: (" . str tyclasses . str ") => " .
-      str actionty . str "\n" .
-      str fun . str " = " . str code . nl
-    GScan { gscanTypeInfo = Just (Nothing, tokenty) } ->
-        str fun . str " :: " . gscanActionType tokenty . str "\n"
-      . str fun . str " = " . str code . nl
-    GScan { gscanTypeInfo = Just (Just tyclasses, tokenty) } ->
+      str actionty . nl
+    GScan { gscanTypeInfo = Just (Nothing, tokenty) } -> nl .
+        str fun . str " :: " . gscanActionType tokenty . nl
+    GScan { gscanTypeInfo = Just (Just tyclasses, tokenty) } -> nl .
       str fun . str " :: (" . str tyclasses . str ") => " .
-      gscanActionType tokenty . str "\n" .
-      str fun . str " = " . str code . nl
-    Basic { basicStrType = strty, basicTypeInfo = Just (Nothing, tokenty) } ->
+      gscanActionType tokenty . nl
+    Basic { basicStrType = strty, basicTypeInfo = Just (Nothing, tokenty) } -> nl .
       str fun . str " :: " . str (show strty) . str " -> "
-      . str tokenty . str "\n"
-      . str fun . str " = " . str code . nl
+      . str tokenty . nl
     Basic { basicStrType = strty,
-            basicTypeInfo = Just (Just tyclasses, tokenty) } ->
+            basicTypeInfo = Just (Just tyclasses, tokenty) } -> nl .
       str fun . str " :: (" . str tyclasses . str ") => " .
-      str (show strty) . str " -> " . str tokenty . str "\n" .
-      str fun . str " = " . str code . nl
+      str (show strty) . str " -> " . str tokenty . nl
     Posn { posnByteString = isByteString,
-           posnTypeInfo = Just (Nothing, tokenty) } ->
+           posnTypeInfo = Just (Nothing, tokenty) } -> nl .
       str fun . str " :: AlexPosn -> " . str (strtype isByteString) . str " -> "
-      . str tokenty . str "\n"
-      . str fun . str " = " . str code . nl
+      . str tokenty . nl
     Posn { posnByteString = isByteString,
-           posnTypeInfo = Just (Just tyclasses, tokenty) } ->
+           posnTypeInfo = Just (Just tyclasses, tokenty) } -> nl .
       str fun . str " :: (" . str tyclasses . str ") => AlexPosn -> " .
-      str (strtype isByteString) . str " -> " . str tokenty . str "\n" .
-      str fun . str " = " . str code . nl
+      str (strtype isByteString) . str " -> " . str tokenty . nl
     Monad { monadByteString = isByteString,
-            monadTypeInfo = Just (Nothing, tokenty) } ->
+            monadTypeInfo = Just (Nothing, tokenty) } -> nl .
       let
         actintty = if isByteString then "Int64" else "Int"
       in
         str fun . str " :: AlexInput -> " . str actintty . str " -> Alex ("
-      . str tokenty . str ")\n"
-      . str fun . str " = " . str code . nl
+      . str tokenty . str ")" . nl
     Monad { monadByteString = isByteString,
-            monadTypeInfo = Just (Just tyclasses, tokenty) } ->
+            monadTypeInfo = Just (Just tyclasses, tokenty) } -> nl .
       let
         actintty = if isByteString then "Int64" else "Int"
       in
-        str fun . str " :: (" . str tyclasses . str ") => "
+        str fun . str " :: (" . str tyclasses . str ") =>"
       . str " AlexInput -> " . str actintty
-      . str " -> Alex (" . str tokenty . str ")\n"
-      . str fun . str " = " . str code . nl
-    _ -> str fun . str " = " . str code . nl
+      . str " -> Alex (" . str tokenty . str ")" . nl
+    _ -> id
 
   act_names = map (\n -> "alex_action_" ++ show (n::Int)) [0..]
 
+  decl_str :: ShowS
   decl_str = foldr (.) id [ decl | Just decl <- decls ]
 
 -- -----------------------------------------------------------------------------

src/Main.hs

@@ -115,7 +115,9 @@ parseScript file prg =
 
         Right script -> return script
 
-alex :: [CLIFlags] -> FilePath -> FilePath
+alex :: [CLIFlags]
+     -> FilePath
+     -> FilePath
      -> (Maybe (AlexPosn, Code), [Directive], Scanner, Maybe (AlexPosn, Code))
      -> IO ()
 alex cli file basename script = do
@@ -148,7 +150,10 @@ alex cli file basename script = do
 
    template_dir  <- templateDir getDataDir cli
 
-   let (maybe_header, directives, scanner1, maybe_footer) = script
+   let maybe_header, maybe_footer :: Maybe (AlexPosn, Code)
+       directives                 :: [Directive]
+       scanner1                   :: Scanner
+       (maybe_header, directives, scanner1, maybe_footer) = script
 
    scheme <- getScheme directives
 
@@ -158,7 +163,12 @@ alex cli file basename script = do
         (\h -> do hClose h; removeFile o_file)
         $ \out_h -> do
 
-   let
+   let   wrapper_name            :: Maybe FilePath
+         scanner2, scanner_final :: Scanner
+         scs                     :: [StartCode]
+         sc_hdr, actions         :: ShowS
+         encodingsScript         :: [Encoding]
+
          wrapper_name = wrapperFile template_dir scheme
          (scanner2, scs, sc_hdr) = encodeStartCodes scanner1
          (scanner_final, actions) = extractActions scheme scanner2

src/Scan.x

@@ -175,7 +175,7 @@ code (p,_,_inp) _ = do
     go :: AlexInput -> Int -> String -> P Token
     go inp 0 cs = do
       setInput inp
-      return (T p (CodeT (reverse (tail cs))))
+      return $ T p $ CodeT $ triml $ reverse $ triml $ tail cs
     go inp n cs = do
       case alexGetChar inp of
         Nothing       -> err inp
@@ -210,6 +210,8 @@ code (p,_,_inp) _ = do
 
     err inp = do setInput inp; lexError "lexical error in code fragment"
 
+    triml = dropWhile isSpace
+
 lexError :: String -> P a
 lexError s = do
   (_,_,_,input) <- getInput

tests/Makefile

@@ -1,6 +1,6 @@
 # NOTE: `cabal test` will take care to build the local `alex`
-# executable and place it into $PATH for us to pick up.  
-# 
+# executable and place it into $PATH for us to pick up.
+#
 # If it doesn't look like the alex binary in $PATH comes from the
 # build tree, then we'll fall back to pointing to
 # ../dist/build/alex/alex to support running tests via "runghc
@@ -13,7 +13,19 @@ endif
 
 # NOTE: This assumes that a working `ghc` is on $PATH; this may not necessarily be the same GHC used by `cabal` for building `alex`.
 HC=ghc
-HC_OPTS=-Wall -fwarn-incomplete-uni-patterns -fno-warn-missing-signatures -fno-warn-unused-imports -fno-warn-tabs -Werror
+
+# Some GHC warnings are only available from a certain version on
+# Get the GHC version
+GHC_VERSION:=$(shell ghc --numeric-version)
+GHC_VERSION_WORDS=$(subst ., ,$(GHC_VERSION))
+GHC_MAJOR_VERSION=$(word 1,$(GHC_VERSION_WORDS))
+GHC_MINOR_VERSION=$(word 2,$(GHC_VERSION_WORDS))
+# -fwarn-incomplete-uni-patterns only from 7.4
+WARNS_FOR_GHC_GTEQ_7_4=-fwarn-incomplete-uni-patterns
+WARNS_FOR_GHC_LT_7_4=-fno-warn-lazy-unlifted-bindings
+WARNS_DEP_GHC_GTEQ_7_4:=$(shell if [ $(GHC_MAJOR_VERSION) -gt 7 -o $(GHC_MAJOR_VERSION) -ge 7 -a $(GHC_MINOR_VERSION) -ge 4 ]; then echo "$(WARNS_FOR_GHC_GTEQ_7_4)"; else echo "$(WARNS_FOR_GHC_LT_7_4)"; fi)
+
+HC_OPTS=-Wall $(WARNS_DEP_GHC_GTEQ_7_4) -fno-warn-missing-signatures -fno-warn-unused-imports -fno-warn-tabs -Werror
 
 .PRECIOUS: %.n.hs %.g.hs %.o %.exe %.bin
 
@@ -73,7 +85,8 @@ ALL_TESTS = $(patsubst %.hs, %.run, $(ALL_TEST_HS))
 
 all :: $(ALL_TESTS)
 
-.PHONY: clean
+.PHONY: clean debug
+
 clean:
 	rm -f $(CLEAN_FILES)
 
@@ -82,3 +95,8 @@ interact:
 	ghci -cpp -i../src -i../dist/build/autogen -i../dist/build/alex/alex-tmp Main -fbreak-on-exception
 # -args='--template=.. simple.x -o simple.n.hs'
 # :set args --template=.. simple.x -o simple.n.hs
+
+debug :
+	@echo HC_OPTS=$(HC_OPTS)
+
+# EOF