[project @ 1998-12-02 13:17:09 by simonm]

[ghc-hetmet.git] / ghc / compiler / reader / PrefixToHs.lhs

diff --git a/ghc/compiler/reader/PrefixToHs.lhs b/ghc/compiler/reader/PrefixToHs.lhs
index b91f75b..ee4c224 100644 (file)
--- a/ghc/compiler/reader/PrefixToHs.lhs
+++ b/ghc/compiler/reader/PrefixToHs.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[PrefixToHS]{Support routines for converting ``prefix form'' to Haskell abstract syntax}
 
@@ -14,7 +14,9 @@ module PrefixToHs (
        cvBinds,
        cvMonoBindsAndSigs,
        cvMatches,
-       cvOtherDecls
+       cvOtherDecls,
+       cvForeignDecls -- HACK
+
     ) where
 
 #include "HsVersions.h"
@@ -22,7 +24,6 @@ module PrefixToHs (
 import PrefixSyn       -- and various syntaxen.
 import HsSyn
 import RdrHsSyn
-import HsPragmas       ( noGenPragmas, noClassOpPragmas )
 
 import BasicTypes      ( RecFlag(..) )
 import SrcLoc          ( mkSrcLoc )
@@ -174,7 +175,9 @@ cvMatch sf is_case rdr_match
          RdrMatch_Guards  ln b c gd_exps d -> (c,d, map (cvGRHS sf ln) gd_exps)
 
 cvGRHS :: SrcFile -> SrcLine -> ([RdrNameStmt], RdrNameHsExpr) -> RdrNameGRHS
-cvGRHS sf sl (g, e) = GRHS g e (mkSrcLoc sf sl)
+cvGRHS sf sl (g, e) = GRHS (g ++ [ExprStmt e locn]) locn
+                   where
+                     locn = mkSrcLoc sf sl
 \end{code}
 
 %************************************************************************
@@ -197,4 +200,12 @@ cvOtherDecls b
     go acc (RdrDefaultDecl d)     = DefD d  : acc
     go acc other                 = acc
        -- Ignore value bindings
+
+cvForeignDecls :: RdrBinding -> [RdrNameHsDecl]
+cvForeignDecls b = go [] b
+ where
+    go acc (RdrAndBindings b1 b2) = go (go acc b1) b2
+    go acc (RdrForeignDecl d)     = ForD d  : acc
+    go acc other                 = acc
+ 
 \end{code}