[project @ 1998-02-05 12:23:33 by simonm]

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

diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index 9f1747f..cb84530 100644 (file)
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -1,25 +1,30 @@
 %
-% (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
 
-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
+#include "HsVersions.h"
 
+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 Outputable      ( hcat, ptext, int, char )
 \end{code}
 
 Generating code for info tables (arrays of data).
@@ -37,73 +42,72 @@ 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 ->
-               let rtbl = uppBesides (
+               let rtbl = hcat (
                       if is_selector then
-                         [uppPStr SLIT("Select__"),
-                          uppInt select_word,
-                          uppPStr SLIT("_rtbl")]
+                         [ptext SLIT("Select__"),
+                          int select_word,
+                          ptext SLIT("_rtbl")]
                       else
-                         [uppPStr (case updatable of
+                         [ptext (case updatable of
                                    SMNormalForm -> SLIT("Spec_N_")
                                    SMSingleEntry -> SLIT("Spec_S_")
                                    SMUpdatable -> SLIT("Spec_U_")
-                                  ),
-                          uppInt size,
-                          uppChar '_',
-                          uppInt ptrs,
-                          uppPStr SLIT("_rtbl")])
-                in
+                                  ),
+                          int size,
+                          char '_',
+                          int ptrs,
+                          ptext SLIT("_rtbl")])
+               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 +128,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}