Move GenUtils out of happy-grammar

- Move mapDollarDollar to Grammar: the $$ feature is on grammar level
- Move mkClosure into tabular as it is only used there

happy.cabal

@@ -169,6 +169,7 @@ executable happy
   other-modules:
         Paths_happy
         AbsSyn
+        GenUtils
         Lexer
         Mangler
         ParseMonad

packages/grammar/happy-grammar.cabal

@@ -35,8 +35,7 @@ tested-with:
 library
   hs-source-dirs:      src
 
-  exposed-modules:     Happy.Grammar.Grammar,
-                       Happy.Grammar.GenUtils
+  exposed-modules:     Happy.Grammar.Grammar
   build-depends:       base < 5,
                        array
 

packages/grammar/src/Happy/Grammar/Grammar.lhs

@@ -12,10 +12,13 @@ The Grammar data type.
 >       Assoc(..),
 >
 >       errorName, errorTok, startName, dummyName, firstStartTok, dummyTok,
->       eofName, epsilonTok
+>       eofName, epsilonTok,
+>
+>       mapDollarDollar
 >       ) where
 
 > import Data.Array
+> import Data.Char (isAlphaNum)
 
 > type Name = Int
 
@@ -125,4 +128,25 @@ In hindsight, this was probably a bad idea.
 > firstStartTok   = 3
 > dummyTok        = 2
 > errorTok        = 1
