[project @ 1996-04-25 13:02:32 by partain]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixInfo.lhs

diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index 9f1747f..82b88c6 100644 (file)
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -1,25 +1,32 @@
 %
-% (c) The AQUA Project, Glasgow University, 1993-1995
+% (c) The AQUA Project, Glasgow University, 1993-1996
 %
 
 \begin{code}
 #include "HsVersions.h"
 
-module StixInfo (
-       genCodeInfoTable
-    ) where
-
-import AbsCSyn
-import ClosureInfo
-import MachDesc
-import Maybes          ( maybeToBool, Maybe(..) )
-import SMRep           ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
-import Stix
-import SplitUniq
-import Unique
-import Unpretty
-import Util
-
+module StixInfo ( genCodeInfoTable ) where
+
+import Ubiq{-uitious-}
+
+import AbsCSyn         ( AbstractC(..), CAddrMode, ReturnInfo,
+                         RegRelative, MagicId, CStmtMacro
+                       )
+import ClosureInfo     ( closurePtrsSize, closureSizeWithoutFixedHdr,
+                         closureNonHdrSize, closureSemiTag, maybeSelectorInfo,
+                         closureSMRep, closureLabelFromCI,
+                         infoTableLabelFromCI
+                       )
+import HeapOffs                ( hpRelToInt )
+import Maybes          ( maybeToBool )
+import PrimRep         ( PrimRep(..) )
+import SMRep           ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..),
+                         isSpecRep
+                       )
+import Stix            -- all of it
+import StixPrim                ( amodeToStix )
+import UniqSupply      ( returnUs, UniqSM(..) )
+import Unpretty                ( uppBesides, uppPStr, uppInt, uppChar )
 \end{code}
 
 Generating code for info tables (arrays of data).
@@ -37,39 +44,38 @@ data___rtbl = sStLitLbl SLIT("Data___rtbl")
 dyn___rtbl     = sStLitLbl SLIT("Dyn___rtbl")
 
 genCodeInfoTable
-    :: Target
-    -> AbstractC
-    -> SUniqSM StixTreeList
+    :: AbstractC
+    -> UniqSM StixTreeList
 
-genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
-    returnSUs (\xs -> info : lbl : xs)
+genCodeInfoTable (CClosureInfoAndCode cl_info _ _ upd cl_descr _)
+  = returnUs (\xs -> info : lbl : xs)
 
     where
-       info = StData PtrKind table
+       info = StData PtrRep table
        lbl = StLabel info_lbl
 
        table = case sm_rep of
            StaticRep _ _ -> [
                StInt (toInteger ptrs),
-                StInt (toInteger size),
-                upd_code,
+               StInt (toInteger size),
+               upd_code,
                static___rtbl,
-                tag]
+               tag]
 
            SpecialisedRep ConstantRep _ _ _ -> [
                StCLbl closure_lbl,
-                upd_code,
-                const___rtbl,
-                tag]
+               upd_code,
+               const___rtbl,
+               tag]
 
            SpecialisedRep CharLikeRep _ _ _ -> [
                upd_code,
                charlike___rtbl,
-                tag]
+               tag]
 
            SpecialisedRep IntLikeRep _ _ _ -> [
                upd_code,
-                intlike___rtbl,
+               intlike___rtbl,
                tag]
 
            SpecialisedRep _ _ _ updatable ->
@@ -83,27 +89,27 @@ genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
                                    SMNormalForm -> SLIT("Spec_N_")
                                    SMSingleEntry -> SLIT("Spec_S_")
                                    SMUpdatable -> SLIT("Spec_U_")
-                                  ),
+                                  ),
                           uppInt size,
                           uppChar '_',
                           uppInt ptrs,
                           uppPStr SLIT("_rtbl")])
-                in
+               in
                    case updatable of
                        SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
-                       _            -> [StLitLbl rtbl, tag]
+                       _            -> [StLitLbl rtbl, tag]
 
            GenericRep _ _ updatable ->
-                let rtbl = case updatable of
-                            SMNormalForm  -> gen_N___rtbl
-                            SMSingleEntry -> gen_S___rtbl
+               let rtbl = case updatable of
+                           SMNormalForm  -> gen_N___rtbl
+                           SMSingleEntry -> gen_S___rtbl
                            SMUpdatable   -> gen_U___rtbl
-                in [
+               in [
                    StInt (toInteger ptrs),
-                    StInt (toInteger size),
+                   StInt (toInteger size),
                    upd_code,
-                    rtbl,
-                    tag]
+                   rtbl,
+                   tag]
 
            BigTupleRep _ -> [
                tuple___rtbl,
@@ -124,19 +130,18 @@ genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
        closure_lbl     = closureLabelFromCI   cl_info
 
        sm_rep  = closureSMRep cl_info
-        maybe_selector = maybeSelectorInfo cl_info
-        is_selector = maybeToBool maybe_selector
-        (Just (_, select_word)) = maybe_selector
+       maybe_selector = maybeSelectorInfo cl_info
+       is_selector = maybeToBool maybe_selector
+       (Just (_, select_word)) = maybe_selector
 
        tag = StInt (toInteger (closureSemiTag cl_info))
 
        size    = if isSpecRep sm_rep
                  then closureNonHdrSize cl_info
-                 else hpRel target (closureSizeWithoutFixedHdr cl_info)
+                 else hpRelToInt (closureSizeWithoutFixedHdr cl_info)
        ptrs    = closurePtrsSize cl_info
 
-       upd_code = amodeToStix target upd
+       upd_code = amodeToStix upd
 
        info_unused = StInt (-1)
-
 \end{code}