[make 'Requires' a simple set, include the calling convention with the requirements.
John Meacham <john@repetae.net>**20120212053838
 Ignore-this: b7fa6f8ece79c96073d8638a876456de
] hunk ./src/C/FFI.hs 14
-type CName    = String
-
-data CallConv = CCall | StdCall | CApi | Primitive | DotNet deriving(Eq,Ord,Show)
-    {-! derive: Binary !-}
+type CName = String
hunk ./src/C/FFI.hs 29
-    ffiExportCName :: CName,
-    ffiExportSafety :: Safety,
+    ffiExportCName    :: CName,
+    ffiExportSafety   :: Safety,
hunk ./src/C/FFI.hs 32
-    ffiExportArgTypes ::[ExtType],
+    ffiExportArgTypes :: [ExtType],
hunk ./src/C/FromGrin2.hs 127
-compileGrin :: Grin -> (LBS.ByteString,[String])
-compileGrin grin = (LBS.fromChunks code, snub (reqLibraries req))  where
+compileGrin :: Grin -> (LBS.ByteString,Requires)
+compileGrin grin = (LBS.fromChunks code, req)  where
hunk ./src/C/FromGrin2.hs 135
-        vcat includes,
hunk ./src/C/FromGrin2.hs 136
-        vcat cincludes,
+        vcat includes,
+--        vcat cincludes,
hunk ./src/C/FromGrin2.hs 150
-    nh_stuff = text "static const void * const nh_stuff[] = {" $$ fsep (punctuate (char ',') (cafnames ++ constnames ++ [text "NULL"]))  $$ text "};"
-    includes = map include (filter ((".h" ==) . takeExtension) $ snub $ reqIncludes req)
-    cincludes = map include (filter ((".c" ==) . takeExtension) $ snub $ reqIncludes req)
+    fromRequires (Requires s) = map (unpackPS . snd) (Set.toList s)
+    nh_stuff  = text "static const void * const nh_stuff[] = {" $$ fsep (punctuate (char ',') (cafnames ++ constnames ++ [text "NULL"]))  $$ text "};"
+    includes  = map include (filter ((".h" ==) . takeExtension)  $ fromRequires req)
+--    cincludes = map include (filter ((".c" ==) . takeExtension) $ fromRequires req)
hunk ./src/C/Prims.hs 7
+import qualified Data.Set as Set
hunk ./src/C/Prims.hs 16
-{-
-data PrimTypeType = PrimTypeIntegral | PrimTypeFloating | PrimTypePointer | PrimTypeVoid
-    deriving(Show,Eq,Ord)
hunk ./src/C/Prims.hs 17
-data PrimType = PrimType {
-    primTypeName :: ExtType,
-    primTypeType :: {-# UNPACK #-} !PrimTypeType,
-    primTypeAlignmentOf :: {-# UNPACK #-} !Int,
-    primTypeIsSigned :: {-# UNPACK #-} !Bool,
-    primTypeSizeOf :: {-# UNPACK #-} !Int
-    } deriving(Show)
--}
+data CallConv = CCall | StdCall | CApi | Primitive | DotNet 
+    deriving(Eq,Ord,Show)
+    {-! derive: Binary !-}
hunk ./src/C/Prims.hs 28
-    show (Requires [] []) = "()"
-    show (Requires xs ys) = show (xs,ys)
+    show (Requires s) = show (Set.toList s)
hunk ./src/C/Prims.hs 30
-data Requires = Requires {
-    reqIncludes :: [String],
-    reqLibraries :: [String]
-    } deriving(Eq, Ord)
-    {-! derive: Monoid, Binary !-}
+newtype Requires = Requires (Set.Set (CallConv,PackedString))
+    deriving(Eq,Ord,Monoid,Binary)
hunk ./src/C/Prims.hs 135
-parsePrimString s = do
-    ws@(_:_) <- return $ words s
-    let v = case last ws of
-            '&':s -> AddrOf { primConst = (packString s), primRequires = reqs }
-            s -> Func { funcName = (packString s), primArgTypes = [], primRetType = "", primRequires = reqs, primRetArgs = [] }
-        f opt@('-':'l':_) = Requires [] [opt]
-        f s = Requires [s] []
-        reqs = (mconcat (map f (init ws)))
-    return v
-
hunk ./src/FrontEnd/ParseUtils.hs 17
-	  splitTyConApp		-- HsType -> P (HsName,[HsType])
+	  splitTyConApp		-- HsType -> P (Name,[HsType])
hunk ./src/FrontEnd/ParseUtils.hs 21
-	, checkDataHeader	-- HsQualType -> P (HsContext,HsName,[HsName])
+	, checkDataHeader	-- HsQualType -> P (HsContext,Name,[Name])
hunk ./src/FrontEnd/ParseUtils.hs 26
-	, checkUnQual		-- HsQName -> P HsName
+	, checkUnQual		-- Name -> P Name
hunk ./src/FrontEnd/ParseUtils.hs 41
+import qualified Data.Set as Set
hunk ./src/FrontEnd/ParseUtils.hs 50
-
-type HsQName = HsName
+import PackedString
hunk ./src/FrontEnd/ParseUtils.hs 55
-splitTyConApp :: HsType -> P (HsName,[HsType])
+splitTyConApp :: HsType -> P (Name,[HsType])
hunk ./src/FrontEnd/ParseUtils.hs 58
-	split :: HsType -> [HsType] -> P (HsName,[HsType])
+	split :: HsType -> [HsType] -> P (Name,[HsType])
hunk ./src/FrontEnd/ParseUtils.hs 102
-checkDataHeader :: HsQualType -> P (HsContext,HsName,[HsName])
+checkDataHeader :: HsQualType -> P (HsContext,Name,[Name])
hunk ./src/FrontEnd/ParseUtils.hs 107
-checkSimple :: String -> HsType -> [HsName] -> P ((HsName,[HsName]))
+checkSimple :: String -> HsType -> [Name] -> P ((Name,[Name]))
hunk ./src/FrontEnd/ParseUtils.hs 113
-checkInstHeader :: HsQualType -> P (HsContext,HsQName,[HsType])
+checkInstHeader :: HsQualType -> P (HsContext,Name,[HsType])
hunk ./src/FrontEnd/ParseUtils.hs 118
-checkInsts :: HsType -> [HsType] -> P ((HsQName,[HsType]))
+checkInsts :: HsType -> [HsType] -> P ((Name,[HsType]))
hunk ./src/FrontEnd/ParseUtils.hs 299
-isFunLhs :: HsExp -> [HsExp] -> Maybe (HsName, [HsExp])
+isFunLhs :: HsExp -> [HsExp] -> Maybe (Name, [HsExp])
hunk ./src/FrontEnd/ParseUtils.hs 324
-checkUnQual :: HsQName -> P HsName
+checkUnQual :: Name -> P Name
hunk ./src/FrontEnd/ParseUtils.hs 379
-sameFun :: HsName -> HsDecl -> Bool
+sameFun :: Name -> HsDecl -> Bool
hunk ./src/FrontEnd/ParseUtils.hs 383
-doForeign :: Monad m => SrcLoc -> [HsName] -> Maybe (String,HsName) -> HsQualType -> m HsDecl
+doForeign :: Monad m => SrcLoc -> [Name] -> Maybe (String,Name) -> HsQualType -> m HsDecl
hunk ./src/FrontEnd/ParseUtils.hs 395
-                im <- parseImport mstring vname
+                im <- parseImport conv mstring vname
+                conv <- return (if conv == CApi then CCall else conv)
hunk ./src/FrontEnd/ParseUtils.hs 406
-        g s _  ("capi":rs)  = g s CCall rs
+        g s _  ("capi":rs)  = g s CApi rs
hunk ./src/FrontEnd/ParseUtils.hs 411
-doForeignEq :: Monad m => SrcLoc -> [HsName] -> Maybe (String,HsName) -> HsQualType -> HsExp -> m HsDecl
+doForeignEq :: Monad m => SrcLoc -> [Name] -> Maybe (String,Name) -> HsQualType -> HsExp -> m HsDecl
hunk ./src/FrontEnd/ParseUtils.hs 416
-parseExport :: Monad m => String -> HsName -> m String
+parseExport :: Monad m => String -> Name -> m String
hunk ./src/FrontEnd/ParseUtils.hs 423
-parseImport :: Monad m => Maybe String -> HsName -> m FfiType
-parseImport Nothing hn = return $ Import (show hn) mempty
-parseImport (Just cn) hn =
+parseImport :: Monad m => CallConv -> Maybe String -> Name -> m FfiType
+parseImport _ Nothing hn = return $ Import (show hn) mempty
+parseImport cc (Just cn) hn =
hunk ./src/FrontEnd/ParseUtils.hs 430
-      ("static":xs) -> parseIS [] [] xs
-      xs            -> parseIS [] [] xs
+      ("static":xs) -> parseIS cc xs
+      xs            -> parseIS cc xs
hunk ./src/FrontEnd/ParseUtils.hs 433
-parseIS a b ['&':n] | isCName n = return $ ImportAddr n $ Requires a b
-parseIS a b [n]     | isCName n = return $ Import     n $ Requires a b
-parseIS a b ["&",n] | isCName n = return $ ImportAddr n $ Requires a b
-parseIS a b (('-':'l':l):r)     = parseIS a (l:b) r
-parseIS a b (i:r)               = parseIS (i:a) b r
-parseIS _ _ x                   = fail ("Syntax error parsing foreign import: "++show x)
+parseIS cc rs = f Set.empty rs where
+    f s ['&':n] | isCName n = return $ ImportAddr n $ Requires s
+    f s [n]     | isCName n = return $ Import     n $ Requires s
+    f s ["&",n] | isCName n = return $ ImportAddr n $ Requires s
+    f s (i:r)               = f (Set.insert (cc,packString i) s) r
+    f s x                   = fail ("Syntax error parsing foreign import: "++show x)
hunk ./src/Grin/Main.hs 4
+import Data.List
hunk ./src/Grin/Main.hs 7
-import System.Process
hunk ./src/Grin/Main.hs 11
+import qualified Data.Set as Set
hunk ./src/Grin/Main.hs 15
+import C.Prims
hunk ./src/Grin/Main.hs 29
+import PackedString
hunk ./src/Grin/Main.hs 89
-    let (cg,rls) = FG2.compileGrin grin
+    let (cg,Requires reqs) = FG2.compileGrin grin
+        rls = filter ("-l" `isPrefixOf`) $ map (unpackPS . snd) (Set.toList reqs)
hunk ./src/Grin/Main.hs 112
-    let comm = shellQuote $ [cc] ++ ["-o", fn, cf] ++ args ++ (map ("-l" ++) rls) ++ extraCFiles
+    let comm = shellQuote $ [cc] ++ ["-o", fn, cf] ++ args ++ rls ++ extraCFiles