
Hello, There seems to be a problem with the .hi file writer and/or parser in nhc98 (v1.10, 2001-10-19). The following test case demonstrates the problem: -- File: Arrow.hs module Arrow where class Arrow a where arr :: (x -> y) -> a x y instance Arrow (->) where {- This is the problem spot -} arr = id -- END of Arrow.hs -- File: Test.hs module Main where import Arrow main :: IO () main = return () -- END of Test.hs Arrow.hs compiles OK, but Test.hs does not: | % nhc98 -c Test.hs | | Fail: In file ./Arrow.hi: | 4:17 Found (Prelude.->) but expected a ) --Joe English jenglish@flightlab.com

instance Arrow (->) where {- This is the problem spot -} arr = id
Fail: In file ./Arrow.hi: 4:17 Found (Prelude.->) but expected a )
Ok, patch below. With this patch, nhc98 will now also accept the qualified use of -> in a source file, e.g. instance Arrow (Prelude.->) where arr = id Regards, Malcolm Index: src/compiler98/Parse2.hs =================================================================== RCS file: /usr/src/master/nhc/src/compiler98/Parse2.hs,v retrieving revision 1.12 diff -u -r1.12 Parse2.hs --- src/compiler98/Parse2.hs 2001/10/17 12:53:47 1.12 +++ src/compiler98/Parse2.hs 2001/11/08 14:18:37 @@ -224,6 +224,8 @@ `orelse` mkAppInst `parseAp` conid `ap` many varid `orelse` + (\pos-> TypeCons pos t_Arrow []) `parseAp` k_rarrow + `orelse` -- (TypeCons noPos (t_Tuple 0) []) `parseChk` lpar `chk` rpar -- `orelse` parse (TypeCons noPos (t_Tuple 0) []) Index: src/compiler98/ParseLex.hs =================================================================== RCS file: /usr/src/master/nhc/src/compiler98/ParseLex.hs,v retrieving revision 1.3 diff -u -r1.3 ParseLex.hs --- src/compiler98/ParseLex.hs 2000/10/18 12:43:25 1.3 +++ src/compiler98/ParseLex.hs 2001/11/08 14:18:37 @@ -4,9 +4,9 @@ import Lexical import Syntax(Lit(..),Boxed(..),Exp(..),Alt,Pat(..),Decls,Context,Type,Stmt,Field) import ParseLib -import TokenId(TokenId,isUnit,t_Bang,tprefix,tas,tunboxed,tprimitive,t_Tuple, - tforall,tdot, - t_foreign,t_export,t_ccall,t_stdcall,t_unsafe,t_cast,t_noproto) +import TokenId(TokenId,isUnit,t_Bang,tprefix,tas,tunboxed,tprimitive,t_Tuple + ,tforall,tdot,t_Arrow + ,t_foreign,t_export,t_ccall,t_stdcall,t_unsafe,t_cast,t_noproto) lit a = literal (a::Lex) @@ -46,6 +46,7 @@ k_as = lvarid tas "as" k_forall = lvarid tforall "forall" k_dot = lvarop tdot "dot" +k_rarrow = lvarop t_Arrow "->" -- "special" identifiers for FFI which are not (all) language keywords. k_foreign = lvarid t_foreign "foreign"
participants (2)
-
Joe English
-
Malcolm Wallace