alex 2.3.1 → 2.3.2
raw patch · 21 files changed
+185/−134 lines, 21 filesdep ~base
Dependency ranges changed: base
Files
- alex.cabal +12/−3
- dist/build/alex/alex-tmp/Parser.hs +6/−4
- dist/build/alex/alex-tmp/Scan.hs +34/−29
- doc/alex.xml +1/−1
- doc/config.mk.in +1/−2
- doc/configure.ac +2/−1
- doc/docbook-xml.mk +9/−32
- src/AbsSyn.hs +7/−3
- src/CharSet.hs +1/−0
- src/DFA.hs +7/−7
- src/DFS.hs +4/−4
- src/Info.hs +6/−6
- src/Main.hs +31/−5
- src/NFA.hs +13/−13
- src/Output.hs +18/−9
- src/ParseMonad.hs +4/−3
- src/Parser.y +2/−0
- src/Scan.x +2/−0
- src/Sort.hs +8/−6
- src/Util.hs +10/−1
- templates/GenericTemplate.hs +7/−5
alex.cabal view
@@ -1,15 +1,23 @@ name: alex-version: 2.3.1+version: 2.3.2 license: BSD3 license-file: LICENSE copyright: (c) Chis Dornan, Simon Marlow author: Chris Dornan and Simon Marlow-maintainer: Simon Marlow <simonmar@microsoft.com>+maintainer: Simon Marlow <marlowsd@gmail.com>+bug-reports: mailto:marlowsd@gmail.com stability: stable homepage: http://www.haskell.org/alex/ synopsis: Alex is a tool for generating lexical analysers in Haskell category: Development cabal-version: >= 1.2++-- Later, this isn't compatible with Cabal 1.2:+-- source-repository head+-- type: darcs+-- location: http://darcs.haskell.org/alex/++ build-type: Custom extra-source-files: ANNOUNCE@@ -63,9 +71,10 @@ else build-depends: base >= 1.0 - build-depends: haskell98 >= 1.0+ build-depends: base < 5, haskell98 >= 1.0 extensions: CPP+ ghc-options: -Wall other-modules: AbsSyn CharSet
dist/build/alex/alex-tmp/Parser.hs view
@@ -7,6 +7,8 @@ -- -- ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -w #-}+ module Parser ( parse, P ) where import AbsSyn import Scan@@ -196,10 +198,10 @@ happyOut30 :: (HappyAbsSyn ) -> ((AlexPosn,String)) happyOut30 x = unsafeCoerce# x {-# INLINE happyOut30 #-}-happyInTok :: (Token) -> (HappyAbsSyn )+happyInTok :: Token -> (HappyAbsSyn ) happyInTok x = unsafeCoerce# x {-# INLINE happyInTok #-}-happyOutTok :: (HappyAbsSyn ) -> (Token)+happyOutTok :: (HappyAbsSyn ) -> Token happyOutTok x = unsafeCoerce# x {-# INLINE happyOutTok #-} @@ -845,7 +847,7 @@ happyThen1 = happyThen happyReturn1 :: () => a -> P a happyReturn1 = happyReturn-happyError' :: () => (Token) -> P a+happyError' :: () => Token -> P a happyError' tk = (\token -> happyError) tk parse = happySomeParser where@@ -874,7 +876,7 @@ {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}+{-# LINE 1 "<command-line>" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
dist/build/alex/alex-tmp/Scan.hs view
@@ -1,5 +1,8 @@ {-# OPTIONS -fglasgow-exts -cpp #-} {-# LINE 13 "src/Scan.x" #-}++{-# OPTIONS_GHC -w #-}+ module Scan(lexer, AlexPosn(..), Token(..), Tkn(..), tokPosn) where import Data.Char@@ -8,7 +11,7 @@ #if __GLASGOW_HASKELL__ >= 603 #include "ghcconfig.h"-#else+#elif defined(__GLASGOW_HASKELL__) #include "config.h" #endif #if __GLASGOW_HASKELL__ >= 503@@ -37,8 +40,9 @@ alex_deflt = AlexA# "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x06\x00\x06\x00\xff\xff\xff\xff\xff\xff\x0b\x00\x0b\x00\xff\xff\x15\x00\xff\xff\x15\x00\xff\xff\xff\xff\xff\xff\xff\xff\x15\x00\x15\x00\xff\xff\xff\xff\x19\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\x00\xff\xff\x3e\x00\x3e\x00\xff\xff\xff\xff\x44\x00\xff\xff\x44\x00\x44\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00"# alex_accept = listArray (0::Int,77) [[],[(AlexAcc (alex_action_21))],[],[],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[(AlexAcc (alex_action_0))],[],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_1))],[(AlexAcc (alex_action_10))],[],[(AlexAcc (alex_action_2))],[(AlexAcc (alex_action_2))],[],[],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[],[],[],[],[],[(AlexAccPred (alex_action_3) (alexRightContext 24)),(AlexAcc (alex_action_4))],[],[(AlexAccSkip)],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_4))],[(AlexAcc (alex_action_5))],[],[],[],[],[],[],[],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_6))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_7))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_8))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_9))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_10))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[(AlexAcc (alex_action_11))],[],[],[],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[(AlexAcc (alex_action_12))],[],[],[],[(AlexAcc (alex_action_13))],[(AlexAcc (alex_action_13))],[],[],[],[],[(AlexAcc (alex_action_14))],[(AlexAcc (alex_action_14))],[],[],[],[],[(AlexAcc (alex_action_15))],[(AlexAcc (alex_action_16))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_17))],[(AlexAcc (alex_action_18))],[(AlexAcc (alex_action_19))],[(AlexAcc (alex_action_20))],[]]-{-# LINE 73 "src/Scan.x" #-}+{-# LINE 75 "src/Scan.x" #-} + -- ----------------------------------------------------------------------------- -- Token type @@ -185,32 +189,33 @@ afterstartcodes,startcodes :: Int afterstartcodes = 1 startcodes = 2-alex_action_0 = skip -alex_action_1 = string -alex_action_2 = bind -alex_action_3 = code -alex_action_4 = special -alex_action_5 = wrapper -alex_action_6 = decch -alex_action_7 = hexch -alex_action_8 = octch -alex_action_9 = escape -alex_action_10 = char -alex_action_11 = smac -alex_action_12 = rmac -alex_action_13 = smacdef -alex_action_14 = rmacdef -alex_action_15 = special `andBegin` startcodes -alex_action_16 = zero -alex_action_17 = startcode -alex_action_18 = special -alex_action_19 = special `andBegin` afterstartcodes -alex_action_20 = special `andBegin` 0 -alex_action_21 = skip `andBegin` 0 -{-# LINE 1 "GenericTemplate.hs" #-}+alex_action_0 = skip +alex_action_1 = string +alex_action_2 = bind +alex_action_3 = code +alex_action_4 = special +alex_action_5 = wrapper +alex_action_6 = decch +alex_action_7 = hexch +alex_action_8 = octch +alex_action_9 = escape +alex_action_10 = char +alex_action_11 = smac +alex_action_12 = rmac +alex_action_13 = smacdef +alex_action_14 = rmacdef +alex_action_15 = special `andBegin` startcodes +alex_action_16 = zero +alex_action_17 = startcode +alex_action_18 = special +alex_action_19 = special `andBegin` afterstartcodes +alex_action_20 = special `andBegin` 0 +alex_action_21 = skip `andBegin` 0 +{-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "<built-in>" #-}-{-# LINE 1 "<command line>" #-}-{-# LINE 1 "GenericTemplate.hs" #-}+{-# LINE 1 "<command-line>" #-}+{-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- -- ALEX TEMPLATE --@@ -220,9 +225,9 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "GenericTemplate.hs" #-}+{-# LINE 35 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "GenericTemplate.hs" #-}+{-# LINE 45 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr#
doc/alex.xml view
@@ -981,7 +981,7 @@ <title>The Interface to an Alex-generated lexer</title> <para>This section answers the question: "How do I include an- Alex lexer in my program?</para>+ Alex lexer in my program?"</para> <para>Alex provides for a great deal of flexibility in how the lexer is exposed to the rest of the program. For instance,
doc/config.mk.in view
@@ -5,8 +5,7 @@ XMLLINT = @XmllintCmd@ FOP = @FopCmd@ XMLTEX = @XmltexCmd@-PDFXMLTEX = @PdfxmltexCmd@-DVIPS = @DvipsCmd@+DBLATEX = @DbLatexCmd@ DIR_DOCBOOK_XSL = @DIR_DOCBOOK_XSL@
doc/configure.ac view
@@ -6,7 +6,8 @@ dnl ** check for DocBook toolchain FP_CHECK_DOCBOOK_DTD FP_DIR_DOCBOOK_XSL([/usr/share/xml/docbook/stylesheet/nwalsh/current /usr/share/xml/docbook/stylesheet/nwalsh /usr/share/sgml/docbook/docbook-xsl-stylesheets* /usr/share/sgml/docbook/xsl-stylesheets* /opt/kde?/share/apps/ksgmltools2/docbook/xsl /usr/share/docbook-xsl /usr/share/sgml/docbkxsl /usr/local/share/xsl/docbook /sw/share/xml/xsl/docbook-xsl])-FP_PROG_FO_PROCESSOR++AC_PATH_PROG(DbLatexCmd,dblatex) AC_CONFIG_FILES([config.mk]) AC_OUTPUT
doc/docbook-xml.mk view
@@ -18,7 +18,6 @@ XML_HTML_NO_CHUNKS = $(addsuffix .html,$(XML_DOC)) XML_CHM = $(addsuffix .chm,$(XML_DOC)) XML_HxS = $(addsuffix .HxS,$(XML_DOC))-XML_FO = $(addsuffix .fo,$(XML_DOC)) XML_DVI = $(addsuffix .dvi,$(XML_DOC)) XML_PS = $(addsuffix .ps,$(XML_DOC)) XML_PDF = $(addsuffix .pdf,$(XML_DOC))@@ -29,17 +28,16 @@ html-no-chunks :: $(XML_HTML_NO_CHUNKS) chm :: $(XML_CHM) HxS :: $(XML_HxS)-fo :: $(XML_FO) dvi :: $(XML_DVI) ps :: $(XML_PS) pdf :: $(XML_PDF) -CLEAN_FILES += $(XML_HTML_NO_CHUNKS) $(XML_FO) $(XML_DVI) $(XML_PS) $(XML_PDF)+CLEAN_FILES += $(XML_HTML_NO_CHUNKS) $(XML_DVI) $(XML_PS) $(XML_PDF) FPTOOLS_CSS = fptools.css clean ::- $(RM) -rf $(XML_DOC).out $(basename $(XML_DOC)) $(basename $(XML_DOC))-htmlhelp+ $(RM) -rf $(XML_DOC).out $(basename $(XML_DOC)) $(basename $(XML_DOC))-htmlhelp $(XML_DOC).pdf $(XML_DOC).dvi $(XML_DOC).ps validate :: $(XMLLINT) --valid --noout $(XMLLINT_OPTS) $(XML_DOC).xml@@ -97,34 +95,13 @@ %.HxS : %-htmlhelp2/collection.HxC ( cd $(dir $<) && if Hxcomp -p collection.HxC -o ../$@ ; then false ; else true ; fi ) -%.fo : %.xml- $(XSLTPROC) --output $@ \- --stringparam draft.mode no \- $(XSLTPROC_LABEL_OPTS) $(XSLTPROC_OPTS) \- $(DIR_DOCBOOK_XSL)/fo/docbook.xsl $<--ifeq "$(FOP)" ""-ifneq "$(PDFXMLTEX)" ""-%.pdf : %.fo- $(PDFXMLTEX) $<- if grep "LaTeX Warning: Label(s) may have changed.Rerun to get cross-references right." $(basename $@).log > /dev/null ; then \- $(PDFXMLTEX) $< ; \- $(PDFXMLTEX) $< ; \- fi-endif-else-%.ps : %.fo- $(FOP) $(FOP_OPTS) -fo $< -ps $@+ifneq "$(DBLATEX)" ""+%.pdf : %.xml+ $(DBLATEX) -tpdf $< -%.pdf : %.fo- $(FOP) $(FOP_OPTS) -fo $< -pdf $@-endif+%.dvi : %.xml+ $(DBLATEX) -tdvi $< -ifneq "$(XMLTEX)" ""-%.dvi : %.fo- $(XMLTEX) $<- if grep "LaTeX Warning: Label(s) may have changed.Rerun to get cross-references right." $(basename $@).log > /dev/null ; then \- $(XMLTEX) $< ; \- $(XMLTEX) $< ; \- fi+%.ps : %.xml+ $(DBLATEX) -tps $< endif
src/AbsSyn.hs view
@@ -71,14 +71,18 @@ showsPrec _ (RECtx scs _ r rctx code) = showStarts scs . shows r . showRCtx rctx . showMaybeCode code +showMaybeCode :: Maybe String -> String -> String showMaybeCode Nothing = id showMaybeCode (Just code) = showCode code +showCode :: String -> String -> String showCode code = showString " { " . showString code . showString " }" +showStarts :: [(String, StartCode)] -> String -> String showStarts [] = id showStarts scs = shows scs +showRCtx :: RightContext RExp -> String -> String showRCtx NoRightContext = id showRCtx (RightContextRExp r) = ('\\':) . shows r showRCtx (RightContextCode code) = showString "\\ " . showCode code@@ -126,7 +130,7 @@ instance Show RExp where showsPrec _ Eps = showString "()"- showsPrec _ (Ch set) = showString "[..]"+ showsPrec _ (Ch _) = showString "[..]" showsPrec _ (l :%% r) = shows l . shows r showsPrec _ (l :| r) = shows l . ('|':) . shows r showsPrec _ (Star r) = shows r . ('*':)@@ -222,7 +226,7 @@ [] -> tl (nm,_):rst -> "\n" ++ nm ++ foldr f t rst where- f (nm, _) t = "," ++ nm ++ t+ f (nm', _) t' = "," ++ nm' ++ t' t = " :: Int\n" ++ foldr fmt_sc tl name_code_pairs where fmt_sc (nm,sc) t = nm ++ " = " ++ show sc ++ "\n" ++ t@@ -247,7 +251,7 @@ f r@RECtx{ reCtxCode = Just code } name = (r{reCtxCode = Just name}, Just (mkDecl name code))- f r@RECtx{ reCtxCode = Nothing } name+ f r@RECtx{ reCtxCode = Nothing } _ = (r{reCtxCode = Nothing}, Nothing) mkDecl fun code = str fun . str " = " . str code . nl
src/CharSet.hs view
@@ -28,6 +28,7 @@ -- Implementation as functions type CharSet = Char -> Bool +emptyCharSet :: CharSet emptyCharSet = const False charSetSingleton :: Char -> CharSet
src/DFA.hs view
@@ -104,7 +104,7 @@ -- including `rctx_ss' in the search). nfa2pdfa:: NFA -> DFA StateSet Code -> [StateSet] -> DFA StateSet Code-nfa2pdfa nfa pdfa [] = pdfa+nfa2pdfa _ pdfa [] = pdfa nfa2pdfa nfa pdfa (ss:umkd) | ss `in_pdfa` pdfa = nfa2pdfa nfa pdfa umkd | otherwise = nfa2pdfa nfa pdfa' umkd'@@ -135,7 +135,7 @@ sort_accs:: [Accept a] -> [Accept a] sort_accs accs = foldr chk [] (msort le accs) where- chk acc@(Acc _ _ Nothing NoRightContext) rst = [acc]+ chk acc@(Acc _ _ Nothing NoRightContext) _ = [acc] chk acc rst = acc:rst le (Acc{accPrio = n}) (Acc{accPrio=n'}) = n<=n'@@ -181,26 +181,26 @@ -- sets of states from the original NFA. mk_int_dfa:: NFA -> DFA StateSet a -> DFA SNum a-mk_int_dfa nfa pdfa@(DFA start_states mp)+mk_int_dfa nfa (DFA start_states mp) = DFA [0 .. length start_states-1] - (Map.fromList [ (lookup st, cnv pds) | (st, pds) <- Map.toAscList mp ])+ (Map.fromList [ (lookup' st, cnv pds) | (st, pds) <- Map.toAscList mp ]) where mp' = Map.fromList (zip (start_states ++ (map fst . Map.toAscList) (foldr Map.delete mp start_states)) [0..]) - lookup = fromJust . flip Map.lookup mp'+ lookup' = fromJust . flip Map.lookup mp' cnv :: State StateSet a -> State SNum a cnv (State accs as) = State accs' as' where- as' = Map.mapWithKey (\ch s -> lookup s) as+ as' = Map.mapWithKey (\_ch s -> lookup' s) as accs' = map cnv_acc accs cnv_acc (Acc p a lctx rctx) = Acc p a lctx rctx' where rctx' = case rctx of RightContextRExp s -> - RightContextRExp (lookup (mk_ss nfa [s]))+ RightContextRExp (lookup' (mk_ss nfa [s])) other -> other {-
src/DFS.hs view
@@ -37,9 +37,9 @@ postorder:: GForrest -> [Int] postorder ts = po ts [] where- po ts l = foldr po_tree l ts+ po ts' l = foldr po_tree l ts' - po_tree (GNode a ts) l = po ts (a:l)+ po_tree (GNode a ts') l = po ts' (a:l) list_tree:: GTree -> [Int] list_tree t = l_t t []@@ -102,7 +102,7 @@ dff g = dff' (vertices g) g dff':: [Int] -> Graph -> GForrest-dff' vs (bs,f) = prune (map (generate_g f) vs)+dff' vs (_bs, f) = prune (map (generate_g f) vs) generate_g:: (Int->[Int]) -> Int -> GTree generate_g f v = GNode v (map (generate_g f) (f v))@@ -114,7 +114,7 @@ empty_int = Set.empty chop:: (Set Int,GForrest) -> (Set Int,GForrest)-chop p@(vstd,[]) = p+chop p@(_, []) = p chop (vstd,GNode v ts:us) = if v `Set.member` vstd then chop (vstd,us)
src/Info.hs view
@@ -18,19 +18,19 @@ -- Generate a human readable dump of the state machine infoDFA :: Int -> String -> DFA SNum Code -> ShowS-infoDFA n func_nm dfa+infoDFA _ func_nm dfa = str "Scanner : " . str func_nm . nl . str "States : " . shows (length dfa_list) . nl- . nl . infoDFA dfa+ . nl . infoDFA' where dfa_list = Map.toAscList (dfa_states dfa) - infoDFA dfa = interleave_shows nl (map infoStateN dfa_list)+ infoDFA' = interleave_shows nl (map infoStateN dfa_list) infoStateN (i,s) = str "State " . shows i . nl . infoState s . nl infoState :: State SNum Code -> ShowS- infoState (State accs out)+ infoState (State _accs out) = infoArr out . nl -- . str ("\tDefault -> ") . shows df @@ -38,8 +38,8 @@ = char '\t' . interleave_shows (str "\n\t") (map infoTransition (Map.toAscList out)) - infoTransition (char,state)- = str (ljustify 8 (show char))+ infoTransition (char',state)+ = str (ljustify 8 (show char')) . str " -> " . shows state
src/Main.hs view
@@ -35,7 +35,33 @@ import System.Environment ( getProgName, getArgs ) import System.Exit ( ExitCode(..), exitWith ) import System.IO ( stderr, Handle, IOMode(..), openFile, hClose, hPutStr, hPutStrLn )+#if __GLASGOW_HASKELL__ >= 612+import System.IO ( hGetContents, hSetEncoding, utf8 )+#endif +-- We need to force every file we open to be read in+-- as UTF8+alexReadFile :: FilePath -> IO String+#if __GLASGOW_HASKELL__ >= 612+alexReadFile file = do+ h <- alexOpenFile file ReadMode+ hGetContents h+#else+alexReadFile = readFile+#endif++-- We need to force every file we write to be written+-- to as UTF8+alexOpenFile :: FilePath -> IOMode -> IO Handle+#if __GLASGOW_HASKELL__ >= 612+alexOpenFile file mode = do+ h <- openFile file mode+ hSetEncoding h utf8+ return h+#else+alexOpenFile = openFile+#endif+ -- `main' decodes the command line arguments and calls `alex'. main:: IO ()@@ -68,7 +94,7 @@ 'x':'.':r -> return (reverse r) _ -> die (file ++ ": filename must end in \'.x\'\n") - prg <- readFile file+ prg <- alexReadFile file script <- parseScript file prg alex cli file basename script @@ -109,7 +135,7 @@ -- open the output file; remove it if we encounter an error bracketOnError - (openFile o_file WriteMode)+ (alexOpenFile o_file WriteMode) (\h -> do hClose h; removeFile o_file) $ \out_h -> do @@ -127,7 +153,7 @@ -- add the wrapper, if necessary when (isJust wrapper_name) $- do str <- readFile (fromJust wrapper_name)+ do str <- alexReadFile (fromJust wrapper_name) hPutStr out_h str let dfa = scanner2dfa scanner_final scs@@ -142,7 +168,7 @@ hPutStr out_h (actions "") -- add the template- tmplt <- readFile template_name+ tmplt <- alexReadFile template_name hPutStr out_h tmplt hClose out_h@@ -232,7 +258,7 @@ infoStart :: FilePath -> FilePath -> IO (String -> IO (), IO ()) infoStart x_file info_file = do bracketOnError- (openFile info_file WriteMode)+ (alexOpenFile info_file WriteMode) (\h -> do hClose h; removeFile info_file) (\h -> do infoHeader h x_file return (hPutStr h, hClose h)
src/NFA.hs view
@@ -47,7 +47,7 @@ -- Debug stuff instance Show (Accept a) where- showsPrec _ (Acc p act lctx rctx) = shows p --TODO+ showsPrec _ (Acc p _act _lctx _rctx) = shows p --TODO instance Show NState where showsPrec _ (NSt accs cl outs) =@@ -95,7 +95,7 @@ startcodes start_states where- do_token (RECtx scs lctx re rctx code) prio = do+ do_token (RECtx _scs lctx re rctx code) prio = do b <- newState e <- newState rexp2nfa b e re@@ -103,12 +103,12 @@ rctx_e <- case rctx of NoRightContext -> return NoRightContext- RightContextCode code ->- return (RightContextCode code)- RightContextRExp re -> do + RightContextCode code' ->+ return (RightContextCode code')+ RightContextRExp re' -> do r_b <- newState r_e <- newState- rexp2nfa r_b r_e re+ rexp2nfa r_b r_e re' accept r_e rctxt_accept return (RightContextRExp r_b) @@ -171,7 +171,7 @@ return a = N $ \s n -> (s,n,a) m >>= k = N $ \s n -> case unN m s n of- (s,n,a) -> unN (k a) s n+ (s', n', a) -> unN (k a) s' n' runNFA :: NFAM () -> NFA runNFA m = case unN m 0 Map.empty of@@ -189,9 +189,9 @@ newState = N $ \s n -> (s+1,n,s) charEdge :: SNum -> CharSet -> SNum -> NFAM ()-charEdge from charset to = N $ \s n -> (s, addEdge n from charset to, ())+charEdge from charset to = N $ \s n -> (s, addEdge n, ()) where- addEdge n from charset to = + addEdge n = case Map.lookup from n of Nothing -> Map.insert from (NSt [] [] [(charset,to)]) n@@ -201,17 +201,17 @@ epsilonEdge :: SNum -> SNum -> NFAM () epsilonEdge from to | from == to = return ()- | otherwise = N $ \s n -> (s, addEdge n from to, ())+ | otherwise = N $ \s n -> (s, addEdge n, ()) where- addEdge n from to = + addEdge n = case Map.lookup from n of Nothing -> Map.insert from (NSt [] [to] []) n Just (NSt acc eps trans) -> Map.insert from (NSt acc (to:eps) trans) n accept :: SNum -> Accept Code -> NFAM ()-accept state new_acc = N $ \s n -> (s, addAccept n state, ())+accept state new_acc = N $ \s n -> (s, addAccept n, ()) where- addAccept n state = + addAccept n = case Map.lookup state n of Nothing -> Map.insert state (NSt [new_acc] [] []) n
src/Output.hs view
@@ -29,7 +29,7 @@ -- Printing the output outputDFA :: Target -> Int -> String -> DFA SNum Code -> ShowS-outputDFA target n func_nm dfa+outputDFA target _ _ dfa = interleave_shows nl [outputBase, outputTable, outputCheck, outputDefault, outputAccept] where @@ -73,14 +73,14 @@ outputAccs accs = brack (interleave_shows (char ',') (map (paren.outputAcc) accs)) - outputAcc (Acc prio Nothing Nothing NoRightContext)+ outputAcc (Acc _ Nothing Nothing NoRightContext) = str "AlexAccSkip"- outputAcc (Acc prio (Just act) Nothing NoRightContext)+ outputAcc (Acc _ (Just act) Nothing NoRightContext) = str "AlexAcc " . paren (str act)- outputAcc (Acc prio Nothing lctx rctx)+ outputAcc (Acc _ Nothing lctx rctx) = str "AlexAccSkipPred " . space . paren (outputPred lctx rctx)- outputAcc (Acc prio (Just act) lctx rctx)+ outputAcc (Acc _ (Just act) lctx rctx) = str "AlexAccPred " . space . paren (str act) . space . paren (outputPred lctx rctx)@@ -171,8 +171,8 @@ [ expand (dfa_arr!state) | state <- [0..top_state] ] expand (State _ out) = - [(i, lookup out i) | i <- ['\0'..'\255']]- where lookup out i = case Map.lookup i out of+ [(i, lookup' out i) | i <- ['\0'..'\255']]+ where lookup' out' i = case Map.lookup i out' of Nothing -> -1 Just s -> s @@ -243,7 +243,7 @@ = fit_all entries 0 1 where - fit_all [] max_off fst_zero = return max_off+ fit_all [] max_off _ = return max_off fit_all (s:ss) max_off fst_zero = do (off, new_max_off, new_fst_zero) <- fit s max_off fst_zero writeArray off_arr off 1@@ -272,6 +272,11 @@ -- Find a valid offset in the table for this state.+findFreeOffset :: Int+ -> STUArray s Int Int+ -> STUArray s Int Int+ -> [(Int, Int)]+ -> ST s Int findFreeOffset off check off_arr state = do -- offset 0 isn't allowed if off == 0 then try_next else do@@ -296,7 +301,9 @@ if i /= -1 then return False else fits off rest check -addState off table check [] = return ()+addState :: Int -> STUArray s Int Int -> STUArray s Int Int -> [(Int, Int)]+ -> ST s ()+addState _ _ _ [] = return () addState off table check ((t,val):state) = do writeArray table (off+t) val writeArray check (off+t) t@@ -330,7 +337,9 @@ hexChar16 i = toHex (i .&. 0xff) ++ toHex ((i `shiftR` 8) .&. 0xff) -- force little-endian +toHex :: Int -> String toHex i = ['\\','x', hexDig (i `div` 16), hexDig (i `mod` 16)] +hexDig :: Int -> Char hexDig i | i <= 9 = chr (i + ord '0') | otherwise = chr (i - 10 + ord 'a')
src/ParseMonad.hs view
@@ -27,10 +27,10 @@ String) -- current input string alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar (p,c,s) = c+alexInputPrevChar (_,c,_) = c alexGetChar :: AlexInput -> Maybe (Char,AlexInput)-alexGetChar (p,c,[]) = Nothing+alexGetChar (_,_,[]) = Nothing alexGetChar (p,_,(c:s)) = let p' = alexMove p c in p' `seq` Just (c, (p', c, s)) @@ -52,7 +52,7 @@ alexMove :: AlexPosn -> Char -> AlexPosn alexMove (AlexPn a l c) '\t' = AlexPn (a+1) l (((c+7) `div` 8)*8+1)-alexMove (AlexPn a l c) '\n' = AlexPn (a+1) (l+1) 1+alexMove (AlexPn a l _) '\n' = AlexPn (a+1) (l+1) 1 alexMove (AlexPn a l c) _ = AlexPn (a+1) l (c+1) -- -----------------------------------------------------------------------------@@ -86,6 +86,7 @@ PState{ smac_env=senv, rmac_env=renv, startcode = 0, input=(alexStartPos,'\n',str) } +failP :: String -> P a failP str = P $ \PState{ input = (p,_,_) } -> Left (Just p,str) -- Macros are expanded during parsing, to simplify the abstract
src/Parser.y view
@@ -7,6 +7,8 @@ -- -- ----------------------------------------------------------------------------- +{-# OPTIONS_GHC -w #-}+ module Parser ( parse, P ) where import AbsSyn import Scan
src/Scan.x view
@@ -11,6 +11,8 @@ ------------------------------------------------------------------------------- {+{-# OPTIONS_GHC -w #-}+ module Scan(lexer, AlexPosn(..), Token(..), Tkn(..), tokPosn) where import Data.Char
src/Sort.hs view
@@ -19,6 +19,8 @@ module Sort where +-- Hide (<=) so that we don't get name shadowing warnings for it+import Prelude hiding ((<=)) -- `isort' is an insertion sort and is here for historical reasons; msort is -- better in almost every situation.@@ -27,16 +29,16 @@ isort (<=) = foldr (insrt (<=)) [] insrt:: (a->a->Bool) -> a -> [a] -> [a]-insrt (<=) e [] = [e]+insrt _ e [] = [e] insrt (<=) e l@(h:t) = if e<=h then e:l else h:insrt (<=) e t msort :: (a->a->Bool) -> [a] -> [a]-msort (<=) [] = [] -- (foldb f []) is undefined+msort _ [] = [] -- (foldb f []) is undefined msort (<=) xs = foldb (mrg (<=)) (runs (<=) xs) runs :: (a->a->Bool) -> [a] -> [[a]]-runs (<=) xs = foldr op [] xs+runs (<=) xs0 = foldr op [] xs0 where op z xss@(xs@(x:_):xss') | z<=x = (z:xs):xss' | otherwise = [z]:xss@@ -44,14 +46,14 @@ foldb :: (a->a->a) -> [a] -> a foldb _ [x] = x-foldb f xs = foldb f (fold xs)+foldb f xs0 = foldb f (fold xs0) where fold (x1:x2:xs) = f x1 x2 : fold xs fold xs = xs mrg:: (a->a->Bool) -> [a] -> [a] -> [a]-mrg (<=) [] l = l-mrg (<=) l@(_:_) [] = l+mrg _ [] l = l+mrg _ l@(_:_) [] = l mrg (<=) l1@(h1:t1) l2@(h2:t2) = if h1<=h2 then h1:mrg (<=) t1 l2
src/Util.hs view
@@ -12,17 +12,25 @@ -- Pretty-printing utilities +str :: String -> String -> String str = showString+char :: Char -> String -> String char c = (c :) +nl :: String -> String nl = char '\n' +paren :: (String -> String) -> String -> String paren s = char '(' . s . char ')'++brack :: (String -> String) -> String -> String brack s = char '[' . s . char ']' -interleave_shows s [] = id+interleave_shows :: (String -> String) -> [String -> String] -> String -> String+interleave_shows _ [] = id interleave_shows s xs = foldr1 (\a b -> a . s . b) xs +space :: String -> String space = char ' ' cjustify, ljustify, rjustify :: Int -> String -> String@@ -35,4 +43,5 @@ spaces :: Int -> String spaces n = replicate n ' ' +hline :: String hline = replicate 77 '-'
templates/GenericTemplate.hs view
@@ -9,6 +9,7 @@ #ifdef ALEX_GHC #define ILIT(n) n#+#define FAST_INT_BINDING(n) !(n) #define IBOX(n) (I# (n)) #define FAST_INT Int# #define LT(n,m) (n <# m)@@ -21,6 +22,7 @@ #define IF_GHC(x) (x) #else #define ILIT(n) (n)+#define FAST_INT_BINDING(n) (n) #define IBOX(n) (n) #define FAST_INT Int #define LT(n,m) (n < m)@@ -155,12 +157,12 @@ trace ("State: " ++ show IBOX(s) ++ ", char: " ++ show c) $ #endif let- base = alexIndexInt32OffAddr alex_base s- IBOX(ord_c) = ord c- offset = PLUS(base,ord_c)- check = alexIndexInt16OffAddr alex_check offset+ FAST_INT_BINDING(base) = alexIndexInt32OffAddr alex_base s+ FAST_INT_BINDING(IBOX(ord_c)) = ord c+ FAST_INT_BINDING(offset) = PLUS(base,ord_c)+ FAST_INT_BINDING(check) = alexIndexInt16OffAddr alex_check offset - new_s = if GTE(offset,ILIT(0)) && EQ(check,ord_c)+ FAST_INT_BINDING(new_s) = if GTE(offset,ILIT(0)) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in