ghc/compiler/reader/PrefixToHs.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[PrefixToHS]{Support routines for converting ``prefix form'' to Haskell abstract syntax}
   5
   6 Support routines for reading prefix-form from the Lex/Yacc parser.
   7
   8 \begin{code}
   9 module PrefixToHs (
  10         cvBinds,
  11         cvMonoBindsAndSigs,
  12         cvTopDecls,
  13         cvValSig, cvClassOpSig, cvInstDeclSig
  14     ) where
  15
  16 #include "HsVersions.h"
  17
  18 import PrefixSyn        -- and various syntaxen.
  19 import HsSyn
  20 import RdrHsSyn
  21
  22 import BasicTypes       ( RecFlag(..) )
  23 import SrcLoc           ( mkSrcLoc )
  24 import Util             ( mapAndUnzip )
  25 import Panic            ( panic, assertPanic )
  26 \end{code}
  27
  28 %************************************************************************
  29 %*                                                                      *
  30 \subsection[cvDecls]{Convert various top-level declarations}
  31 %*                                                                      *
  32 %************************************************************************
  33
  34 We make a point not to throw any user-pragma ``sigs'' at
  35 these conversion functions:
  36
  37 \begin{code}
  38 cvValSig, cvClassOpSig, cvInstDeclSig :: SigConverter
  39
  40 cvValSig      sig = sig
  41
  42 cvInstDeclSig sig = sig
  43
  44 cvClassOpSig (Sig var poly_ty src_loc) = ClassOpSig var Nothing poly_ty src_loc
  45 cvClassOpSig sig                       = sig
  46 \end{code}
  47
  48
  49 %************************************************************************
  50 %*                                                                      *
  51 \subsection[cvBinds-etc]{Converting to @HsBinds@, @MonoBinds@, etc.}
  52 %*                                                                      *
  53 %************************************************************************
  54
  55 Function definitions are restructured here. Each is assumed to be recursive
  56 initially, and non recursive definitions are discovered by the dependency
  57 analyser.
  58
  59 \begin{code}
  60 cvBinds :: SrcFile -> SigConverter -> RdrBinding -> RdrNameHsBinds
  61         -- The mysterious SigConverter converts Sigs to ClassOpSigs
  62         -- in class declarations.  Mostly it's just an identity function
  63
  64 cvBinds sf sig_cvtr binding
  65   = case (cvMonoBindsAndSigs sf sig_cvtr binding) of { (mbs, sigs) ->
  66     MonoBind mbs sigs Recursive
  67     }
  68 \end{code}
  69
  70 \begin{code}
  71 cvMonoBindsAndSigs :: SrcFile
  72                    -> SigConverter
  73                    -> RdrBinding
  74                    -> (RdrNameMonoBinds, [RdrNameSig])
  75
  76 cvMonoBindsAndSigs sf sig_cvtr fb
  77   = mangle_bind (EmptyMonoBinds, []) fb
  78   where
  79     mangle_bind acc RdrNullBind
  80       = acc
  81
  82     mangle_bind acc (RdrAndBindings fb1 fb2)
  83       = mangle_bind (mangle_bind acc fb1) fb2
  84
  85     mangle_bind (b_acc, s_acc) (RdrSig sig)
  86       = (b_acc, sig_cvtr sig : s_acc)
  87
  88     mangle_bind (b_acc, s_acc) (RdrValBinding binding)
  89       = (b_acc `AndMonoBinds` binding, s_acc)
  90 \end{code}
  91
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection[PrefixToHS-utils]{Utilities for conversion}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 Separate declarations into all the various kinds:
 100
 101 \begin{code}
 102 cvTopDecls :: SrcFile -> RdrBinding -> [RdrNameHsDecl]
 103 cvTopDecls srcfile bind
 104   = let
 105         (top_decls, mono_binds, sigs) = go ([], EmptyMonoBinds, []) bind
 106     in
 107     (ValD (MonoBind mono_binds sigs Recursive) : top_decls)
 108   where
 109     go acc                RdrNullBind            = acc
 110     go acc                (RdrAndBindings b1 b2) = go (go acc b1) b2
 111     go (topds, mbs, sigs) (RdrHsDecl d)          = (d : topds, mbs, sigs)
 112     go (topds, mbs, sigs) (RdrSig (FixSig d))    = (FixD d  : topds, mbs, sigs)
 113     go (topds, mbs, sigs) (RdrSig sig)           = (topds, mbs, sig:sigs)
 114     go (topds, mbs, sigs) (RdrValBinding bind)   = (topds, mbs `AndMonoBinds` bind, sigs)
 115 \end{code}