Literate scripts not handled correctly

Hi all 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") % ghc -c -o Q.o Q.lhs Q.lhs:7: parse error on input `bar' % nhc98 -c -o Q.o Q.lhs In file ./Q.lhs: 7:1 Found bar but expected a {-EOF-} 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. Thanks Ian

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").
The definitions of foo and bar are not at the same indentation level, so they are being rejected by the layout rule. At least, hugs and nhc98 accept it if you indent bar by two spaces, ghc still complains: ghc -c lit.lhs lit.lhs:9: parse error on input `_' Regards, Malcolm
participants (2)
-
Ian Lynagh
-
Malcolm Wallace