clone 403091 -1 retitle -1 cpphs truncates output file reassign -1 cpphs block 403091 -1 thanks
Hi Lucas,
Thanks for your bug report.
Op do, 14-12-2006 te 16:23 +0100, schreef Lucas Nussbaum:
> During a rebuild of all packages in etch, I discovered that your package
> failed to build on i386.
>
> Relevant parts:
> Building setup...
> Running: ghc6 -package Cabal Setup.hs -o setup
> compilation IS NOT required
> ./setup haddock
> setup: Warning: The field "hs-source-dir" is deprecated, please use
> hs-source-dirs.
> dist/build/tmp/src/UU/Parsing/Offside.hs:"dist/build/tmp/src/UU/Parsing/Offside.hs":
> 163:21: Parse e
> rror
> Warning: cannot use package base:
> HTML directory /usr/share/ghc-6.6/html/libraries/base does not exist.
> Warning: cannot use package haskell98:
> HTML directory /usr/share/ghc-6.6/html/libraries/haskell98 does not exist.
> Preprocessing library uulib-0.9.2...
> Running Haddock for uulib-0.9.2...
> make: *** [install-indep] Error 1
Hmm, this bug is caused by the latest upload of cpphs it seems:
(pbuild15857)[EMAIL PROTECTED]:~/haskell-uulib-0.9.2# ./setup haddock -v
setup: Warning: The field "hs-source-dir" is deprecated, please use
hs-source-dirs.
Preprocessing library uulib-0.9.2...
Running Haddock for uulib-0.9.2...
/usr/bin/cpphs -Odist/build/tmp/src/UU/Parsing/CharParser.hs
src/UU/Parsing/CharParser.hs --noline --strip -Dlinux_BUILD_OS -Dlinux_HOST_OS
-Di386_BUILD_ARCH -Di386_HOST_ARCH -D__HUGS__ -D__HADDOCK__
...
/usr/bin/cpphs -Odist/build/tmp/src/UU/Parsing/Offside.hs
src/UU/Parsing/Offside.hs --noline --strip -Dlinux_BUILD_OS -Dlinux_HOST_OS
-Di386_BUILD_ARCH -Di386_HOST_ARCH -D__HUGS__ -D__HADDOCK__
...
/usr/bin/haddock --html --odir=dist/doc/html --title=uulib-0.9.2:
--package=uulib-0.9.2 --dump-interface=dist/doc/html/uulib.haddock
--prologue=uulib-0.9.2-haddock-prolog.txt --use-package=base
--use-package=haskell98 dist/build/tmp/src/UU/Parsing/CharParser.hs
dist/build/tmp/src/UU/Parsing/Derived.hs
dist/build/tmp/src/UU/Parsing/Interface.hs
dist/build/tmp/src/UU/Parsing/MachineInterface.hs
dist/build/tmp/src/UU/Parsing/Merge.hs dist/build/tmp/src/UU/Parsing/Offside.hs
dist/build/tmp/src/UU/Parsing/Perms.hs
dist/build/tmp/src/UU/Parsing/StateParser.hs dist/build/tmp/src/UU/Parsing.hs
dist/build/tmp/src/UU/DData/IntBag.hs dist/build/tmp/src/UU/DData/Map.hs
dist/build/tmp/src/UU/DData/MultiSet.hs dist/build/tmp/src/UU/DData/Queue.hs
dist/build/tmp/src/UU/DData/Scc.hs dist/build/tmp/src/UU/DData/Seq.hs
dist/build/tmp/src/UU/DData/Set.hs dist/build/tmp/src/UU/PPrint.hs
dist/build/tmp/src/UU/Pretty/Ext.hs dist/build/tmp/src/UU/Pretty.hs
dist/build/tmp/src/UU/Scanner/GenToken.hs
dist/build/tmp/src/UU/Scanner/GenTokenOrd.hs
dist/build/tmp/src/UU/Scanner/GenTokenParser.hs
dist/build/tmp/src/UU/Scanner/GenTokenSymbol.hs
dist/build/tmp/src/UU/Scanner/Position.hs
dist/build/tmp/src/UU/Scanner/Scanner.hs dist/build/tmp/src/UU/Scanner/Token.hs
dist/build/tmp/src/UU/Scanner/TokenParser.hs
dist/build/tmp/src/UU/Scanner/TokenShow.hs dist/build/tmp/src/UU/Scanner.hs
dist/build/tmp/src/UU/Util/BinaryTrees.hs
dist/build/tmp/src/UU/Util/PermTree.hs dist/build/tmp/src/UU/Util/Utils.hs
dist/build/tmp/src/UU/Pretty/Basic.hs dist/build/tmp/src/UU/Parsing/Machine.hs
dist/build/tmp/src/UU/DData/IntMap.hs dist/build/tmp/src/UU/DData/IntSet.hs
Warning: cannot use package base:
HTML directory /usr/share/ghc-6.6/html/libraries/base does not exist.
Warning: cannot use package haskell98:
HTML directory /usr/share/ghc-6.6/html/libraries/haskell98 does not exist.
dist/build/tmp/src/UU/Parsing/Offside.hs:"dist/build/tmp/src/UU/Parsing/Offside.hs":
163:21: Parse error
The file written by cpphs is truncated at line 163 which cause the parse error.
Ian, cpphs seems to choke on the attached file and does not write a
complete output file. You can try this by doing:
cpphs -OOutOffside.hs Offside.hs --noline --strip)
The output file OutOffside.hs is truncated. What is strange that when
cpphs is called without the -o flag output on the stdout is NOT
truncated.
Ian, could you look into this? BTW cpphs 1.3 does not truncate the file.
Greetings Arjan
module UU.Parsing.Offside( parseOffside
, pBlock
, pBlock1
, pOffside
, pOpen
, pClose
, pSeparator
, scanOffside
, OffsideSymbol(..)
, OffsideInput
, Stream
, OffsideParser(..)
) where
import UU.Parsing.Interface
import UU.Parsing.Machine
import UU.Parsing.Derived(opt, pFoldr1Sep,pList,pList1, pList1Sep)
import UU.Scanner.Position
data OffsideSymbol s =
Symbol s
| SemiColon
| CloseBrace
| OpenBrace
deriving (Ord,Eq,Show)
scanOffside :: (InputState i s p, Position p, Eq s)
=> s -> s -> s -> [s] -> i -> OffsideInput i s p
scanOffside mod open close triggers ts = start ts []
where
isModule t = t == mod
isOpen t = t == open
isClose t = t == close
isTrigger t = t `elem` triggers
end ts = Off (getPosition ts) (End ts)
cons :: p -> OffsideSymbol s -> OffsideInput i s p -> OffsideInput i s p
cons p s r = Off p (Cons s r) Nothing
start = case splitStateE ts of
Left' t _ | not (isModule t || isOpen t) -> implicitL 0 (column (getPosition ts) )
_ -> layoutL 0
-- L (<n>:ts) (m:ms) = ; : (L ts (m:ms)) if m = n
-- = } : (L (<n>:ts) ms) if n < m
-- L (<n>:ts) ms = L ts ms
startlnL l n ts (m:ms) | m == n = cons (getPosition ts) SemiColon (layoutL (line (getPosition ts)) ts (m:ms))
| n < m = cons (getPosition ts) CloseBrace (startlnL l n ts ms)
startlnL l n ts ms = layoutL (line (getPosition ts)) ts ms
-- L ({n}:ts) (m:ms) = { : (L ts (n:m:ms)) if n > m (Note 1)
-- L ({n}:ts) [] = { : (L ts [n]) if n > 0 (Note 1)
-- L ({n}:ts) ms = { : } : (L (<n>:ts) ms) (Note 2)
implicitL l n ts (m:ms) | n > m = cons (getPosition ts) OpenBrace (layoutL (line (getPosition ts)) ts (n:m:ms))
implicitL l n ts [] | n > 0 = cons (getPosition ts) OpenBrace (layoutL (line (getPosition ts)) ts [n])
implicitL l n ts ms = cons (getPosition ts) OpenBrace (cons (getPosition ts) CloseBrace (startlnL l n ts ms))
layoutL ln ts ms | ln /= sln = startln (column pos) ts ms
| otherwise = sameln ts ms
where sln = line pos
pos = getPosition ts
layout = layoutL ln
implicit = implicitL ln
startln = startlnL ln
-- If a let ,where ,do , or of keyword is not followed by the lexeme {,
-- the token {n} is inserted after the keyword, where nis the indentation of
-- the next lexeme if there is one, or 0 if the end of file has been reached.
aftertrigger ts ms = case splitStateE ts of
Left' t _ | isOpen t -> layout ts ms
| otherwise -> implicit (column(getPosition ts)) ts ms
Right' _ -> implicit 0 ts ms
-- L ( }:ts) (0:ms) = } : (L ts ms) (Note 3)
-- L ( }:ts) ms = parse-error (Note 3), matching of implicit/explicit braces is handled by parser
-- L ( {:ts) ms = {: (L ts (0:ms)) (Note 4)
-- L (t:ts) (m:ms) = }: (L (t:ts) ms) if m /= 0 and parse-error(t) (Note 5)
-- L (t:ts) ms = t : (L ts ms)
sameln tts ms = case splitStateE tts of
Left' t ts | isTrigger t -> cons pos (Symbol t) (aftertrigger ts ms)
| isClose t -> cons pos (Symbol t)
(case ms of
0:ms -> layout ts ms
_ -> layout ts ms
)
| isOpen t -> cons pos (Symbol t) (layout ts (0:ms))
| otherwise -> let parseError = case ms of
m:ms | m /= 0 -> Just (layout tts ms)
_ -> Nothing
in Off pos (Cons (Symbol t) (layout ts ms)) parseError
Right' rest -> endofinput pos rest ms
where pos = getPosition tts
-- L [] [] = []
-- L [] (m:ms) = } : L [] ms if m /=0 (Note 6)
-- = L [] ms, if m == 0 (this is an error, the parser should yield a parse error, if this situation occurs)
endofinput pos rest [] = Off pos (End rest) Nothing
endofinput pos rest (m:ms) | m /= 0 = cons pos CloseBrace (endofinput pos rest ms)
| otherwise = endofinput pos rest ms
data Stream inp s p = Cons (OffsideSymbol s) (OffsideInput inp s p)
| End inp
data OffsideInput inp s p = Off p (Stream inp s p) (Maybe (OffsideInput inp s p))
instance InputState inp s p => InputState (OffsideInput inp s p) (OffsideSymbol s) p where
splitStateE inp@(Off p stream _) = case stream of
Cons s rest -> Left' s rest
_ -> Right' inp
splitState (Off _ stream _) =
case stream of
Cons s rest -> (s ,rest)
getPosition (Off pos _ _ ) = pos
instance Symbol s => Symbol (OffsideSymbol s) where
deleteCost s = case s of
Symbol s -> deleteCost s
SemiColon -> 5
OpenBrace -> 5
CloseBrace -> 5
symBefore s = case s of
Symbol s -> Symbol (symBefore s)
SemiColon -> error "Symbol.symBefore SemiColon"
OpenBrace -> error "Symbol.symBeforeOpenBrace"
CloseBrace -> error "Symbol.symBefore CloseBrace"
symAfter s = case s of
Symbol s -> Symbol (symAfter s)
SemiColon -> error "Symbol.symAfter SemiColon"
OpenBrace -> error "Symbol.symAfter OpenBrace"
CloseBrace -> error "Symbol.symAfter CloseBrace"
newtype OffsideParser i o s p a = OP (AnaParser (OffsideInput i s p) o (OffsideSymbol s) p a)
instance (Symbol s, Ord s, InputState i s p, OutputState o) => IsParser (OffsideParser i o s p) s where
(<*>) = operator (<*>)
(<* ) = operator (<* )
( *>) = operator ( *>)
(<|>) = operator (<|>)
(<$>) = operatorr (<$>)
(<$ ) = operatorr (<$ )
pSucceed = OP . pSucceed
pLow = OP . pLow
pFail = OP pFail
pCostRange c s (Range l r) = OP (getSymbol <$> pCostRange c (Symbol s) (Range (Symbol l)(Symbol r)))
pCostSym c s t = OP (getSymbol <$> pCostSym c (Symbol s) (Symbol t))
pSym s = OP (getSymbol <$> pSym (Symbol s))
pRange s (Range l r) = OP (getSymbol <$> pRange (Symbol s) (Range (Symbol l)(Symbol r)))
getfirsts (OP p) = removeSymbol (getfirsts p)
setfirsts exp (OP p) = OP (setfirsts (addSymbol exp) p)
getzerop (OP p) = fmap OP (getzerop p)
getonep (OP p) = fmap OP (getonep p)
removeSymbol exp = case exp of
ESym (Range (Symbol l) (Symbol r)) -> ESym (Range l r)
ESym _ -> EOr []
EStr txt -> EStr txt
EOr exps -> EOr (map removeSymbol exps)
ESeq exps -> ESeq (map removeSymbol exps)
addSymbol exp = case exp of
ESym (Range l r) -> ESym (Range (Symbol l) (Symbol r))
EStr txt -> EStr txt
EOr exps -> EOr (map addSymbol exps)
ESeq exps -> ESeq (map addSymbol exps)
getSymbol (Symbol s) = s
operator f (OP p) (OP q) = OP (f p q)
operatorr f g (OP p) = OP (f g p)
pSeparator :: (OutputState o, InputState i s p, Position p, Symbol s, Ord s)
=> OffsideParser i o s p ()
pSeparator = OP (() <$ pCostSym 5 SemiColon SemiColon)
pClose, pOpen :: (OutputState o, InputState i s p, Position p, Symbol s, Ord s)
=> OffsideParser i o s p ()
pClose = OP (pWrap f g ( () <$ pSym CloseBrace) )
where g state steps1 k = (state,ar,k)
where ar = case state of
Off _ _ (Just state') -> let steps2 = k state'
in if not (hasSuccess steps1) && hasSuccess steps2 then steps2 else steps1
_ -> steps1
f acc state steps k = let (stl,ar,str2rr) = g state (val snd steps) k
in (stl ,val (acc ()) ar , str2rr )
pOpen = OP (() <$ pSym OpenBrace)
pOffside :: (InputState i s p, OutputState o, Position p, Symbol s, Ord s)
=> OffsideParser i o s p x
-> OffsideParser i o s p y
-> OffsideParser i o s p a
-> OffsideParser i o s p a
-> OffsideParser i o s p a
pOffside open close bodyE bodyI =
open *> bodyE <* close
<|> pOpen *> bodyI <* pClose
pBlock :: (InputState i s p, OutputState o, Position p, Symbol s, Ord s)
=> OffsideParser i o s p x
-> OffsideParser i o s p y
-> OffsideParser i o s p z
-> OffsideParser i o s p a
-> OffsideParser i o s p [a]
pBlock open sep close p = pOffside open close explicit implicit
where elem = (:) <$> p `opt` id
sep' = () <$ sep
elems s = ($[]) <$> pFoldr1Sep ((.),id) s elem
explicit = elems sep'
implicit = elems (sep' <|> pSeparator)
pBlock1 :: (InputState i s p, OutputState o, Position p, Symbol s, Ord s)
=> OffsideParser i o s p x
-> OffsideParser i o s p y
-> OffsideParser i o s p z
-> OffsideParser i o s p a
-> OffsideParser i o s p [a]
pBlock1 open sep close p = pOffside open close explicit implicit
where sep' = () <$ sep
elems s = pList s *> pList1Sep (pList1 s) p <* pList s
explicit = elems sep'
implicit = elems (sep' <|> pSeparator)
parseOffside :: (Symbol s, InputState i s p, Position p)
=> OffsideParser i Pair s p a
-> OffsideInput i s p
-> Steps (a, OffsideInput i s p) (OffsideSymbol s) p
parseOffside (OP p) inp = val fromPair (parse p inp)
where fromPair (Pair x (Pair y _)) = (x,y)
signature.asc
Description: Dit berichtdeel is digitaal ondertekend
