First batch of update following code review.

Author: pschachte

src/AST.hs

@@ -134,7 +134,7 @@ module AST (
 
 import           Config (magicVersion, wordSize, objectExtension,
                          sourceExtension, currentModuleAlias,
-                         specialChar, specialName, specialName2, wordSizeBytes,)
+                         specialChar, specialName, specialName2, wordSizeBytes,byteBits)
 import           Control.Monad
 import           Control.Monad.Extra
 import           Control.Monad.Trans (lift,liftIO)
@@ -3542,11 +3542,11 @@ constValueSize (GenericStructMember _) = wordSizeBytes
 
 -- | Return the representation of a StructMember
 constValueRepresentation :: ConstValue -> TypeRepresentation
-constValueRepresentation (IntStructMember _ size) = Bits $ size * 8
-constValueRepresentation (FloatStructMember _ size) = Floating $ size * 8
+constValueRepresentation (IntStructMember _ size) = Bits $ size * byteBits
+constValueRepresentation (FloatStructMember _ size) = Floating $ size * byteBits
 constValueRepresentation (PointerStructMember _) = Pointer
 constValueRepresentation (FnPointerStructMember _) = CPointer
-constValueRepresentation (UndefStructMember size) = Bits $ size * 8
+constValueRepresentation (UndefStructMember size) = Bits $ size * byteBits
 constValueRepresentation (GenericStructMember _) = Pointer
 
 

src/BodyBuilder.hs

@@ -17,7 +17,7 @@ import AST
 import Debug.Trace
 import Snippets ( boolType, intType, primMove )
 import Util
-import Config (minimumSwitchCases, wordSize, wordSizeBytes)
+import Config (minimumSwitchCases, wordSize, wordSizeBytes, byteBits)
 import Options (LogSelection(BodyBuilder))
 import Data.Char ( ord )
 import Data.Map as Map
@@ -278,7 +278,7 @@ potentialConstStruct var size = do
                     Map.insert var (newBlock size) $ constStructs st}
 
 
--- | Does the specified variable hold a constant structure?
+-- | Delete a constant structure record from the BodyBuilder monad.
 deleteConstStruct :: PrimVarName -> BodyBuilder ()
 deleteConstStruct var = do
     logBuild $ "Deleting constant structure " ++ show var
@@ -692,7 +692,7 @@ typeSize :: TypeSpec -> BodyBuilder Int
 typeSize ty = do
     rep <- trustFromJust ("lookupTypeRepresentation of " ++ show ty)
             <$> lift (lookupTypeRepresentation ty)
-    return $ 1 + ((typeRepSize rep - 1) `div` 8)
+    return $ 1 + ((typeRepSize rep - 1) `div` byteBits)
 
 
 -- Do the normal work of instr.  First check if we've already computed its

src/Config.hs

