[project @ 1998-02-10 14:15:51 by simonpj]

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

diff --git a/ghc/compiler/reader/PrefixToHs.lhs b/ghc/compiler/reader/PrefixToHs.lhs
index 61da9a2..acc8627 100644 (file)
--- a/ghc/compiler/reader/PrefixToHs.lhs
+++ b/ghc/compiler/reader/PrefixToHs.lhs
@@ -6,8 +6,6 @@
 Support routines for reading prefix-form from the Lex/Yacc parser.
 
 \begin{code}
-#include "HsVersions.h"
-
 module PrefixToHs (
        cvValSig,
        cvClassOpSig,
@@ -19,13 +17,14 @@ module PrefixToHs (
        cvOtherDecls
     ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import PrefixSyn       -- and various syntaxen.
 import HsSyn
 import RdrHsSyn
 import HsPragmas       ( noGenPragmas, noClassOpPragmas )
 
+import BasicTypes      ( RecFlag(..) )
 import SrcLoc          ( mkSrcLoc )
 import Util            ( mapAndUnzip, panic, assertPanic )
 \end{code}
@@ -45,11 +44,10 @@ cvValSig (RdrTySig vars poly_ty src_loc)
   = [ Sig v poly_ty src_loc | v <- vars ]
 
 cvClassOpSig (RdrTySig vars poly_ty src_loc)
-  = [ ClassOpSig v poly_ty noClassOpPragmas src_loc | v <- vars ]
+  = [ ClassOpSig v Nothing poly_ty src_loc | v <- vars ]
 
 cvInstDeclSig (RdrSpecValSig        sigs) = sigs
 cvInstDeclSig (RdrInlineValSig      sig)  = [ sig ]
-cvInstDeclSig (RdrDeforestSig      sig)  = [ sig ]
 cvInstDeclSig (RdrMagicUnfoldingSig sig)  = [ sig ]
 \end{code}
 
@@ -67,9 +65,7 @@ analyser.
 cvBinds :: SrcFile -> SigConverter -> RdrBinding -> RdrNameHsBinds
 cvBinds sf sig_cvtr binding
   = case (cvMonoBindsAndSigs sf sig_cvtr binding) of { (mbs, sigs) ->
-    if (null sigs)
-    then SingleBind (RecBind mbs)
-    else BindWith   (RecBind mbs) sigs
+    MonoBind mbs sigs Recursive
     }
 \end{code}
 
@@ -98,7 +94,6 @@ cvMonoBindsAndSigs sf sig_cvtr fb
 
     mangle_bind (b_acc, s_acc) (RdrSpecValSig       sig) = (b_acc, sig ++ s_acc)
     mangle_bind (b_acc, s_acc) (RdrInlineValSig      sig) = (b_acc, sig : s_acc)
-    mangle_bind (b_acc, s_acc) (RdrDeforestSig       sig) = (b_acc, sig : s_acc)
     mangle_bind (b_acc, s_acc) (RdrMagicUnfoldingSig sig) = (b_acc, sig : s_acc)
 
     mangle_bind (b_acc, s_acc)
@@ -128,13 +123,14 @@ cvMonoBindsAndSigs sf sig_cvtr fb
        }
 
     mangle_bind (b_acc, s_acc) other = (b_acc, s_acc)
+       -- Ignore class decls, instance decls etc
 \end{code}
 
 \begin{code}
 cvPatMonoBind :: SrcFile -> RdrMatch -> (RdrNamePat, [RdrNameGRHS], RdrNameHsBinds)
 
 cvPatMonoBind sf (RdrMatch_NoGuard srcline srcfun pat expr binding)
-  = (pat, [OtherwiseGRHS expr (mkSrcLoc sf srcline)], cvBinds sf cvValSig binding)
+  = (pat, unguardedRHS expr (mkSrcLoc sf srcline), cvBinds sf cvValSig binding)
 
 cvPatMonoBind sf (RdrMatch_Guards srcline srcfun pat guardedexprs binding)
   = (pat, map (cvGRHS sf srcline) guardedexprs, cvBinds sf cvValSig binding)
@@ -150,9 +146,9 @@ cvFunMonoBind sf matches
     get_mdef (RdrMatch_NoGuard _ sfun pat _ _) = get_pdef pat
     get_mdef (RdrMatch_Guards  _ sfun pat _ _) = get_pdef pat
 
-    get_pdef (ConPatIn fn _)     = (fn, False)
-    get_pdef (ConOpPatIn _ op _) = (op, True)
-    get_pdef (ParPatIn pat)     = get_pdef pat
+    get_pdef (ConPatIn fn _)       = (fn, False)
+    get_pdef (ConOpPatIn _ op _ _) = (op, True)
+    get_pdef (ParPatIn pat)       = get_pdef pat
 
 
 cvMatches :: SrcFile -> Bool -> [RdrMatch] -> [RdrNameMatch]
@@ -172,17 +168,17 @@ cvMatch sf is_case rdr_match
          (if is_case then -- just one pattern: leave it untouched...
              [pat]
           else            -- function pattern; extract arg patterns...
-             case pat of ConPatIn fn pats    -> pats
-                         ConOpPatIn p1 op p2 -> [p1,p2]
-                         ParPatIn pat        -> panic "PrefixToHs.cvMatch:ParPatIn"
+             case pat of ConPatIn fn pats      -> pats
+                         ConOpPatIn p1 op _ p2 -> [p1,p2]
+                         ParPatIn pat          -> panic "PrefixToHs.cvMatch:ParPatIn"
          )
   where
     (pat, binding, guarded_exprs)
       = case rdr_match of
-         RdrMatch_NoGuard ln b c expr    d -> (c,d, [OtherwiseGRHS expr (mkSrcLoc sf ln)])
+         RdrMatch_NoGuard ln b c expr    d -> (c,d, unguardedRHS expr (mkSrcLoc sf ln))
          RdrMatch_Guards  ln b c gd_exps d -> (c,d, map (cvGRHS sf ln) gd_exps)
 
-cvGRHS :: SrcFile -> SrcLine -> (RdrNameHsExpr, RdrNameHsExpr) -> RdrNameGRHS
+cvGRHS :: SrcFile -> SrcLine -> ([RdrNameStmt], RdrNameHsExpr) -> RdrNameGRHS
 cvGRHS sf sl (g, e) = GRHS g e (mkSrcLoc sf sl)
 \end{code}
 
@@ -205,4 +201,5 @@ cvOtherDecls b
     go acc (RdrInstDecl d)       = InstD d : acc 
     go acc (RdrDefaultDecl d)     = DefD d  : acc
     go acc other                 = acc
+       -- Ignore value bindings
 \end{code}