-> epsilonTok      = 0
+> epsilonTok      = 0
+
+-----------------------------------------------------------------------------
+
+Replace $$ with an arbitrary string, being careful to avoid ".." and '.'.
+
+> mapDollarDollar :: String -> Maybe (String -> String)
+> mapDollarDollar code0 = go code0 ""
+>   where go code acc =
+>           case code of
+>               [] -> Nothing
+>
+>               '"'  :r    -> case reads code :: [(String,String)] of
+>                                []       -> go r ('"':acc)
+>                                (s,r'):_ -> go r' (reverse (show s) ++ acc)
+>               a:'\'' :r | isAlphaNum a -> go r ('\'':a:acc)
+>               '\'' :r    -> case reads code :: [(Char,String)] of
+>                                []       -> go r ('\'':acc)
+>                                (c,r'):_ -> go r' (reverse (show c) ++ acc)
+>               '\\':'$':r -> go r ('$':acc)
+>               '$':'$':r  -> Just (\repl -> reverse acc ++ repl ++ r)
+>               c:r  -> go r (c:acc)

packages/tabular/src/Happy/Tabular.hs

@@ -5,7 +5,6 @@ module Happy.Tabular(
   ) where
 
 import Happy.Grammar.Grammar
-import Happy.Grammar.GenUtils
 import Happy.Tabular.NameSet (NameSet)
 import Happy.Tabular.Tables
 import Happy.Tabular.First
@@ -16,6 +15,7 @@ import Happy.Tabular.Info
 import Data.Set (Set)
 import Data.Array (Array)
 import System.IO
+import System.Exit
 import Control.Monad
 
 -------- Pure tabular functions, may be called without creating TabularArgs --------
@@ -76,6 +76,9 @@ runTabular args g =
         writeInfoFile sets g action goto conflictArray (inFile args) (infoFile args) unused_rules unused_terminals
         reportConflicts g sr rr
         return (action, goto, items2, unused_rules)
+    where
+      optPrint b io = when b (putStr "\n---------------------\n" >> io)
+
 
 -------- Helpers --------
 
@@ -103,6 +106,9 @@ reportConflicts g sr rr = case expect g of
         if rr /= 0
           then hPutStrLn stderr ("reduce/reduce conflicts: " ++ show rr)
           else return ()
+#if !MIN_VERSION_base(4,8,0)
+    where die s = hPutStr stderr s >> exitWith (ExitFailure 1) 
+#endif
 
 type ItemSetWithGotos = (Set Lr0Item, [(Name,Int)])
 writeInfoFile :: [ItemSetWithGotos] -> Grammar -> ActionTable -> GotoTable -> Array Int (Int,Int) -> String -> Maybe String -> [Int] -> [String] -> IO ()

packages/tabular/src/Happy/Tabular/First.lhs

@@ -4,11 +4,10 @@ Implementation of FIRST
 (c) 1993-2001 Andy Gill, Simon Marlow
 -----------------------------------------------------------------------------
 
-> module Happy.Tabular.First ( mkFirst ) where
+> module Happy.Tabular.First ( mkFirst, mkClosure ) where
 
 > import Happy.Tabular.NameSet ( NameSet )
 > import qualified Happy.Tabular.NameSet as Set
-> import Happy.Grammar.GenUtils
 > import Happy.Grammar.Grammar
 > import Data.IntSet (IntSet)
 
@@ -21,6 +20,17 @@ Implementation of FIRST
 >           | Set.member epsilonTok h = Set.delete epsilonTok h `Set.union` b
 >           | otherwise = h
 
+@mkClosure@ makes a closure, when given a comparison and iteration loop.
+Be careful, because if the functional always makes the object different,
+This will never terminate.
+
+> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
+> mkClosure eq f = match . iterate f
+>   where
+>       match (a:b:_) | a `eq` b = a
+>       match (_:c)              = match c
+>       match [] = error "Can't happen: match []"
+
 \subsection{Implementation of FIRST}
 
 > mkFirst :: Grammar -> [Name] -> NameSet

packages/tabular/src/Happy/Tabular/Info.lhs

@@ -7,7 +7,6 @@ Generating info files.
 > module Happy.Tabular.Info (genInfoFile) where
 
 > import Happy.Grammar.Grammar
-> import Happy.Grammar.GenUtils    ( str, interleave, interleave' )
 > import Happy.Tabular.Tables
 > import Happy.Tabular.LALR   ( Lr0Item(..) )
 > import Paths_happy_tabular  ( version )
@@ -224,3 +223,10 @@ Produce a file of parser information, useful for debugging the parser.
 >       = str "-----------------------------------------------------------------------------\n"
 >       . str s
 >       . str "\n-----------------------------------------------------------------------------\n"
+
+> str :: String -> String -> String
+> str = showString
+> interleave :: String -> [String -> String] -> String -> String
+> interleave s = foldr (\a b -> a . str s . b) id
+> interleave' :: String -> [String -> String] -> String -> String
+> interleave' s = foldr1 (\a b -> a . str s . b)

packages/tabular/src/Happy/Tabular/LALR.lhs

@@ -11,9 +11,9 @@ Generation of LALR parsing tables.
 >        Lr0Item(..), Lr1Item(..))
 >       where
 
+> import Happy.Tabular.First ( mkClosure )
 > import Happy.Tabular.NameSet ( NameSet )
 > import qualified Happy.Tabular.NameSet as NameSet
-> import Happy.Grammar.GenUtils
 > import Happy.Grammar.Grammar
 > import Happy.Tabular.Tables
 > import qualified Data.Set as Set hiding ( Set )

packages/grammar/src/Happy/Grammar/GenUtils.lhs → src/GenUtils.lhs

@@ -4,10 +4,8 @@ This is realy just an extended prelude.
 All the code below is understood to be in the public domain.
 -----------------------------------------------------------------------------
 
-> module Happy.Grammar.GenUtils (
->       mkClosure,
+> module GenUtils (
 >       combinePairs,
->       mapDollarDollar,
 >       str, char, nl, brack, brack',
 >       interleave, interleave',
 >       strspace, maybestr,
@@ -16,28 +14,13 @@ All the code below is understood to be in the public domain.
 >       getProgramName
 >        ) where
 
-> import Data.Char  (isAlphaNum)
 > import Data.Ord   (comparing)
 > import Data.List  (sortBy, isSuffixOf)
 > import Control.Monad
 > import System.IO  (stderr, hPutStr)
 > import System.Environment
 > import System.Exit (exitWith, ExitCode(..))
 
-%------------------------------------------------------------------------------
-
-@mkClosure@ makes a closure, when given a comparison and iteration loop.
-Be careful, because if the functional always makes the object different,
-This will never terminate.
-
-> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
-> mkClosure eq f = match . iterate f
->   where
->       match (a:b:_) | a `eq` b = a
->       match (_:c)              = match c
->       match [] = error "Can't happen: match []"
-
-
 Gofer-like stuff:
 
 > combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
@@ -49,27 +32,6 @@ Gofer-like stuff:
 >       combine (a:r) = a : combine r
 >
 
-
-Replace $$ with an arbitrary string, being careful to avoid ".." and '.'.
-
-> mapDollarDollar :: String -> Maybe (String -> String)
-> mapDollarDollar code0 = go code0 ""
->   where go code acc =
->           case code of
->               [] -> Nothing
->
->               '"'  :r    -> case reads code :: [(String,String)] of
->                                []       -> go r ('"':acc)
->                                (s,r'):_ -> go r' (reverse (show s) ++ acc)
->               a:'\'' :r | isAlphaNum a -> go r ('\'':a:acc)
->               '\'' :r    -> case reads code :: [(Char,String)] of
->                                []       -> go r ('\'':acc)
->                                (c,r'):_ -> go r' (reverse (show c) ++ acc)
->               '\\':'$':r -> go r ('$':acc)
->               '$':'$':r  -> Just (\repl -> reverse acc ++ repl ++ r)
->               c:r  -> go r (c:acc)
-
-
 %-------------------------------------------------------------------------------
 Fast string-building functions.
 

src/Main.lhs

@@ -12,7 +12,7 @@ Path settings auto-generated by Cabal:
 > import Paths_happy
 
 > import ParseMonad.Class
-> import Happy.Grammar.GenUtils
+> import GenUtils
 > import Happy.Grammar.Grammar
 > import PrettyGrammar
 > import Parser

src/Mangler.lhs

@@ -9,7 +9,7 @@ Mangler converts AbsSyn to Grammar
 > module Mangler (mangler) where
 
 > import Happy.Grammar.Grammar
-> import Happy.Grammar.GenUtils
+> import GenUtils
 > import AbsSyn
 #ifdef HAPPY_BOOTSTRAP
 > import ParseMonad.Class

src/ProduceCode.lhs

@@ -10,7 +10,7 @@ The code generator.
 > import Data.Version           ( showVersion )
 > import Happy.Grammar.Grammar
 > import Target                 ( Target(..) )
-> import Happy.Grammar.GenUtils               ( mapDollarDollar, str, char, nl, strspace,
+> import GenUtils               ( str, char, nl, strspace,
 >                                 interleave, interleave', maybestr,
 >                                 brack, brack' )
 > import Happy.Tabular.Tables

src/ProduceGLRCode.lhs

@@ -15,8 +15,7 @@ This module is designed as an extension to the Haskell parser generator Happy.
 >                       ) where
 
 > import Paths_happy ( version )
-> import Happy.Grammar.GenUtils ( mapDollarDollar )
-> import Happy.Grammar.GenUtils ( str, char, nl, brack, brack', interleave, maybestr )
+> import GenUtils ( str, char, nl, brack, brack', interleave, maybestr )
 > import Happy.Grammar.Grammar
 > import Data.Array ( Array, (!), array, assocs )
 > import Data.Char ( isSpace, isAlphaNum )