@@ -12,7 +12,7 @@ module Config (sourceExtension, objectExtension, executableExtension,
                bitcodeExtension, assemblyExtension, nativeAssemblyExtension,
                archiveExtension, moduleDirectoryBasename, currentModuleAlias,
                specialChar, specialName, specialName2, initProcName,
-               wordSize, wordSizeBytes,
+               wordSize, wordSizeBytes, byteBits,
                availableTagBits, tagMask, smallestAllocatedAddress,
                minimumSwitchCases, magicVersion,
                linkerDeadStripArgs, removeLPVMSection,
@@ -102,14 +102,19 @@ initProcName = ""
 
 -- |Determining word size of the machine in bits
 wordSize :: Int
-wordSize = wordSizeBytes * 8
+wordSize = wordSizeBytes * byteBits
 
 
 -- |Word size of the machine in bytes
 wordSizeBytes :: Int
 wordSizeBytes = sizeOf (3 :: Word)
 
 
+-- |Size of a byte in bits
+byteBits :: Int
+byteBits = 8
+
+
 -- |The number of tag bits available on this architecture.  This is the base 2
 --  log of the word size in bytes, assuming this is a byte addressed machine.
 --  XXX this would need to be fixed for non-byte addressed architectures.

src/LLVM.hs

@@ -331,10 +331,10 @@ argConstValue :: PrimArg -> LLVM (Maybe ConstValue)
 argConstValue ArgVar{} = return Nothing
 argConstValue (ArgInt n ty) = do
     sz <- typeRepSize <$> lift (typeRepresentation ty)
-    return $ Just $ IntStructMember n (sz `div` 8)
+    return $ Just $ IntStructMember n (sz `div` byteBits)
 argConstValue (ArgFloat n ty) = do
     sz <- typeRepSize <$> lift (typeRepresentation ty)
-    return $ Just $ FloatStructMember n (sz `div` 8)
+    return $ Just $ FloatStructMember n (sz `div` byteBits)
 argConstValue ArgClosure{} = return Nothing -- const closures already handled
 argConstValue (ArgGlobal info _) = do
     -- XXX is ArgGlobal a constant?  Does it give the address, or value, of the
@@ -345,7 +345,7 @@ argConstValue (ArgConstRef structID _) = do
 argConstValue ArgUnneeded{} = return Nothing
 argConstValue (ArgUndef ty) = do
     sz <- typeRepSize <$> lift (typeRepresentation ty)
-    return $ Just $ UndefStructMember (sz `div` 8)
+    return $ Just $ UndefStructMember (sz `div` byteBits)
 
 
 -- | If needed, add an extern declaration for a prim to the set.
@@ -472,38 +472,6 @@ writeAssemblyConstants = do
 -- declared and recorded.  This will happen because sets are sorted
 -- alphabetically, and CString comes before WybeString.
 writeConstDeclaration :: StructID -> LLVM ()
--- writeConstDeclaration spec@(WybeStringSpec str) n = do
---     -- let stringName = specialName2 "string" $ show n
---     -- modify $ \s -> s { constNames=Map.insert spec stringName
---     --                                    $ constNames s}
---     cStringID <- lift $ recordConstStruct $ CStringInfo str
---     writeConstDeclaration (StructSpec cStringID) n
---     wStringID <- lift $ recordConstStruct $ StructInfo
---          [ IntStructMember (fromIntegral $ length str) wordSize
---          , PointerStructMember cStringID]
---     writeConstDeclaration (StructSpec wStringID) n
---     -- return ()
--- writeConstDeclaration spec@(CStringSpec str) n = do
---     -- let textName = specialName2 "cstring" $ show n
---     cStringID <- lift $ recordConstStruct $ CStringInfo str
---     writeConstDeclaration (StructSpec cStringID) n
---     -- modify $ \s -> s { constNames=Map.insert spec textName
---     --                                    $ constNames s}
---     -- declareStringConstant textName str Nothing
--- writeConstDeclaration spec@(ClosureSpec pspec args) n = do
---     -- let closureName = specialName2 "closure" $ show n
---     -- modify $ \s -> s { constNames=Map.insert spec closureName $ constNames s}
---     let pname = show pspec
---     -- argReps <- mapM argTypeRep args
---     -- declareStructConstant closureName
---     --     ((ArgGlobal (GlobalVariable pname) (Representation CPointer), CPointer)
---     --      : zip args argReps)
---     --     Nothing
---     constArgs <- mapM argStructMember args
---     closureID <- lift $ recordConstStruct
---                     $ StructInfo (GlobalNameMember pname : constArgs )
---     writeConstDeclaration (StructSpec closureID) n
-
 writeConstDeclaration structID = do
     info <- trustFromJust ("writeConstDeclaration of " ++ show structID)
             <$> lift (lookupConstInfo structID)
@@ -816,12 +784,9 @@ writeWybeCall wybeProc args pos = do
 
 -- | Generate a Wybe proc call instruction, or defer it if necessary.
 writeHOCall :: PrimArg -> [PrimArg] -> OptPos -> LLVM ()
-writeHOCall (ArgClosure pspec closed _) args pos = do
-    -- NB:  this case doesn't seem to ever occur -- probably handled earlier
-    pspec' <- fromMaybe pspec <$> lift (maybeGetClosureOf pspec)
-    logLLVM $ "Compiling HO call as first order call to " ++ show pspec'
-              ++ " closed over " ++ show closed
-    writeWybeCall pspec' (closed ++ args) pos
+writeHOCall closure@(ArgClosure pspec closed _) args pos = do
+    -- NB:  this case should have been handled earlier
+    shouldnt $ "Higher order call with constand closure should have been handled earlier: " ++ show closure
 writeHOCall closure args pos = do
     (ins,outs,oRefs,iRefs) <- partitionArgsWithRefs $ closure:args
     unless (List.null oRefs && List.null iRefs)

src/Normalise.hs

@@ -13,7 +13,7 @@ module Normalise (normalise, normaliseItem, completeNormalisation) where
 
 import AST
 import Config (wordSize, wordSizeBytes, availableTagBits,
-               tagMask, smallestAllocatedAddress, currentModuleAlias, specialName2, specialName, initProcName)
+               tagMask, smallestAllocatedAddress, currentModuleAlias, specialName2, specialName, initProcName, byteBits)
 import Control.Monad
 import Control.Monad.State (gets)
 import Control.Monad.Trans (lift,liftIO)
