[Pkg-haskell-commits] darcs: bnfc: Adopt for the DHG
Joachim Breitner
mail at joachim-breitner.de
Sat May 11 12:01:38 UTC 2013
Sat May 11 12:00:54 UTC 2013 Joachim Breitner <mail at joachim-breitner.de>
* Adopt for the DHG
Ignore-this: 9a347f1d2559f005be3045543e25f3be
A ./bnfc.hakell-binaries
M ./changelog +7
M ./control -5 +16
R ./patches/
R ./patches/dont-generate-unqualified.patch
R ./patches/generate-alex3.patch
R ./patches/remove-haskell98.patch
R ./patches/series
R ./patches/use-alex-3.patch
M ./rules -18 +2
A ./watch
Sat May 11 12:00:54 UTC 2013 Joachim Breitner <mail at joachim-breitner.de>
* Adopt for the DHG
Ignore-this: 9a347f1d2559f005be3045543e25f3be
diff -rN -u old-bnfc//bnfc.hakell-binaries new-bnfc//bnfc.hakell-binaries
--- old-bnfc//bnfc.hakell-binaries 1970-01-01 00:00:00.000000000 +0000
+++ new-bnfc//bnfc.hakell-binaries 2013-05-11 12:01:38.295034108 +0000
@@ -0,0 +1 @@
+bnfc
diff -rN -u old-bnfc//changelog new-bnfc//changelog
--- old-bnfc//changelog 2013-05-11 12:01:38.286530434 +0000
+++ new-bnfc//changelog 2013-05-11 12:01:38.295034108 +0000
@@ -1,3 +1,10 @@
+bnfc (2.6.0.3-1) UNRELEASED; urgency=low
+
+ * New upstream release
+ * Adopt packge by the Debian Haskell Group
+
+ -- Joachim Breitner <nomeata at debian.org> Sat, 11 May 2013 13:52:57 +0200
+
bnfc (2.4.2.0-2) unstable; urgency=low
* debian/rules: Compile Setup.lhs at configure time, as some architectures
diff -rN -u old-bnfc//control new-bnfc//control
--- old-bnfc//control 2013-05-11 12:01:38.238024006 +0000
+++ new-bnfc//control 2013-05-11 12:01:38.299021714 +0000
@@ -1,11 +1,22 @@
Source: bnfc
-Priority: optional
-Section: devel
-Maintainer: Antti-Juhani Kaijanaho <ajk at debian.org>
-Build-Depends: debhelper (>= 9), ghc (>= 7.0.1) | ghc6 (>= 6.10.1+dfsg1), alex (>= 3.0.1), libghc-mtl-dev | libghc6-mtl-dev
-Standards-Version: 3.9.3
+Section: haskell
+Priority: extra
+Maintainer: Debian Haskell Group <pkg-haskell-maintainers at lists.alioth.debian.org>
+Uploaders: Joachim Breitner
+Build-Depends: debhelper (>= 7)
+ , cdbs
+ , haskell-devscripts (>= 0.8.13)
+ , ghc
+ , ghc-prof
+ , libghc-mtl-dev
+ , libghc-process-dev
+Standards-Version: 3.9.2
+Homepage: http://hackage.haskell.org/package/bnfc
+Vcs-Darcs: http://darcs.debian.org/pkg-haskell/bnfc
+Vcs-Browser: http://darcs.debian.org/cgi-bin/darcsweb.cgi?r=pkg-haskell/bnfc
Package: bnfc
+Section: devel
Architecture: any
Depends: ${shlibs:Depends}, ${misc:Depends}
Description: Compiler front-end generator based on Labelled BNF
diff -rN -u old-bnfc//patches/dont-generate-unqualified.patch new-bnfc//patches/dont-generate-unqualified.patch
--- old-bnfc//patches/dont-generate-unqualified.patch 2013-05-11 12:01:38.295034108 +0000
+++ new-bnfc//patches/dont-generate-unqualified.patch 1970-01-01 00:00:00.000000000 +0000
@@ -1,49 +0,0 @@
-Description: Changes Haskell generation to not use unqualified modules
- Recent base releases are incompatible with haskell98, which provides several
- unqualified modules. Here we change Haskell generation to generate
- qualified modules, so that haskell98 is not required to compile the
- generated code.
-Author: Antti-Juhani Kaijanaho <ajk at debian.org>
-Forwarded: by email to Markus Forsberg <markus.forsberg at gu.se> and Aarne Ranta <aarne at chalmers.se>
-Last-Update: 2012-04-01
----
-This patch header follows DEP-3: http://dep.debian.net/deps/dep3/
---- a/formats/haskell-gadt/HaskellTopGADT.hs
-+++ b/formats/haskell-gadt/HaskellTopGADT.hs
-@@ -231,8 +231,8 @@
- ["-- automatically generated by BNF Converter",
- "module Main where\n",
- "",
-- "import IO ( stdin, hGetContents )",
-- "import System ( getArgs, getProgName )",
-+ "import System.IO ( stdin, hGetContents )",
-+ "import System.Environment ( getArgs, getProgName )",
- "",
- "import " ++ alexFileM opts,
- "import " ++ happyFileM opts,
---- a/formats/haskell2/HaskellTop.hs
-+++ b/formats/haskell2/HaskellTop.hs
-@@ -241,8 +241,8 @@
- ["-- automatically generated by BNF Converter",
- "module Main where\n",
- "",
-- "import IO ( stdin, hGetContents )",
-- "import System ( getArgs, getProgName )",
-+ "import System.IO ( stdin, hGetContents )",
-+ "import System.Environment ( getArgs, getProgName )",
- "",
- "import " ++ alexFileM opts,
- "import " ++ happyFileM opts,
---- a/formats/profile/ProfileTop.hs
-+++ b/formats/profile/ProfileTop.hs
-@@ -184,8 +184,8 @@
- "",
- "import Trees",
- "import Profile",
-- "import IO ( stdin, hGetContents )",
-- "import System ( getArgs, getProgName )",
-+ "import System.IO ( stdin, hGetContents )",
-+ "import System.Environment ( getArgs, getProgName )",
- "",
- "import " ++ alexFileM inDir name,
- "import " ++ happyFileM inDir name,
diff -rN -u old-bnfc//patches/generate-alex3.patch new-bnfc//patches/generate-alex3.patch
--- old-bnfc//patches/generate-alex3.patch 2013-05-11 12:01:38.291055542 +0000
+++ new-bnfc//patches/generate-alex3.patch 1970-01-01 00:00:00.000000000 +0000
@@ -1,580 +0,0 @@
-Description: Makes possible to generate Alex 3 code
- Alex 3 changes the interface again; thus the generated code needs
- to be specially adapted for Alex 3. This patch adds a new option
- -alex3 which directs code generation for Alex 3; it is made
- the default.
-Author: Antti-Juhani Kaijanaho <ajk at debian.org>
-Forwarded: by email to Markus Forsberg <markus.forsberg at gu.se> and Aarne Ranta <aarne at chalmers.se>
-Last-Update: 2012-04-01
----
-This patch header follows DEP-3: http://dep.debian.net/deps/dep3/
---- /dev/null
-+++ b/formats/haskell2/CFtoAlex3.hs
-@@ -0,0 +1,355 @@
-+{-
-+ BNF Converter: Alex 3.0 Generator
-+ Copyright (C) 2012 Author: Antti-Juhani Kaijanaho
-+ Copyright (C) 2004 Author: Peter Gammie
-+ (C)opyright 2003, {aarne,markus,peteg} at cs dot chalmers dot se
-+
-+ This program is free software; you can redistribute it and/or modify
-+ it under the terms of the GNU General Public License as published by
-+ the Free Software Foundation; either version 2 of the License, or
-+ (at your option) any later version.
-+
-+ This program is distributed in the hope that it will be useful,
-+ but WITHOUT ANY WARRANTY; without even the implied warranty of
-+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-+ GNU General Public License for more details.
-+
-+ You should have received a copy of the GNU General Public License
-+ along with this program; if not, write to the Free Software
-+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-+-}
-+
-+module CFtoAlex3 (cf2alex3) where
-+
-+import CF
-+import Data.List
-+
-+-- For RegToAlex, see below.
-+import AbsBNF
-+import Data.Char
-+
-+cf2alex3 :: String -> String -> String -> Bool -> Bool -> CF -> String
-+cf2alex3 name errMod shareMod shareStrings byteStrings cf =
-+ unlines $ concat $ intersperse [""] [
-+ prelude name errMod shareMod shareStrings byteStrings,
-+ cMacros,
-+ rMacros cf,
-+ restOfAlex shareMod shareStrings byteStrings cf
-+ ]
-+
-+prelude :: String -> String -> String -> Bool -> Bool -> [String]
-+prelude name errMod shareMod shareStrings byteStrings = [
-+ "-- -*- haskell -*-",
-+ "-- This Alex file was machine-generated by the BNF converter",
-+ "{",
-+ "{-# OPTIONS -fno-warn-incomplete-patterns #-}",
-+ "module " ++ name ++ " where",
-+ "",
-+ -- "import " ++ errMod,
-+ if shareStrings then "import " ++ shareMod else "",
-+ if byteStrings then "import qualified Data.ByteString.Char8 as BS" else "",
-+ "import qualified Data.Bits",
-+ "import Data.Word (Word8)",
-+ "}",
-+ ""
-+ ]
-+
-+cMacros :: [String]
-+cMacros = [
-+ "$l = [a-zA-Z\\192 - \\255] # [\\215 \\247] -- isolatin1 letter FIXME",
-+ "$c = [A-Z\\192-\\221] # [\\215] -- capital isolatin1 letter FIXME",
-+ "$s = [a-z\\222-\\255] # [\\247] -- small isolatin1 letter FIXME",
-+ "$d = [0-9] -- digit",
-+ "$i = [$l $d _ '] -- identifier character",
-+ "$u = [\\0-\\255] -- universal: any character"
-+ ]
-+
-+rMacros :: CF -> [String]
-+rMacros cf =
-+ let symbs = symbols cf
-+ in
-+ (if null symbs then [] else [
-+ "@rsyms = -- symbols and non-identifier-like reserved words",
-+ " " ++ unwords (intersperse "|" (map mkEsc symbs))
-+ ])
-+ where
-+ mkEsc = unwords . esc
-+ esc s = if null a then rest else show a : rest
-+ where (a,r) = span isAlphaNum s
-+ rest = case r of
-+ [] -> []
-+ (c:xs) -> s : esc xs
-+ where s = if isPrint c then ['\\',c]
-+ else '\\':show (ord c)
-+
-+restOfAlex :: String -> Bool -> Bool -> CF -> [String]
-+restOfAlex shareMod shareStrings byteStrings cf = [
-+ ":-",
-+ lexComments (comments cf),
-+ "$white+ ;",
-+ pTSpec (symbols cf),
-+
-+ userDefTokenTypes,
-+ ident,
-+
-+ ifC "String" ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t)))* \\\"" ++
-+ "{ tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"),
-+ ifC "Char" "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t]) \\' { tok (\\p s -> PT p (TC $ share s)) }",
-+ ifC "Integer" "$d+ { tok (\\p s -> PT p (TI $ share s)) }",
-+ ifC "Double" "$d+ \\. $d+ (e (\\-)? $d+)? { tok (\\p s -> PT p (TD $ share s)) }",
-+ "",
-+ "{",
-+ "",
-+ "tok f p s = f p s",
-+ "",
-+ "share :: "++stringType++" -> "++stringType,
-+ "share = " ++ if shareStrings then "shareString" else "id",
-+ "",
-+ "data Tok =",
-+ " TS !"++stringType++" !Int -- reserved words and symbols",
-+ " | TL !"++stringType++" -- string literals",
-+ " | TI !"++stringType++" -- integer literals",
-+ " | TV !"++stringType++" -- identifiers",
-+ " | TD !"++stringType++" -- double precision float literals",
-+ " | TC !"++stringType++" -- character literals",
-+ userDefTokenConstrs,
-+ " deriving (Eq,Show,Ord)",
-+ "",
-+ "data Token = ",
-+ " PT Posn Tok",
-+ " | Err Posn",
-+ " deriving (Eq,Show,Ord)",
-+ "",
-+ "tokenPos (PT (Pn _ l _) _ :_) = \"line \" ++ show l",
-+ "tokenPos (Err (Pn _ l _) :_) = \"line \" ++ show l",
-+ "tokenPos _ = \"end of file\"",
-+ "",
-+ "posLineCol (Pn _ l c) = (l,c)",
-+ "mkPosToken t@(PT p _) = (posLineCol p, prToken t)",
-+ "",
-+ "prToken t = case t of",
-+ " PT _ (TS s _) -> s",
-+ " PT _ (TL s) -> s",
-+ " PT _ (TI s) -> s",
-+ " PT _ (TV s) -> s",
-+ " PT _ (TD s) -> s",
-+ " PT _ (TC s) -> s",
-+ userDefTokenPrint,
-+ "",
-+ "data BTree = N | B "++stringType++" Tok BTree BTree deriving (Show)",
-+ "",
-+ "eitherResIdent :: ("++stringType++" -> Tok) -> "++stringType++" -> Tok",
-+ "eitherResIdent tv s = treeFind resWords",
-+ " where",
-+ " treeFind N = tv s",
-+ " treeFind (B a t left right) | s < a = treeFind left",
-+ " | s > a = treeFind right",
-+ " | s == a = t",
-+ "",
-+ "resWords = " ++ (show $ sorted2tree $ zip (sort resws) [1..]),
-+ " where b s n = let bs = "++stringPack++" s",
-+ " in B bs (TS bs n)",
-+ "",
-+ "unescapeInitTail :: "++stringType++" -> "++stringType++"",
-+ "unescapeInitTail = "++stringPack++" . unesc . tail . "++stringUnpack++" where",
-+ " unesc s = case s of",
-+ " '\\\\':c:cs | elem c ['\\\"', '\\\\', '\\\''] -> c : unesc cs",
-+ " '\\\\':'n':cs -> '\\n' : unesc cs",
-+ " '\\\\':'t':cs -> '\\t' : unesc cs",
-+ " '\"':[] -> []",
-+ " c:cs -> c : unesc cs",
-+ " _ -> []",
-+ "",
-+ "-------------------------------------------------------------------",
-+ "-- Alex wrapper code.",
-+ "-- A modified \"posn\" wrapper.",
-+ "-------------------------------------------------------------------",
-+ "",
-+ "data Posn = Pn !Int !Int !Int",
-+ " deriving (Eq, Show,Ord)",
-+ "",
-+ "alexStartPos :: Posn",
-+ "alexStartPos = Pn 0 1 1",
-+ "",
-+ "alexMove :: Posn -> Char -> Posn",
-+ "alexMove (Pn a l c) '\\t' = Pn (a+1) l (((c+7) `div` 8)*8+1)",
-+ "alexMove (Pn a l c) '\\n' = Pn (a+1) (l+1) 1",
-+ "alexMove (Pn a l c) _ = Pn (a+1) l (c+1)",
-+ "",
-+ "type Byte = Word8",
-+ "",
-+ "type AlexInput = (Posn, -- current position,",
-+ " Char, -- previous char",
-+ " [Byte], -- pending bytes on the current char",
-+ " "++stringType++") -- current input string",
-+ "",
-+ "tokens :: "++stringType++" -> [Token]",
-+ "tokens str = go (alexStartPos, '\\n', [], str)",
-+ " where",
-+ " go :: AlexInput -> [Token]",
-+ " go inp@(pos, _, _, str) =",
-+ " case alexScan inp 0 of",
-+ " AlexEOF -> []",
-+ " AlexError (pos, _, _, _) -> [Err pos]",
-+ " AlexSkip inp' len -> go inp'",
-+ " AlexToken inp' len act -> act pos ("++stringTake++" len str) : (go inp')",
-+ "",
-+ "alexGetByte :: AlexInput -> Maybe (Byte,AlexInput)",
-+ "alexGetByte (p, c, (b:bs), s) = Just (b, (p, c, bs, s))",
-+ "alexGetByte (p, _, [], s) =",
-+ " case "++stringUncons++" s of",
-+ " "++stringNilP++" -> Nothing",
-+ " "++stringConsP++" ->",
-+ " let p' = alexMove p c",
-+ " (b:bs) = utf8Encode c",
-+ " in p' `seq` Just (b, (p', c, bs, s))",
-+ "",
-+ "alexInputPrevChar :: AlexInput -> Char",
-+ "alexInputPrevChar (p, c, bs, s) = c",
-+ "",
-+ " -- | 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",
-+ " ]",
-+ "}"
-+ ]
-+ where
-+ (stringType,stringTake,stringUncons,stringPack,stringUnpack,stringNilP,stringConsP)
-+ | byteStrings = ("BS.ByteString", "BS.take", "BS.uncons", "BS.pack", "BS.unpack", "Nothing", "Just (c,s)")
-+ | otherwise = ("String", "take", "", "id", "id", "[]", "(c:s)" )
-+
-+ ifC cat s = if isUsedCat cf cat then s else ""
-+ lexComments ([],[]) = []
-+ lexComments (xs,s1:ys) = '\"' : s1 ++ "\"" ++ " [.]* ; -- Toss single line comments\n" ++ lexComments (xs, ys)
-+ lexComments (([l1,l2],[r1,r2]):xs,[]) = concat $
-+ [
-+ ('\"':l1:l2:"\" ([$u # \\"), -- FIXME quotes or escape?
-+ (l2:"] | \\"),
-+ (r1:" [$u # \\"),
-+ (r2:"])* (\""),
-+ (r1:"\")+ \""),
-+ (r2:"\" ; \n"),
-+ lexComments (xs, [])
-+ ]
-+ lexComments ((_:xs),[]) = lexComments (xs,[])
-+--- lexComments (xs,(_:ys)) = lexComments (xs,ys)
-+
-+ -- tokens consisting of special symbols
-+ pTSpec [] = ""
-+ pTSpec _ = "@rsyms { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }"
-+
-+ userDefTokenTypes = unlines $
-+ [printRegAlex exp ++
-+ " { tok (\\p s -> PT p (eitherResIdent (T_" ++ name ++ " . share) s)) }"
-+ | (name,exp) <- tokenPragmas cf]
-+ userDefTokenConstrs = unlines $
-+ [" | T_" ++ name ++ " !"++stringType | (name,_) <- tokenPragmas cf]
-+ userDefTokenPrint = unlines $
-+ [" PT _ (T_" ++ name ++ " s) -> s" | (name,_) <- tokenPragmas cf]
-+
-+ ident =
-+ "$l $i* { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }"
-+ --ifC "Ident" "<ident> ::= ^l ^i* { ident p = PT p . eitherResIdent TV }"
-+
-+ resws = reservedWords cf ++ symbols cf
-+
-+
-+data BTree = N | B String Int BTree BTree
-+
-+instance Show BTree where
-+ showsPrec _ N = showString "N"
-+ showsPrec n (B s k l r) = wrap (showString "b " . shows s . showChar ' '. shows k . showChar ' '
-+ . showsPrec 1 l . showChar ' '
-+ . showsPrec 1 r)
-+ where wrap f = if n > 0 then showChar '(' . f . showChar ')' else f
-+
-+sorted2tree :: [(String,Int)] -> BTree
-+sorted2tree [] = N
-+sorted2tree xs = B x n (sorted2tree t1) (sorted2tree t2) where
-+ (t1,((x,n):t2)) = splitAt (length xs `div` 2) xs
-+
-+
-+-------------------------------------------------------------------
-+-- Inlined version of @RegToAlex at .
-+-- Syntax has changed...
-+-------------------------------------------------------------------
-+
-+-- modified from pretty-printer generated by the BNF converter
-+
-+-- the top-level printing method
-+printRegAlex :: Reg -> String
-+printRegAlex = render . prt 0
-+
-+-- you may want to change render and parenth
-+
-+render :: [String] -> String
-+render = rend 0
-+ where rend :: Int -> [String] -> String
-+ rend i ss = case ss of
-+ "[" :ts -> cons "[" $ rend i ts
-+ "(" :ts -> cons "(" $ rend i ts
-+ t : "," :ts -> cons t $ space "," $ rend i ts
-+ t : ")" :ts -> cons t $ cons ")" $ rend i ts
-+ t : "]" :ts -> cons t $ cons "]" $ rend i ts
-+ t :ts -> space t $ rend i ts
-+ _ -> ""
-+
-+ cons s t = s ++ t
-+ new i s = s
-+ space t s = if null s then t else t ++ " " ++ s
-+
-+parenth :: [String] -> [String]
-+parenth ss = ["("] ++ ss ++ [")"]
-+
-+-- the printer class does the job
-+class Print a where
-+ prt :: Int -> a -> [String]
-+ prtList :: [a] -> [String]
-+ prtList = concat . map (prt 0)
-+
-+instance Print a => Print [a] where
-+ prt _ = prtList
-+
-+instance Print Char where
-+ prt _ c = if isAlphaNum c then [[c]] else ['\\':[c]]
-+ prtList s = map (concat . prt 0) s
-+
-+prPrec :: Int -> Int -> [String] -> [String]
-+prPrec i j = if j<i then parenth else id
-+
-+instance Print Ident where
-+ prt _ (Ident i) = [i]
-+
-+instance Print Reg where
-+ prt i e = case e of
-+ RSeq reg0 reg -> prPrec i 2 (concat [prt 2 reg0 , prt 3 reg])
-+ RAlt reg0 reg -> prPrec i 1 (concat [prt 1 reg0 , ["|"] , prt 2 reg])
-+ RMinus reg0 reg -> prPrec i 1 (concat [prt 2 reg0 , ["#"] , prt 2 reg])
-+ RStar reg -> prPrec i 3 (concat [prt 3 reg , ["*"]])
-+ RPlus reg -> prPrec i 3 (concat [prt 3 reg , ["+"]])
-+ ROpt reg -> prPrec i 3 (concat [prt 3 reg , ["?"]])
-+ REps -> prPrec i 3 (["$"])
-+ RChar c -> prPrec i 3 (concat [prt 0 c])
-+ RAlts str -> prPrec i 3 (concat [["["],prt 0 str,["]"]])
-+ RSeqs str -> prPrec i 2 (concat (map (prt 0) str))
-+ RDigit -> prPrec i 3 (concat [["$d"]])
-+ RLetter -> prPrec i 3 (concat [["$l"]])
-+ RUpper -> prPrec i 3 (concat [["$c"]])
-+ RLower -> prPrec i 3 (concat [["$s"]])
-+ RAny -> prPrec i 3 (concat [["$u"]])
---- a/formats/haskell2/HaskellTop.hs
-+++ b/formats/haskell2/HaskellTop.hs
-@@ -17,7 +17,7 @@
- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
- -}
-
--module HaskellTop (makeAll) where
-+module HaskellTop (makeAll,AlexMode(..)) where
-
-
-
-@@ -26,6 +26,7 @@
- import CFtoHappy
- import CFtoAlex
- import CFtoAlex2
-+import CFtoAlex3
- import CFtoLatex
- import CFtoTxt
- import CFtoAbstract
-@@ -106,10 +107,12 @@
- xmlFileM = mkMod withLang "XML"
- layoutFile = mkFile withLang "Layout" "hs"
-
-+data AlexMode = Alex1 | Alex2 | Alex3 deriving Eq
-+
- data Options = Options
- {
- make :: Bool,
-- alex1 :: Bool,
-+ alexMode :: AlexMode,
- inDir :: Bool,
- shareStrings :: Bool,
- byteStrings :: Bool,
-@@ -120,12 +123,12 @@
- multi :: Bool
- }
-
--makeAll :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Int
-+makeAll :: Bool -> AlexMode -> Bool -> Bool -> Bool -> Bool -> Int
- -> Maybe String -- [...incomplete...]
More information about the Pkg-haskell-commits
mailing list