packages feed

alex 3.2.3 → 3.2.4

raw patch · 24 files changed

+6229/−581 lines, 24 filesdep −QuickCheckdep ~basesetup-changed

Dependencies removed: QuickCheck

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,6 +1,12 @@+## Changes in 3.2.4:++ * Remove dependency on QuickCheck+ * Change the way that bootstrapping is done: see README.md for build+   instructions+ ## Changes in 3.2.3: - * fix issue when using ccphs (#116)+ * fix issue when using cpphs (#116)  ## Changes in 3.2.2:
README.md view
@@ -5,15 +5,9 @@ Alex is a Lex-like tool for generating Haskell scanners.  For complete documentation, see the doc directory. -   http://www.haskell.org/alex/--   http://hackage.haskell.org/package/alex--Alex is built using Cabal.  First install GHC and cabal-install, then:+- <https://www.haskell.org/alex/> -    $ cabal configure-    $ cabal build-    $ cabal install+- <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@@ -28,6 +22,66 @@ 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.++## Build Instructions++If you just want to *use* Alex, you can download or install (via+`cabal install alex`) an+[Alex release from Hackage](https://hackage.haskell.org/package/alex); also note that+distributions such as the+[Haskell Platform](https://www.haskell.org/platform/) and other package+manager-based distributions provide packages for Alex. Moreover,+recent versions of `cabal` will automatically install the required+version of `alex` based on+[`build-tools`/`build-tool-depends` declarations](http://cabal.readthedocs.io/en/latest/developing-packages.html#pkg-field-build-tool-depends).++Read on if you want to build Alex directly from Git.++Alex is built using GHC & Cabal; so first install+[GHC](https://www.haskell.org/ghc) and+[`cabal-install-2.0`](https://www.haskell.org/cabal) (or later).++Since Alex itself is implemented in terms of an Alex scanner,+bootstrapping Alex is a bit tricky:++You need to have the build-tools `alex` and `happy` manually+installed; either via your system package manager distribution, the+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!).++### Variant A++First you need to generate the pre-processed templates via++    $ cabal new-run gen-alex-sdist++(otherwise `cabal install` will complain about+"`data/AlexTemplate: copyFile: does not exist (No such file or directory)`")++And then you can install `alex` simply by invoking++    $ cabal install+    +from inside the Git folder.++### Variant B++Alternatively, you can use the `Makefile` which automates the steps of+producing a self-contained pre-bootstrapped source distribution with+pre-generated lexer/scanners (and which also performs the `cabal+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+source source tarball and runs the test-suite from within the source dist.++## Contributing & Reporting Issues  Please report any bugs or comments at  https://github.com/simonmar/alex/issues
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs 
@@ -1,99 +0,0 @@-#!/usr/bin/runhaskell--\begin{code}-module Main where--import Distribution.Verbosity-import Distribution.PackageDescription (PackageDescription(..))-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 Control.Exception ( IOException, try )-import System.Directory (removeFile)-import Data.Char--main :: IO ()-main = defaultMainWithHooks simpleUserHooks{ postBuild = myPostBuild,-                                             postClean = myPostClean,-                                             copyHook  = myCopy,-                                             instHook  = myInstall }---- hack to turn cpp-style '# 27 "GenericTemplate.hs"' into--- '{-# LINE 27 "GenericTemplate.hs" #-}'.-mungeLinePragma line = case symbols line of- syms | Just prag <- getLinePrag syms  -> prag- -- Also convert old-style CVS lines, no idea why we do this...- ("--":"$":"Id":":":_) -> filter (/='$') line- (     "$":"Id":":":_) -> filter (/='$') line- _ -> line--getLinePrag :: [String] -> Maybe String-getLinePrag ("#" : n : string : rest)-  | length rest <= 1   -- clang puts an extra field-  , length string >= 2 && head string == '"' && last string == '"'-  , all isDigit n-  = Just $ "{-# LINE " ++ n ++ " " ++ string ++ " #-}"-getLinePrag other = Nothing--symbols :: String -> [String]-symbols cs = case lex cs of-              (sym, cs'):_ | not (null sym) -> sym : symbols cs'-              _ -> []--myPostBuild _ flags _ lbi = do-  let verbosity = fromFlagOrDefault normal (buildVerbosity flags)-      runProgram p = rawSystemProgramConf verbosity p (withPrograms lbi)-      cpp_template src dst opts = do-        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 _ _ _ _ = let try' = try :: IO a -> IO (Either IOException a)-                      in mapM_ (try' . removeFile) all_template_files--myInstall 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 simpleUserHooks pkg_descr' lbi hooks copy_flags-  where pkg_descr' = pkg_descr {-          dataFiles = dataFiles pkg_descr ++ all_template_files-        }--all_template_files :: [FilePath]-all_template_files = map fst (templates ++ wrappers)--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"])- ]--wrappers :: [(FilePath,[String])]-wrappers = [-  ("AlexWrapper-basic", ["-DALEX_BASIC"]),-  ("AlexWrapper-basic-bytestring", ["-DALEX_BASIC_BYTESTRING"]),-  ("AlexWrapper-strict-bytestring", ["-DALEX_STRICT_BYTESTRING"]),-  ("AlexWrapper-posn",  ["-DALEX_POSN"]),-  ("AlexWrapper-posn-bytestring", ["-DALEX_POSN_BYTESTRING"]),-  ("AlexWrapper-monad", ["-DALEX_MONAD"]),-  ("AlexWrapper-monad-bytestring", ["-DALEX_MONAD_BYTESTRING"]),-  ("AlexWrapper-monadUserState", ["-DALEX_MONAD", "-DALEX_MONAD_USER_STATE"]),-  ("AlexWrapper-monadUserState-bytestring", ["-DALEX_MONAD_BYTESTRING", "-DALEX_MONAD_USER_STATE"]),-  ("AlexWrapper-gscan", ["-DALEX_GSCAN"])- ]--\end{code}
alex.cabal view
@@ -1,5 +1,6 @@+cabal-version: >= 1.8 name: alex-version: 3.2.3+version: 3.2.4 -- don't forget updating changelog.md! license: BSD3 license-file: LICENSE@@ -18,9 +19,27 @@   lex or flex for C/C++.  category: Development-cabal-version: >= 1.8-build-type: Custom+build-type: Simple +data-dir: data/++data-files:+        AlexTemplate+        AlexTemplate-ghc+        AlexTemplate-ghc-nopred+        AlexTemplate-ghc-debug+        AlexTemplate-debug+        AlexWrapper-basic+        AlexWrapper-basic-bytestring+        AlexWrapper-strict-bytestring+        AlexWrapper-posn+        AlexWrapper-posn-bytestring+        AlexWrapper-monad+        AlexWrapper-monad-bytestring+        AlexWrapper-monadUserState+        AlexWrapper-monadUserState-bytestring+        AlexWrapper-gscan+ extra-source-files:         CHANGELOG.md         README.md@@ -50,7 +69,7 @@         src/Parser.y.boot         src/Scan.x.boot         src/ghc_hooks.c-         templates/GenericTemplate.hs+        templates/GenericTemplate.hs         templates/wrappers.hs         tests/Makefile         tests/simple.x@@ -95,8 +114,6 @@     build-depends: base >= 1.0    build-depends: base < 5-  -- build-depends: Ranged-sets-  build-depends: QuickCheck >=2    extensions: CPP   ghc-options: -Wall -rtsopts@@ -110,6 +127,7 @@         Map         NFA         Output+        Paths_alex         Parser         ParseMonad         Scan@@ -125,4 +143,7 @@ test-suite tests   type: exitcode-stdio-1.0   main-is: test.hs+  -- This line is important as it ensures that the local `exe:alex` component declared above is built before the test-suite component is invoked, as well as making sure that `alex` is made available on $PATH and `$alex_datadir` is set accordingly before invoking `test.hs`+  build-tools: alex+   build-depends: base, process
+ data/AlexTemplate view
@@ -0,0 +1,237 @@+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++alexIndexInt16OffAddr arr off = arr ! off+++++++++++++++++++++alexIndexInt32OffAddr arr off = arr ! off++++++++++++quickIndex arr i = arr ! i+++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (sc)+  = alexScanUser undefined input__ (sc)++alexScanUser user__ input__ (sc)+  = case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++++                                   AlexEOF+      Just _ ->++++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (s)))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++++      case fromIntegral c of { (ord_c) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base + ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if (offset >= (0)) && (check == ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            (-1) -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len + (1)) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (len)+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (len)++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastAcc a input__ (len)+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastSkip input__ (len)+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (sc) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ data/AlexTemplate-debug view
@@ -0,0 +1,237 @@+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++alexIndexInt16OffAddr arr off = arr ! off+++++++++++++++++++++alexIndexInt32OffAddr arr off = arr ! off++++++++++++quickIndex arr i = arr ! i+++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (sc)+  = alexScanUser undefined input__ (sc)++alexScanUser user__ input__ (sc)+  = case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++                                   trace ("End of input.") $++                                   AlexEOF+      Just _ ->++                                   trace ("Error.") $++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++    trace ("Skipping.") $++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++    trace ("Accept.") $++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (s)))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++      trace ("State: " ++ show (s) ++ ", char: " ++ show c) $++      case fromIntegral c of { (ord_c) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base + ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if (offset >= (0)) && (check == ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            (-1) -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len + (1)) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (len)+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (len)++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastAcc a input__ (len)+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (len) input__+           = AlexLastSkip input__ (len)+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (sc) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ (0) input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ data/AlexTemplate-ghc view
@@ -0,0 +1,237 @@+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif++++++++++++++++++++data AlexAddr = AlexA# Addr#+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))+        off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+                     (b2 `uncheckedShiftL#` 16#) `or#`+                     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif+++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (I# (sc))+  = alexScanUser undefined input__ (I# (sc))++alexScanUser user__ input__ (I# (sc))+  = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++++                                   AlexEOF+      Just _ ->++++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++++      case fromIntegral c of { (I# (ord_c)) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base +# ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if GTE(offset,0#) && EQ(check,ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            -1# -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (I# (len))+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (I# (len))++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastAcc a input__ (I# (len))+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastSkip input__ (I# (len))+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ data/AlexTemplate-ghc-debug view
@@ -0,0 +1,237 @@+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif++++++++++++++++++++data AlexAddr = AlexA# Addr#+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))+        off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+                     (b2 `uncheckedShiftL#` 16#) `or#`+                     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif+++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (I# (sc))+  = alexScanUser undefined input__ (I# (sc))++alexScanUser user__ input__ (I# (sc))+  = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++                                   trace ("End of input.") $++                                   AlexEOF+      Just _ ->++                                   trace ("Error.") $++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++    trace ("Skipping.") $++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++    trace ("Accept.") $++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++      trace ("State: " ++ show (I# (s)) ++ ", char: " ++ show c) $++      case fromIntegral c of { (I# (ord_c)) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base +# ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if GTE(offset,0#) && EQ(check,ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            -1# -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (I# (len))+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (I# (len))++        check_accs (AlexAccPred a predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastAcc a input__ (I# (len))+           | otherwise+           = check_accs rest+        check_accs (AlexAccSkipPred predx rest)+           | predx user__ orig_input (I# (len)) input__+           = AlexLastSkip input__ (I# (len))+           | otherwise+           = check_accs rest+++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip++  | AlexAccPred Int (AlexAccPred user) (AlexAcc user)+  | AlexAccSkipPred (AlexAccPred user) (AlexAcc user)++type AlexAccPred user = user -> AlexInput -> Int -> AlexInput -> Bool++-- -----------------------------------------------------------------------------+-- Predicates on a rule++alexAndPred p1 p2 user__ in1 len in2+  = p1 user__ in1 len in2 && p2 user__ in1 len in2++--alexPrevCharIsPred :: Char -> AlexAccPred _+alexPrevCharIs c _ input__ _ _ = c == alexInputPrevChar input__++alexPrevCharMatches f _ input__ _ _ = f (alexInputPrevChar input__)++--alexPrevCharIsOneOfPred :: Array Char Bool -> AlexAccPred _+alexPrevCharIsOneOf arr _ input__ _ _ = arr ! alexInputPrevChar input__++--alexRightContext :: Int -> AlexAccPred _+alexRightContext (I# (sc)) user__ _ _ input__ =+     case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+          (AlexNone, _) -> False+          _ -> True+        -- TODO: there's no need to find the longest+        -- match when checking the right context, just+        -- the first match will do.+
+ data/AlexTemplate-ghc-nopred view
@@ -0,0 +1,237 @@+{-# LINE 1 "templates/GenericTemplate.hs" #-}+-- -----------------------------------------------------------------------------+-- ALEX TEMPLATE+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.++-- -----------------------------------------------------------------------------+-- INTERNALS and main scanner engine++++++++++++++++++-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif++++++++++++++++++++data AlexAddr = AlexA# Addr#+-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex.+#if __GLASGOW_HASKELL__ < 503+uncheckedShiftL# = shiftL#+#endif++{-# INLINE alexIndexInt16OffAddr #-}+alexIndexInt16OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow16Int# i+  where+        i    = word2Int# ((high `uncheckedShiftL#` 8#) `or#` low)+        high = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+        low  = int2Word# (ord# (indexCharOffAddr# arr off'))+        off' = off *# 2#+#else+  indexInt16OffAddr# arr off+#endif++++++{-# INLINE alexIndexInt32OffAddr #-}+alexIndexInt32OffAddr (AlexA# arr) off =+#ifdef WORDS_BIGENDIAN+  narrow32Int# i+  where+   i    = word2Int# ((b3 `uncheckedShiftL#` 24#) `or#`+                     (b2 `uncheckedShiftL#` 16#) `or#`+                     (b1 `uncheckedShiftL#` 8#) `or#` b0)+   b3   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 3#)))+   b2   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 2#)))+   b1   = int2Word# (ord# (indexCharOffAddr# arr (off' +# 1#)))+   b0   = int2Word# (ord# (indexCharOffAddr# arr off'))+   off' = off *# 4#+#else+  indexInt32OffAddr# arr off+#endif+++++++#if __GLASGOW_HASKELL__ < 503+quickIndex arr i = arr ! i+#else+-- GHC >= 503, unsafeAt is available from Data.Array.Base.+quickIndex = unsafeAt+#endif+++++-- -----------------------------------------------------------------------------+-- Main lexing routines++data AlexReturn a+  = AlexEOF+  | AlexError  !AlexInput+  | AlexSkip   !AlexInput !Int+  | AlexToken  !AlexInput !Int a++-- alexScan :: AlexInput -> StartCode -> AlexReturn a+alexScan input__ (I# (sc))+  = alexScanUser undefined input__ (I# (sc))++alexScanUser user__ input__ (I# (sc))+  = case alex_scan_tkn user__ input__ 0# input__ sc AlexNone of+  (AlexNone, input__') ->+    case alexGetByte input__ of+      Nothing ->++++                                   AlexEOF+      Just _ ->++++                                   AlexError input__'++  (AlexLastSkip input__'' len, _) ->++++    AlexSkip input__'' len++  (AlexLastAcc k input__''' len, _) ->++++    AlexToken input__''' len (alex_actions ! k)+++-- Push the input through the DFA, remembering the most recent accepting+-- state it encountered.++alex_scan_tkn user__ orig_input len input__ s last_acc =+  input__ `seq` -- strict in the input+  let+  new_acc = (check_accs (alex_accept `quickIndex` (I# (s))))+  in+  new_acc `seq`+  case alexGetByte input__ of+     Nothing -> (new_acc, input__)+     Just (c, new_input) ->++++      case fromIntegral c of { (I# (ord_c)) ->+        let+                base   = alexIndexInt32OffAddr alex_base s+                offset = (base +# ord_c)+                check  = alexIndexInt16OffAddr alex_check offset++                new_s = if GTE(offset,0#) && EQ(check,ord_c)+                          then alexIndexInt16OffAddr alex_table offset+                          else alexIndexInt16OffAddr alex_deflt s+        in+        case new_s of+            -1# -> (new_acc, input__)+                -- on an error, we want to keep the input *before* the+                -- character that failed, not after.+            _ -> alex_scan_tkn user__ orig_input (if c < 0x80 || c >= 0xC0 then (len +# 1#) else len)+                                                -- note that the length is increased ONLY if this is the 1st byte in a char encoding)+                        new_input new_s new_acc+      }+  where+        check_accs (AlexAccNone) = last_acc+        check_accs (AlexAcc a  ) = AlexLastAcc a input__ (I# (len))+        check_accs (AlexAccSkip) = AlexLastSkip  input__ (I# (len))++++++++++++++data AlexLastAcc+  = AlexNone+  | AlexLastAcc !Int !AlexInput !Int+  | AlexLastSkip     !AlexInput !Int++data AlexAcc user+  = AlexAccNone+  | AlexAcc Int+  | AlexAccSkip+++++++++++++++++++++++++++++
+ data/AlexWrapper-basic view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++++++++++++++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper+++type AlexInput = (Char,[Byte],String)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (c,_,_) = c++-- alexScanTokens :: String -> [token]+alexScanTokens str = go ('\n',[],str)+  where go inp__@(_,_bs,s) =+          case alexScan inp__ 0 of+                AlexEOF -> []+                AlexError _ -> error "lexical error"+                AlexSkip  inp__' _ln     -> go inp__'+                AlexToken inp__' len act -> act (take len s) : go inp__'++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (c,(b:bs),s) = Just (b,(c,bs,s))+alexGetByte (_,[],[])    = Nothing+alexGetByte (_,[],(c:s)) = case utf8Encode c of+                             (b:bs) -> Just (b, (c, bs, s))+                             [] -> Nothing++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-basic-bytestring view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)+++import Data.Int (Int64)+import qualified Data.Char+import qualified Data.ByteString.Lazy     as ByteString+import qualified Data.ByteString.Internal as ByteString (w2c)+++++++++++++++++++++++++++++++++++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type++++++++++++++++++++++++++++++++++++++++++++++data AlexInput = AlexInput { alexChar :: {-# UNPACK #-} !Char,      -- previous char+                             alexStr ::  !ByteString.ByteString,    -- current input string+                             alexBytePos :: {-# UNPACK #-} !Int64}  -- bytes consumed so far++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar = alexChar++alexGetByte (AlexInput {alexStr=cs,alexBytePos=n}) =+    case ByteString.uncons cs of+        Nothing -> Nothing+        Just (c, rest) ->+            Just (c, AlexInput {+                alexChar = ByteString.w2c c,+                alexStr =  rest,+                alexBytePos = n+1})+++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++++++++++++++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version++++-- alexScanTokens :: ByteString.ByteString -> [token]+alexScanTokens str = go (AlexInput '\n' str 0)+  where go inp__ =+          case alexScan inp__ 0 of+                AlexEOF -> []+                AlexError _ -> error "lexical error"+                AlexSkip  inp__' _len  -> go inp__'+                AlexToken inp__' _ act ->+                  let len = alexBytePos inp__' - alexBytePos inp__ in+                  act (ByteString.take len (alexStr inp__)) : go inp__'++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-gscan view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c+                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.+++alexGScan stop__ state__ inp__ =+  alex_gscan stop__ alexStartPos '\n' [] inp__ (0,state__)++alex_gscan stop__ p c bs inp__ (sc,state__) =+  case alexScan (p,c,bs,inp__) sc of+        AlexEOF     -> stop__ p c inp__ (sc,state__)+        AlexError _ -> stop__ p c inp__ (sc,state__)+        AlexSkip (p',c',bs',inp__') _len ->+          alex_gscan stop__ p' c' bs' inp__' (sc,state__)+        AlexToken (p',c',bs',inp__') len k ->+           k p c inp__ len (\scs -> alex_gscan stop__ p' c' bs' inp__' scs)                  (sc,state__)+
+ data/AlexWrapper-monad view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++import Control.Applicative as App (Applicative (..))+import qualified Control.Monad (ap)+++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c+                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++data AlexState = AlexState {+        alex_pos :: !AlexPosn,  -- position at current input location+        alex_inp :: String,     -- the current input+        alex_chr :: !Char,      -- the character before the input+        alex_bytes :: [Byte],+        alex_scd :: !Int        -- the current startcode++++    }++-- Compile with -funbox-strict-fields for best results!++runAlex :: String -> Alex a -> Either String a+runAlex input__ (Alex f)+   = case f (AlexState {alex_pos = alexStartPos,+                        alex_inp = input__,+                        alex_chr = '\n',+                        alex_bytes = [],++++                        alex_scd = 0}) of Left msg -> Left msg+                                          Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Functor Alex where+  fmap f a = Alex $ \s -> case unAlex a s of+                            Left msg -> Left msg+                            Right (s', a') -> Right (s', f a')++instance Applicative Alex where+  pure a   = Alex $ \s -> Right (s, a)+  fa <*> a = Alex $ \s -> case unAlex fa s of+                            Left msg -> Left msg+                            Right (s', f) -> case unAlex a s' of+                                               Left msg -> Left msg+                                               Right (s'', b) -> Right (s'', f b)++instance Monad Alex where+  m >>= k  = Alex $ \s -> case unAlex m s of+                                Left msg -> Left msg+                                Right (s',a) -> unAlex (k a) s'+  return = App.pure++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->+        Right (s, (pos,c,bs,inp__))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,bs,inp__)+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of+                  state__@(AlexState{}) -> Right (state__, ())++alexError :: String -> Alex a+alexError message = Alex $ const $ Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())++++++++++alexMonadScan = do+  inp__ <- alexGetInput+  sc <- alexGetStartCode+  case alexScan inp__ sc of+    AlexEOF -> alexEOF+    AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+    AlexSkip  inp__' _len -> do+        alexSetInput inp__'+        alexMonadScan+    AlexToken inp__' len action -> do+        alexSetInput inp__'+        action (ignorePendingBytes inp__) len++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int -> Alex result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip _input _len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code _input _len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input__ len = do+  alexSetStartCode code+  action input__ len++token :: (AlexInput -> Int -> token) -> AlexAction token+token t input__ len = return (t input__ len)++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-monad-bytestring view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++import Control.Applicative as App (Applicative (..))+import qualified Control.Monad (ap)+++import Data.Word (Word8)+++import Data.Int (Int64)+import qualified Data.Char+import qualified Data.ByteString.Lazy     as ByteString+import qualified Data.ByteString.Internal as ByteString (w2c)+++++++++++++++++++++++++++++++++++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++++++++++++++++++++++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  ByteString.ByteString,        -- current input string+                  Int64)           -- bytes consumed so far++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes i = i   -- no pending bytes when lexing bytestrings++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_,c,_,_) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,_,cs,n) =+    case ByteString.uncons cs of+        Nothing -> Nothing+        Just (b, cs') ->+            let c   = ByteString.w2c b+                p'  = alexMove p c+                n'  = n+1+            in p' `seq` cs' `seq` n' `seq` Just (b, (p', c, cs',n'))+++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)+++data AlexState = AlexState {+        alex_pos :: !AlexPosn,  -- position at current input location+        alex_bpos:: !Int64,     -- bytes consumed so far+        alex_inp :: ByteString.ByteString,      -- the current input+        alex_chr :: !Char,      -- the character before the input+        alex_scd :: !Int        -- the current startcode++++    }++-- Compile with -funbox-strict-fields for best results!++runAlex :: ByteString.ByteString -> Alex a -> Either String a+runAlex input__ (Alex f)+   = case f (AlexState {alex_pos = alexStartPos,+                        alex_bpos = 0,+                        alex_inp = input__,+                        alex_chr = '\n',++++                        alex_scd = 0}) of Left msg -> Left msg+                                          Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Functor Alex where+  fmap f m = do x <- m; return (f x)++instance Applicative Alex where+  pure a = Alex $ \s -> Right (s,a)+  (<*>) = Control.Monad.ap++instance Monad Alex where+  m >>= k  = Alex $ \s -> case unAlex m s of+                                Left msg -> Left msg+                                Right (s',a) -> unAlex (k a) s'+  return = App.pure++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->+        Right (s, (pos,c,inp__,bpos))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,inp__,bpos)+ = Alex $ \s -> case s{alex_pos=pos,+                       alex_bpos=bpos,+                       alex_chr=c,+                       alex_inp=inp__} of+                  state__@(AlexState{}) -> Right (state__, ())++alexError :: String -> Alex a+alexError message = Alex $ const $ Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())++alexMonadScan = do+  inp__@(_,_,_,n) <- alexGetInput+  sc <- alexGetStartCode+  case alexScan inp__ sc of+    AlexEOF -> alexEOF+    AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+    AlexSkip  inp__' _len -> do+        alexSetInput inp__'+        alexMonadScan+    AlexToken inp__'@(_,_,_,n') _ action -> do+        alexSetInput inp__'+        action (ignorePendingBytes inp__) len+      where+        len = n'-n++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int64 -> Alex result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip _input _len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code _input _len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input__ len = do+  alexSetStartCode code+  action input__ len++token :: (AlexInput -> Int64 -> token) -> AlexAction token+token t input__ len = return (t input__ len)++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-monadUserState view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++import Control.Applicative as App (Applicative (..))+import qualified Control.Monad (ap)+++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c+                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++data AlexState = AlexState {+        alex_pos :: !AlexPosn,  -- position at current input location+        alex_inp :: String,     -- the current input+        alex_chr :: !Char,      -- the character before the input+        alex_bytes :: [Byte],+        alex_scd :: !Int        -- the current startcode++      , alex_ust :: AlexUserState -- AlexUserState will be defined in the user program++    }++-- Compile with -funbox-strict-fields for best results!++runAlex :: String -> Alex a -> Either String a+runAlex input__ (Alex f)+   = case f (AlexState {alex_pos = alexStartPos,+                        alex_inp = input__,+                        alex_chr = '\n',+                        alex_bytes = [],++                        alex_ust = alexInitUserState,++                        alex_scd = 0}) of Left msg -> Left msg+                                          Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Functor Alex where+  fmap f a = Alex $ \s -> case unAlex a s of+                            Left msg -> Left msg+                            Right (s', a') -> Right (s', f a')++instance Applicative Alex where+  pure a   = Alex $ \s -> Right (s, a)+  fa <*> a = Alex $ \s -> case unAlex fa s of+                            Left msg -> Left msg+                            Right (s', f) -> case unAlex a s' of+                                               Left msg -> Left msg+                                               Right (s'', b) -> Right (s'', f b)++instance Monad Alex where+  m >>= k  = Alex $ \s -> case unAlex m s of+                                Left msg -> Left msg+                                Right (s',a) -> unAlex (k a) s'+  return = App.pure++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} ->+        Right (s, (pos,c,bs,inp__))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,bs,inp__)+ = Alex $ \s -> case s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp__} of+                  state__@(AlexState{}) -> Right (state__, ())++alexError :: String -> Alex a+alexError message = Alex $ const $ Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())+++alexGetUserState :: Alex AlexUserState+alexGetUserState = Alex $ \s@AlexState{alex_ust=ust} -> Right (s,ust)++alexSetUserState :: AlexUserState -> Alex ()+alexSetUserState ss = Alex $ \s -> Right (s{alex_ust=ss}, ())+++alexMonadScan = do+  inp__ <- alexGetInput+  sc <- alexGetStartCode+  case alexScan inp__ sc of+    AlexEOF -> alexEOF+    AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+    AlexSkip  inp__' _len -> do+        alexSetInput inp__'+        alexMonadScan+    AlexToken inp__' len action -> do+        alexSetInput inp__'+        action (ignorePendingBytes inp__) len++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int -> Alex result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip _input _len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code _input _len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input__ len = do+  alexSetStartCode code+  action input__ len++token :: (AlexInput -> Int -> token) -> AlexAction token+token t input__ len = return (t input__ len)++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-monadUserState-bytestring view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++import Control.Applicative as App (Applicative (..))+import qualified Control.Monad (ap)+++import Data.Word (Word8)+++import Data.Int (Int64)+import qualified Data.Char+import qualified Data.ByteString.Lazy     as ByteString+import qualified Data.ByteString.Internal as ByteString (w2c)+++++++++++++++++++++++++++++++++++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++++++++++++++++++++++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  ByteString.ByteString,        -- current input string+                  Int64)           -- bytes consumed so far++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes i = i   -- no pending bytes when lexing bytestrings++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_,c,_,_) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,_,cs,n) =+    case ByteString.uncons cs of+        Nothing -> Nothing+        Just (b, cs') ->+            let c   = ByteString.w2c b+                p'  = alexMove p c+                n'  = n+1+            in p' `seq` cs' `seq` n' `seq` Just (b, (p', c, cs',n'))+++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)+++data AlexState = AlexState {+        alex_pos :: !AlexPosn,  -- position at current input location+        alex_bpos:: !Int64,     -- bytes consumed so far+        alex_inp :: ByteString.ByteString,      -- the current input+        alex_chr :: !Char,      -- the character before the input+        alex_scd :: !Int        -- the current startcode++      , alex_ust :: AlexUserState -- AlexUserState will be defined in the user program++    }++-- Compile with -funbox-strict-fields for best results!++runAlex :: ByteString.ByteString -> Alex a -> Either String a+runAlex input__ (Alex f)+   = case f (AlexState {alex_pos = alexStartPos,+                        alex_bpos = 0,+                        alex_inp = input__,+                        alex_chr = '\n',++                        alex_ust = alexInitUserState,++                        alex_scd = 0}) of Left msg -> Left msg+                                          Right ( _, a ) -> Right a++newtype Alex a = Alex { unAlex :: AlexState -> Either String (AlexState, a) }++instance Functor Alex where+  fmap f m = do x <- m; return (f x)++instance Applicative Alex where+  pure a = Alex $ \s -> Right (s,a)+  (<*>) = Control.Monad.ap++instance Monad Alex where+  m >>= k  = Alex $ \s -> case unAlex m s of+                                Left msg -> Left msg+                                Right (s',a) -> unAlex (k a) s'+  return = App.pure++alexGetInput :: Alex AlexInput+alexGetInput+ = Alex $ \s@AlexState{alex_pos=pos,alex_bpos=bpos,alex_chr=c,alex_inp=inp__} ->+        Right (s, (pos,c,inp__,bpos))++alexSetInput :: AlexInput -> Alex ()+alexSetInput (pos,c,inp__,bpos)+ = Alex $ \s -> case s{alex_pos=pos,+                       alex_bpos=bpos,+                       alex_chr=c,+                       alex_inp=inp__} of+                  state__@(AlexState{}) -> Right (state__, ())++alexError :: String -> Alex a+alexError message = Alex $ const $ Left message++alexGetStartCode :: Alex Int+alexGetStartCode = Alex $ \s@AlexState{alex_scd=sc} -> Right (s, sc)++alexSetStartCode :: Int -> Alex ()+alexSetStartCode sc = Alex $ \s -> Right (s{alex_scd=sc}, ())++alexMonadScan = do+  inp__@(_,_,_,n) <- alexGetInput+  sc <- alexGetStartCode+  case alexScan inp__ sc of+    AlexEOF -> alexEOF+    AlexError ((AlexPn _ line column),_,_,_) -> alexError $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+    AlexSkip  inp__' _len -> do+        alexSetInput inp__'+        alexMonadScan+    AlexToken inp__'@(_,_,_,n') _ action -> do+        alexSetInput inp__'+        action (ignorePendingBytes inp__) len+      where+        len = n'-n++-- -----------------------------------------------------------------------------+-- Useful token actions++type AlexAction result = AlexInput -> Int64 -> Alex result++-- just ignore this token and scan another one+-- skip :: AlexAction result+skip _input _len = alexMonadScan++-- ignore this token, but set the start code to a new value+-- begin :: Int -> AlexAction result+begin code _input _len = do alexSetStartCode code; alexMonadScan++-- perform an action for this token, and set the start code to a new value+andBegin :: AlexAction result -> Int -> AlexAction result+(action `andBegin` code) input__ len = do+  alexSetStartCode code+  action input__ len++token :: (AlexInput -> Int64 -> token) -> AlexAction token+token t input__ len = return (t input__ len)++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-posn view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)+++++++++++++++++import Data.Char (ord)+import qualified Data.Bits++-- | Encode a Haskell String to a list of Word8 values, in UTF8 format.+utf8Encode :: Char -> [Word8]+utf8Encode = map fromIntegral . go . ord+ where+  go oc+   | oc <= 0x7f       = [oc]++   | oc <= 0x7ff      = [ 0xc0 + (oc `Data.Bits.shiftR` 6)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++   | oc <= 0xffff     = [ 0xe0 + (oc `Data.Bits.shiftR` 12)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]+   | otherwise        = [ 0xf0 + (oc `Data.Bits.shiftR` 18)+                        , 0x80 + ((oc `Data.Bits.shiftR` 12) Data.Bits..&. 0x3f)+                        , 0x80 + ((oc `Data.Bits.shiftR` 6) Data.Bits..&. 0x3f)+                        , 0x80 + oc Data.Bits..&. 0x3f+                        ]++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  [Byte],       -- pending bytes on current char+                  String)       -- current input string++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes (p,c,_ps,s) = (p,c,[],s)++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_p,c,_bs,_s) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,c,(b:bs),s) = Just (b,(p,c,bs,s))+alexGetByte (_,_,[],[]) = Nothing+alexGetByte (p,_,[],(c:s))  = let p' = alexMove p c+                                  (b:bs) = utf8Encode c+                              in p' `seq`  Just (b, (p', c, bs, s))++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.+++--alexScanTokens :: String -> [token]+alexScanTokens str0 = go (alexStartPos,'\n',[],str0)+  where go inp__@(pos,_,_,str) =+          case alexScan inp__ 0 of+                AlexEOF -> []+                AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+                AlexSkip  inp__' _ln     -> go inp__'+                AlexToken inp__' len act -> act pos (take len str) : go inp__'++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-posn-bytestring view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)+++import Data.Int (Int64)+import qualified Data.Char+import qualified Data.ByteString.Lazy     as ByteString+import qualified Data.ByteString.Internal as ByteString (w2c)+++++++++++++++++++++++++++++++++++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type+++++++++++++++++++++++type AlexInput = (AlexPosn,     -- current position,+                  Char,         -- previous char+                  ByteString.ByteString,        -- current input string+                  Int64)           -- bytes consumed so far++ignorePendingBytes :: AlexInput -> AlexInput+ignorePendingBytes i = i   -- no pending bytes when lexing bytestrings++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar (_,c,_,_) = c++alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)+alexGetByte (p,_,cs,n) =+    case ByteString.uncons cs of+        Nothing -> Nothing+        Just (b, cs') ->+            let c   = ByteString.w2c b+                p'  = alexMove p c+                n'  = n+1+            in p' `seq` cs' `seq` n' `seq` Just (b, (p', c, cs',n'))+++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++data AlexPosn = AlexPn !Int !Int !Int+        deriving (Eq,Show)++alexStartPos :: AlexPosn+alexStartPos = AlexPn 0 1 1++alexMove :: AlexPosn -> Char -> AlexPosn+alexMove (AlexPn a l c) '\t' = AlexPn (a+1)  l     (((c+alex_tab_size-1) `div` alex_tab_size)*alex_tab_size+1)+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1)   1+alexMove (AlexPn a l c) _    = AlexPn (a+1)  l     (c+1)+++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++--alexScanTokens :: ByteString.ByteString -> [token]+alexScanTokens str0 = go (alexStartPos,'\n',str0,0)+  where go inp__@(pos,_,str,n) =+          case alexScan inp__ 0 of+                AlexEOF -> []+                AlexError ((AlexPn _ line column),_,_,_) -> error $ "lexical error at line " ++ (show line) ++ ", column " ++ (show column)+                AlexSkip  inp__' _len       -> go inp__'+                AlexToken inp__'@(_,_,_,n') _ act ->+                  act pos (ByteString.take (n'-n) str) : go inp__'++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
+ data/AlexWrapper-strict-bytestring view
@@ -0,0 +1,493 @@+{-# LINE 1 "templates/wrappers.hs" #-}+-- -----------------------------------------------------------------------------+-- Alex wrapper code.+--+-- This code is in the PUBLIC DOMAIN; you may copy it freely and use+-- it for any purpose whatsoever.+++++++import Data.Word (Word8)++++++++++import qualified Data.Char+import qualified Data.ByteString          as ByteString+import qualified Data.ByteString.Internal as ByteString hiding (ByteString)+import qualified Data.ByteString.Unsafe   as ByteString++++++++++++++++++++++++++++++type Byte = Word8++-- -----------------------------------------------------------------------------+-- The input type++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++data AlexInput = AlexInput { alexChar :: {-# UNPACK #-} !Char,+                             alexStr :: {-# UNPACK #-} !ByteString.ByteString,+                             alexBytePos :: {-# UNPACK #-} !Int}++alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar = alexChar++alexGetByte (AlexInput {alexStr=cs,alexBytePos=n}) =+    case ByteString.uncons cs of+        Nothing -> Nothing+        Just (c, rest) ->+            Just (c, AlexInput {+                alexChar = ByteString.w2c c,+                alexStr =  rest,+                alexBytePos = n+1})+++-- -----------------------------------------------------------------------------+-- Token positions++-- `Posn' records the location of a token in the input text.  It has three+-- fields: the address (number of chacaters preceding the token), line number+-- and column of a token within the file. `start_pos' gives the position of the+-- start of the file and `eof_pos' a standard encoding for the end of file.+-- `move_pos' calculates the new position after traversing a given character,+-- assuming the usual eight character tab stops.+++++++++++++++-- -----------------------------------------------------------------------------+-- Default monad+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Monad (with ByteString input)++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper++++++++++++++++++++++++++-- -----------------------------------------------------------------------------+-- Basic wrapper, ByteString version+++++++++++++++++++-- alexScanTokens :: ByteString.ByteString -> [token]+alexScanTokens str = go (AlexInput '\n' str 0)+  where go inp__ =+          case alexScan inp__ 0 of+                AlexEOF -> []+                AlexError _ -> error "lexical error"+                AlexSkip  inp__' _len  -> go inp__'+                AlexToken inp__' _ act ->+                  let len = alexBytePos inp__' - alexBytePos inp__ in+                  act (ByteString.take len (alexStr inp__)) : go inp__'+++++-- -----------------------------------------------------------------------------+-- Posn wrapper++-- Adds text positions to the basic model.++++++++++++++-- -----------------------------------------------------------------------------+-- Posn wrapper, ByteString version+++++++++++++++-- -----------------------------------------------------------------------------+-- GScan wrapper++-- For compatibility with previous versions of Alex, and because we can.++++++++++++++
src/Data/Ranged/Boundaries.hs view
@@ -19,9 +19,8 @@    (/>/) ) where -import Data.Ratio-import Data.Word-import Test.QuickCheck+import           Data.Ratio+import           Data.Word  infix 4 />/ @@ -168,10 +167,10 @@  -- | True if the value is above the boundary, false otherwise. above :: Ord v => Boundary v -> v -> Bool-above (BoundaryAbove b) v    = v > b-above (BoundaryBelow b) v    = v >= b-above BoundaryAboveAll _     = False-above BoundaryBelowAll _     = True+above (BoundaryAbove b) v = v > b+above (BoundaryBelow b) v = v >= b+above BoundaryAboveAll _  = False+above BoundaryBelowAll _  = True  -- | Same as 'above', but with the arguments reversed for more intuitive infix -- usage.@@ -210,26 +209,8 @@          BoundaryAboveAll ->             case boundary2 of                BoundaryAboveAll -> EQ-               _        -> GT+               _                -> GT          BoundaryBelowAll ->             case boundary2 of                BoundaryBelowAll -> EQ-               _        -> LT---- QuickCheck Generator--instance Arbitrary a => Arbitrary (Boundary a) where-   arbitrary = frequency [-      (1, return BoundaryAboveAll),-      (1, return BoundaryBelowAll),-      (18, do-         v <- arbitrary-         oneof [return $ BoundaryAbove v, return $ BoundaryBelow v]-      )]--instance CoArbitrary a => CoArbitrary (Boundary a) where-   coarbitrary BoundaryBelowAll   = variant (0 :: Int)-   coarbitrary BoundaryAboveAll   = variant (1 :: Int)-   coarbitrary (BoundaryBelow v)  = variant (2 :: Int) . coarbitrary v-   coarbitrary (BoundaryAbove v)  = variant (3 :: Int) . coarbitrary v-+               _                -> LT
src/Data/Ranged/RangedSet.hs view
@@ -23,37 +23,6 @@    -- ** Useful Sets    rSetEmpty,    rSetFull,-   -- ** QuickCheck Properties-   -- *** Construction-   prop_validNormalised,-   prop_has,-   prop_unfold,-   -- *** Basic Operations-   prop_union,-   prop_intersection,-   prop_difference,-   prop_negation,-   prop_not_empty,-   -- *** Some Identities and Inequalities-   -- $ConstructionProperties-   -- $BasicOperationProperties-   -- $SomeIdentitiesAndInequalities-   prop_empty,-   prop_full,-   prop_empty_intersection,-   prop_full_union,-   prop_union_superset,-   prop_intersection_subset,-   prop_diff_intersect,-   prop_subset,-   prop_strict_subset,-   prop_union_strict_superset,-   prop_intersection_commutes,-   prop_union_commutes,-   prop_intersection_associates,-   prop_union_associates,-   prop_de_morgan_intersection,-   prop_de_morgan_union, ) where  import Data.Ranged.Boundaries@@ -65,7 +34,6 @@ #endif  import Data.List-import Test.QuickCheck  infixl 7 -/\- infixl 6 -\/-, -!-@@ -256,244 +224,3 @@          : case succFunc b of             Just b2 -> ranges1 b2             Nothing -> []----- QuickCheck Generators--instance (Arbitrary v, DiscreteOrdered v) =>-      Arbitrary (RSet v)-   where-   arbitrary = frequency [-      (1, return rSetEmpty),-      (1, return rSetFull),-      (18, do-         ls <- arbitrary-         return $ makeRangedSet $ rangeList $ sort ls-      )]-      where-         -- Arbitrary lists of ranges don't give many interesting sets after-         -- normalisation.  So instead generate a sorted list of boundaries-         -- and pair them off.  Odd boundaries are dropped.-         rangeList (b1:b2:bs) = Range b1 b2 : rangeList bs-         rangeList _ = []--instance (CoArbitrary v, DiscreteOrdered v) =>-      CoArbitrary (RSet v)-   where-   coarbitrary (RSet ls) = variant (0 :: Int) . coarbitrary ls---- ==================================================================--- QuickCheck Properties--- ==================================================================-------------------------------------------------------------------------- Construction properties-------------------------------------------------------------------------- | A normalised range list is valid for unsafeRangedSet------ > prop_validNormalised ls = validRangeList $ normaliseRangeList ls-prop_validNormalised :: (DiscreteOrdered a) => [Range a] -> Bool-prop_validNormalised ls = validRangeList $ normaliseRangeList ls----- | Iff a value is in a range list then it is in a ranged set--- constructed from that list.------ > prop_has ls v = (ls `rangeListHas` v) == makeRangedSet ls -?- v-prop_has :: (DiscreteOrdered a) => [Range a] -> a -> Bool-prop_has ls v = (ls `rangeListHas` v) == makeRangedSet ls -?- v----- | Verifies the correct membership of a set containing all integers--- starting with the digit \"1\" up to 19999.------ > prop_unfold = (v <= 99999 && head (show v) == '1') == (initial1 -?- v)--- >    where--- >       initial1 = rSetUnfold (BoundaryBelow 1) addNines times10--- >       addNines (BoundaryBelow n) = BoundaryAbove $ n * 2 - 1--- >       times10 (BoundaryBelow n) =--- >          if n <= 1000 then Just $ BoundaryBelow $ n * 10 else Nothing--prop_unfold :: Integer -> Bool-prop_unfold v = (v <= 99999 && head (show v) == '1') == (initial1 -?- v)-   where-      initial1 = rSetUnfold (BoundaryBelow 1) addNines times10-      addNines (BoundaryBelow n) = BoundaryAbove $ n * 2 - 1-      addNines _ = error "Can't happen"-      times10 (BoundaryBelow n) =-         if n <= 10000 then Just $ BoundaryBelow $ n * 10 else Nothing-      times10 _ = error "Can't happen"-------------------------------------------------------------------------- Basic operation properties-------------------------------------------------------------------------- | Iff a value is in either of two ranged sets then it is in the union of--- those two sets.------ > prop_union rs1 rs2 v =--- >    (rs1 -?- v || rs2 -?- v) == ((rs1 -\/- rs2) -?- v)-prop_union :: (DiscreteOrdered a ) => RSet a -> RSet a -> a -> Bool-prop_union rs1 rs2 v = (rs1 -?- v || rs2 -?- v) == ((rs1 -\/- rs2) -?- v)---- | Iff a value is in both of two ranged sets then it is n the intersection--- of those two sets.------ > prop_intersection rs1 rs2 v =--- >    (rs1 -?- v && rs2 -?- v) == ((rs1 -/\- rs2) -?- v)-prop_intersection :: (DiscreteOrdered a) => RSet a -> RSet a -> a -> Bool-prop_intersection rs1 rs2 v =-   (rs1 -?- v && rs2 -?- v) == ((rs1 -/\- rs2) -?- v)---- | Iff a value is in ranged set 1 and not in ranged set 2 then it is in the--- difference of the two.------ > prop_difference rs1 rs2 v =--- >    (rs1 -?- v && not (rs2 -?- v)) == ((rs1 -!- rs2) -?- v)-prop_difference :: (DiscreteOrdered a) => RSet a -> RSet a -> a -> Bool-prop_difference rs1 rs2 v =-   (rs1 -?- v && not (rs2 -?- v)) == ((rs1 -!- rs2) -?- v)---- | Iff a value is not in a ranged set then it is in its negation.------ > prop_negation rs v = rs -?- v == not (rSetNegation rs -?- v)-prop_negation :: (DiscreteOrdered a) => RSet a -> a -> Bool-prop_negation rs v = rs -?- v == not (rSetNegation rs -?- v)---- | A set that contains a value is not empty------ > prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs)-prop_not_empty :: (DiscreteOrdered a) => RSet a -> a -> Property-prop_not_empty rs v = (rs -?- v) ==> not (rSetIsEmpty rs)-------------------------------------------------------------------------- Some identities and inequalities of sets-------------------------------------------------------------------------- | The empty set has no members.------ > prop_empty v = not (rSetEmpty -?- v)-prop_empty :: (DiscreteOrdered a) => a -> Bool-prop_empty v = not (rSetEmpty -?- v)---- | The full set has every member.------ > prop_full v = rSetFull -?- v-prop_full :: (DiscreteOrdered a) => a -> Bool-prop_full v = rSetFull -?- v---- | The intersection of a set with its negation is empty.------ > prop_empty_intersection rs =--- >    rSetIsEmpty (rs -/\- rSetNegation rs)-prop_empty_intersection :: (DiscreteOrdered a) => RSet a -> Bool-prop_empty_intersection rs =-   rSetIsEmpty (rs -/\- rSetNegation rs)---- | The union of a set with its negation is full.------ > prop_full_union rs v =--- >    rSetIsFull (rs -\/- rSetNegation rs)-prop_full_union :: (DiscreteOrdered a) => RSet a -> Bool-prop_full_union rs =-   rSetIsFull (rs -\/- rSetNegation rs)---- | The union of two sets is the non-strict superset of both.------ > prop_union_superset rs1 rs2 =--- >    rs1 -<=- u && rs2 -<=- u--- >    where--- >       u = rs1 -\/- rs2-prop_union_superset :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_union_superset rs1 rs2 =-   rs1 -<=- u && rs2 -<=- u-   where-      u = rs1 -\/- rs2---- | The intersection of two sets is the non-strict subset of both.------ > prop_intersection_subset rs1 rs2 =--- >    i -<=- rs1 && i -<=- rs2--- >    where--- >       i = rs1 -/\- rs2-prop_intersection_subset :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_intersection_subset rs1 rs2 = i -<=- rs1 && i -<=- rs2-   where-      i = rs1 -/\- rs2---- | The difference of two sets intersected with the subtractand is empty.------ > prop_diff_intersect rs1 rs2 =--- >    rSetIsEmpty ((rs1 -!- rs2) -/\- rs2)-prop_diff_intersect :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_diff_intersect rs1 rs2 = rSetIsEmpty ((rs1 -!- rs2) -/\- rs2)---- | A set is the non-strict subset of itself.------ > prop_subset rs = rs -<=- rs-prop_subset :: (DiscreteOrdered a) => RSet a -> Bool-prop_subset rs = rs -<=- rs---- | A set is not the strict subset of itself.------ > prop_strict_subset rs = not (rs -<- rs)-prop_strict_subset :: (DiscreteOrdered a) => RSet a -> Bool-prop_strict_subset rs = not (rs -<- rs)---- | If rs1 - rs2 is not empty then the union of rs1 and rs2 will be a strict--- superset of rs2.------ > prop_union_strict_superset rs1 rs2 =--- >    (not $ rSetIsEmpty (rs1 -!- rs2))--- >    ==> (rs2 -<- (rs1 -\/- rs2))-prop_union_strict_superset :: (DiscreteOrdered a) => RSet a -> RSet a -> Property-prop_union_strict_superset rs1 rs2 =-   (not $ rSetIsEmpty (rs1 -!- rs2)) ==> (rs2 -<- (rs1 -\/- rs2))---- | Intersection commutes.------ > prop_intersection_commutes rs1 rs2 = (rs1 -/\- rs2) == (rs2 -/\- rs1)-prop_intersection_commutes :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_intersection_commutes rs1 rs2 = (rs1 -/\- rs2) == (rs2 -/\- rs1)---- | Union commutes.------ > prop_union_commutes rs1 rs2 = (rs1 -\/- rs2) == (rs2 -\/- rs1)-prop_union_commutes :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_union_commutes rs1 rs2 = (rs1 -\/- rs2) == (rs2 -\/- rs1)---- | Intersection associates.------ > prop_intersection_associates rs1 rs2 rs3 =--- >    ((rs1 -/\- rs2) -/\- rs3) == (rs1 -/\- (rs2 -/\- rs3))-prop_intersection_associates :: (DiscreteOrdered a) =>-   RSet a -> RSet a  -> RSet a -> Bool-prop_intersection_associates rs1 rs2 rs3 =-   ((rs1 -/\- rs2) -/\- rs3) == (rs1 -/\- (rs2 -/\- rs3))---- | Union associates.------ > prop_union_associates rs1 rs2 rs3 =--- >    ((rs1 -\/- rs2) -\/- rs3) == (rs1 -\/- (rs2 -\/- rs3))-prop_union_associates :: (DiscreteOrdered a) =>-   RSet a -> RSet a  -> RSet a -> Bool-prop_union_associates rs1 rs2 rs3 =-   ((rs1 -\/- rs2) -\/- rs3) == (rs1 -\/- (rs2 -\/- rs3))---- | De Morgan's Law for Intersection.------ > prop_de_morgan_intersection rs1 rs2 =--- >    rSetNegation (rs1 -/\- rs2) == (rSetNegation rs1 -\/- rSetNegation rs2)-prop_de_morgan_intersection :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_de_morgan_intersection rs1 rs2 =-   rSetNegation (rs1 -/\- rs2) == (rSetNegation rs1 -\/- rSetNegation rs2)---- | De Morgan's Law for Union.------ > prop_de_morgan_union rs1 rs2 =--- >    rSetNegation (rs1 -\/- rs2) == (rSetNegation rs1 -/\- rSetNegation rs2)--prop_de_morgan_union :: (DiscreteOrdered a) => RSet a -> RSet a -> Bool-prop_de_morgan_union rs1 rs2 =-   rSetNegation (rs1 -\/- rs2) == (rSetNegation rs1 -/\- rSetNegation rs2)
src/Data/Ranged/Ranges.hs view
@@ -29,26 +29,9 @@    rangeIntersection,    rangeUnion,    rangeDifference,-   -- ** QuickCheck properties-   prop_unionRange,-   prop_unionRangeLength,-   prop_intersectionRange,-   prop_differenceRange,-   prop_intersectionOverlap,-   prop_enclosureUnion,-   prop_singletonRangeHas,-   prop_singletonRangeHasOnly,-   prop_singletonRangeConverse,-   prop_emptyNonSingleton,-   prop_fullNonSingleton,-   prop_nonSingleton,-   prop_intSingleton ) where -import Control.Monad-import Data.Ranged.Boundaries-import Data.Maybe-import Test.QuickCheck+import           Data.Ranged.Boundaries  -- | A Range has upper and lower boundaries. data Range v = Range {rangeLower, rangeUpper :: Boundary v}@@ -211,150 +194,3 @@          [r1]    where       intersects = (max lower1 lower2) < (min upper1 upper2)----- QuickCheck generators--instance (Arbitrary v,  DiscreteOrdered v) =>-   Arbitrary (Range v) where--   arbitrary = frequency [-      (17, do  -- Ordinary range-         b1 <- arbitrary-         b2 <- arbitrary-         if b1 < b2-            then return $ Range b1 b2-            else return $ Range b2 b1-      ),-      (1, do  -- Singleton range-         v <- arbitrary-         return $ singletonRange v-      ),-      (1, return emptyRange),-      (1, return fullRange)-      ]--instance (CoArbitrary v, DiscreteOrdered v) =>-   CoArbitrary (Range v) where--   coarbitrary (Range lower upper) =-      variant (0 :: Int) . coarbitrary lower . coarbitrary upper------ QuickCheck Properties---- | The union of two ranges has a value iff either range has it.------ > prop_unionRange r1 r2 n =--- >    (r1 `rangeHas` n || r2 `rangeHas` n)--- >    == (r1 `rangeUnion` r2) `rangeListHas` n-prop_unionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool-prop_unionRange r1 r2 n =-   (r1 `rangeHas` n || r2 `rangeHas` n)-   == (r1 `rangeUnion` r2) `rangeListHas` n---- | The union of two ranges always contains one or two ranges.------ > prop_unionRangeLength r1 r2 = (n == 1) || (n == 2)--- >    where n = length $ rangeUnion r1 r2-prop_unionRangeLength :: (DiscreteOrdered a) => Range a -> Range a -> Bool-prop_unionRangeLength r1 r2 = (n == 1) || (n == 2)-   where n = length $ rangeUnion r1 r2---- | The intersection of two ranges has a value iff both ranges have it.------ > prop_intersectionRange r1 r2 n =--- >    (r1 `rangeHas` n && r2 `rangeHas` n)--- >    == (r1 `rangeIntersection` r2) `rangeHas` n-prop_intersectionRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool-prop_intersectionRange r1 r2 n =-   (r1 `rangeHas` n && r2 `rangeHas` n)-   == (r1 `rangeIntersection` r2) `rangeHas` n---- | The difference of two ranges has a value iff the first range has it and--- the second does not.------ > prop_differenceRange r1 r2 n =--- >    (r1 `rangeHas` n && not (r2 `rangeHas` n))--- >    == (r1 `rangeDifference` r2) `rangeListHas` n-prop_differenceRange :: (DiscreteOrdered a) => Range a -> Range a -> a -> Bool-prop_differenceRange r1 r2 n =-   (r1 `rangeHas` n && not (r2 `rangeHas` n))-   == (r1 `rangeDifference` r2) `rangeListHas` n---- | Iff two ranges overlap then their intersection is non-empty.------ > prop_intersectionOverlap r1 r2 =--- >     (rangeIsEmpty $ rangeIntersection r1 r2) == (rangeOverlap r1 r2)-prop_intersectionOverlap :: (DiscreteOrdered a) => Range a -> Range a -> Bool-prop_intersectionOverlap r1 r2 =-    (rangeIsEmpty $ rangeIntersection r1 r2) == not (rangeOverlap r1 r2)---- | Range enclosure makes union an identity function.------ > prop_enclosureUnion r1 r2 =--- >    rangeEncloses r1 r2 == (rangeUnion r1 r2 == [r1])-prop_enclosureUnion :: (DiscreteOrdered a) => Range a -> Range a -> Bool-prop_enclosureUnion r1 r2 = rangeEncloses r1 r2 == (rangeUnion r1 r2 == [r1])---- | Range Singleton has its member.------ > prop_singletonRangeHas v = singletonRange v `rangeHas` v-prop_singletonRangeHas :: (DiscreteOrdered a) => a -> Bool-prop_singletonRangeHas v = singletonRange v `rangeHas` v---- | Range Singleton has only its member.------ > prop_singletonHasOnly v1 v2 =--- >    (v1 == v2) == (singletonRange v1 `rangeHas` v2)-prop_singletonRangeHasOnly :: (DiscreteOrdered a) => a -> a -> Bool-prop_singletonRangeHasOnly v1 v2 =-   (v1 == v2) == (singletonRange v1 `rangeHas` v2)---- | A singleton range can have its value extracted.------ > prop_singletonRangeConverse v =--- >    rangeSingletonValue (singletonRange v) == Just v-prop_singletonRangeConverse:: (DiscreteOrdered a) => a -> Bool-prop_singletonRangeConverse v =-   rangeSingletonValue (singletonRange v) == Just v---- | The empty range is not a singleton.------ > prop_emptyNonSingleton = rangeSingletonValue emptyRange == Nothing-prop_emptyNonSingleton :: Bool-prop_emptyNonSingleton =-    rangeSingletonValue (emptyRange :: Range Int) == Nothing---- | The full range is not a singleton.------ > prop_fullNonSingleton = rangeSingletonValue fullRange == Nothing-prop_fullNonSingleton :: Bool-prop_fullNonSingleton =-    rangeSingletonValue (fullRange :: Range Int) == Nothing---- | For real x and y, @x < y@ implies that any range between them is a--- non-singleton.-prop_nonSingleton :: Double -> Double -> Property-prop_nonSingleton x y = (x < y) ==> null $ mapMaybe rangeSingletonValue rs-   where rs = [-          Range (BoundaryBelow x) (BoundaryBelow y),-          Range (BoundaryAbove x) (BoundaryBelow y),-          Range (BoundaryBelow x) (BoundaryAbove y),-          Range (BoundaryAbove x) (BoundaryAbove y)]----- | For all integers x and y, any range formed from boundaries on either side--- of x and y is a singleton iff it contains exactly one integer.-prop_intSingleton :: Integer -> Integer -> Property-prop_intSingleton x y = forAll (rangeAround x y) $ \r ->-                        case filter (rangeHas r) [x-1 .. y+1] of-                          [v]  -> rangeSingletonValue r == Just v-                          _    -> rangeSingletonValue r == Nothing-    where-      rangeAround v1 v2 = return Range `ap` genBound v1 `ap` genBound v2-      genBound v = elements [BoundaryAbove v, BoundaryBelow v]---
tests/Makefile view
@@ -1,4 +1,6 @@-ALEX=../dist/build/alex/alex+# NOTE: `cabal` will take care to build the local `alex` executable and place it into $PATH for us to pick up+ALEX:=$(shell which alex)+# 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 -fno-warn-missing-signatures -fno-warn-unused-imports -fno-warn-tabs -Werror @@ -36,7 +38,9 @@         tokens_strict_bytestring.x \         unicode.x -TEST_ALEX_OPTS = --template=..+# NOTE: `cabal` will set the `alex_datadir` env-var accordingly before invoking the test-suite+#TEST_ALEX_OPTS = --template=../data/+TEST_ALEX_OPTS=  %.n.hs : %.x 	$(ALEX) $(TEST_ALEX_OPTS) $< -o $@@@ -62,6 +66,7 @@ clean: 	rm -f $(CLEAN_FILES) +# NOTE: The `../dist` path belows don't aren't accurate anymore for recent cabals 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'