@@ -643,7 +643,7 @@ layoutRecord paramInfos tag tagLimit =
     let sizes = (2^) <$> [0..floor $ logBase 2 $ fromIntegral wordSizeBytes]
         fields = List.map
                 (\(CtorParamInfo param anon rep sz) ->
-                    let byteSize = (sz + 7) `div` 8
+                    let byteSize = (sz + 7) `div` byteBits
                         wordSize = (byteSize + wordSizeBytes - 1)
                                     `div` wordSizeBytes * wordSizeBytes
                         alignment =

src/c_config.c

@@ -8,8 +8,7 @@
  *  Generate Haskell source code defining Wybe interpretation of standard
  *  C types.
  * 
- * NB:  This code assumes a byte-addressed architecture, and that a byte
- *      is 8 bits.
+ * NB:  This code assumes a byte-addressed architecture.
  **/
 
 #include <stdio.h>
@@ -23,17 +22,18 @@ int main() {
     printf("-- AUTOMATICALLY GENERATED BY c_config.c\n-- DO NOT EDIT!\n\n");
     printf("-- Purpose : Relate C types to Wybe types for foreign interface\n\n");
     printf("module CConfig (cTypeRepresentation, cPointerSize) where\n");
-    printf("\nimport AST (TypeRepresentation(..))\n\n");
+    printf("\nimport AST (TypeRepresentation(..))\n");
+    printf("import Config (byteBits)\n\n");
     printf("cTypeRepresentation :: String -> Maybe TypeRepresentation\n");
-    printf("cTypeRepresentation \"int\" = Just $ Signed %lu\n", 8*sizeof(i));
-    printf("cTypeRepresentation \"float\" = Just $ Floating %lu\n", 8*sizeof(f));
-    printf("cTypeRepresentation \"double\" = Just $ Floating %lu\n", 8*sizeof(d));
-    printf("cTypeRepresentation \"char\" = Just $ Bits %lu\n", 8*sizeof(c));
-    printf("cTypeRepresentation \"pointer\" = Just $ CPointer\n");
+    printf("cTypeRepresentation \"int\" = Just $ Signed $ byteBits*%lu\n", sizeof(i));
+    printf("cTypeRepresentation \"float\" = Just $ Floating $ byteBits*%lu\n", sizeof(f));
+    printf("cTypeRepresentation \"double\" = Just $ Floating $ byteBits*%lu\n", sizeof(d));
+    printf("cTypeRepresentation \"char\" = Just $ Bits $ byteBits*%lu\n", sizeof(c));
+    printf("cTypeRepresentation \"pointer\" = Just CPointer\n");
     printf("cTypeRepresentation \"void\" = Just $ Bits 0\n");
     printf("cTypeRepresentation \"intrinsic_bool\" = Just $ Bits 1\n");
     printf("cTypeRepresentation other = Nothing\n\n");
     printf("cPointerSize :: Int\n");
-    printf("cPointerSize = %lu\n", 8*sizeof(p));
+    printf("cPointerSize = byteBits*%lu\n", sizeof(p));
     return 0;
 }