RE: Literate scripts not handled correctly

My understanding is that the following script:
----- cut here -----
foo :: Int -> Int foo _ = 2
\begin{code}
bar :: Int -> Int bar _ = 1
\end{code}
----- cut here -----
should be valid and define foo and bar (although the report does say "It is not advisable to mix these two styles in the same file").
However, in hugs: ERROR Q.lhs:7 - Syntax error in input (unexpected symbol "bar")
This is probably due to layout. The unliterate version of the file would be foo :: Int -> Int foo _ = 2 bar :: Int -> Int bar _ = 1 so the occurrence of the token 'bar' at a column less than that of the first 'foo' causes a close brace to be inserted by the layout system, closing the top-level declaration group.
Secondly, in the following script (which I think should define main according to the report):
----- cut here -----
\begin{code}
module Main where
main :: IO() main = putStrLn "Foo"
\end{code}
----- cut here -----
hugs: ERROR W.lhs:12 - Empty script - perhaps you forgot the `>'s?
% nhc98 -c -o W.o W.lhs Warning: Can not find main in module Main.
ghc -c -o W.o W.lhs W.lhs line 11: unlit: missing \end{code}
Interestingly it works in GHC if you remove the white space before the end but not before the begin.
Yes, it looks like GHC's unlit program removes whitespace when looking for \begin{code}, but not for \end{code}. The report isn't explicit about whether whitespace is allowed on these lines, but I would tend to the view that it isn't. Cheers, Simon
participants (1)
-
Simon Marlow