diff options
author | Joe Crayne <joe@jerkface.net> | 2018-11-23 18:30:43 -0500 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-11-23 18:37:13 -0500 |
commit | 5011839455292f2eadc0b172006544214d0a9ba9 (patch) | |
tree | 000ea7fe0f4612c55a5ad74d4f5d89c2635d74ec | |
parent | 6979c8ddda1cf2e4403f447444fe2783cf8c51af (diff) |
Allow providing extra c modules during link.
-rw-r--r-- | c2haskell.hs | 17 |
1 files changed, 9 insertions, 8 deletions
diff --git a/c2haskell.hs b/c2haskell.hs index ed287cf..ce33666 100644 --- a/c2haskell.hs +++ b/c2haskell.hs | |||
@@ -787,15 +787,15 @@ sanitizeArgs ("-o":args) = sanitizeArgs $ drop 1 args | |||
787 | sanitizeArgs (arg:args) = arg : sanitizeArgs args | 787 | sanitizeArgs (arg:args) = arg : sanitizeArgs args |
788 | sanitizeArgs [] = [] | 788 | sanitizeArgs [] = [] |
789 | 789 | ||
790 | usage :: [String] -> Maybe (C2HaskellOptions, [String], FilePath) | 790 | usage :: [String] -> Maybe (C2HaskellOptions, [String], [FilePath]) |
791 | usage args = do | 791 | usage args = |
792 | let fname = last args | ||
793 | case break (=="--") args of | 792 | case break (=="--") args of |
794 | (targs,_:cargs0) -> do | 793 | (targs,_:cargs0) -> do |
795 | let opts = init cargs0 | 794 | let (rfs,ropts) = span (".c" `isSuffixOf`) cargs0 |
795 | opts = reverse ropts | ||
796 | cargs = (sanitizeArgs opts) | 796 | cargs = (sanitizeArgs opts) |
797 | hopts = parseOptions targs defopts | 797 | hopts = parseOptions targs defopts |
798 | return (hopts,cargs,fname) | 798 | return (hopts,cargs,rfs) |
799 | _ -> Nothing | 799 | _ -> Nothing |
800 | 800 | ||
801 | (<&>) :: Functor f => f a -> (a -> b) -> f b | 801 | (<&>) :: Functor f => f a -> (a -> b) -> f b |
@@ -821,6 +821,7 @@ missingSymbols s = uniq $ do | |||
821 | 821 | ||
822 | linker :: [String] -> String -> IO [String] | 822 | linker :: [String] -> String -> IO [String] |
823 | linker cargs fname = do | 823 | linker cargs fname = do |
824 | print (cargs,fname) | ||
824 | (hin,hout,Just herr,hproc) <- createProcess (proc "gcc" $ cargs ++ [fname]) | 825 | (hin,hout,Just herr,hproc) <- createProcess (proc "gcc" $ cargs ++ [fname]) |
825 | { std_err = CreatePipe } | 826 | { std_err = CreatePipe } |
826 | linkerrs <- hGetContents herr | 827 | linkerrs <- hGetContents herr |
@@ -866,9 +867,9 @@ main :: IO () | |||
866 | main = do | 867 | main = do |
867 | self <- getProgName | 868 | self <- getProgName |
868 | args <- getArgs | 869 | args <- getArgs |
869 | let usageString = self ++ " [-v] [-p] [-f <sym>] -- [gcc options] <cfile>" | 870 | let usageString = self ++ " [--cpp | -p | -t ] [-v] [-f <sym>] -- [gcc options] [modules] <cfile>" |
870 | let m = usage args | 871 | let m = usage args |
871 | fromMaybe (putStrLn usageString) $ m <&> \(hopts,cargs,fname) -> do | 872 | fromMaybe (putStrLn usageString) $ m <&> \(hopts,cargs,fname:fs) -> do |
872 | prer <- runPreprocessor (newGCC "gcc") (rawCppArgs cargs fname) | 873 | prer <- runPreprocessor (newGCC "gcc") (rawCppArgs cargs fname) |
873 | let r = do | 874 | let r = do |
874 | pre <- left Left $ prer | 875 | pre <- left Left $ prer |
@@ -888,5 +889,5 @@ main = do | |||
888 | -> do | 889 | -> do |
889 | putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) . snd <$> r | 890 | putStrLn $ ppShow $ everywhere (mkT eraseNodeInfo) . snd <$> r |
890 | _ -> do | 891 | _ -> do |
891 | syms <- linker cargs fname | 892 | syms <- linker (cargs ++ reverse fs) fname |
892 | either print (uncurry $ c2haskell hopts cs syms) r | 893 | either print (uncurry $ c2haskell hopts cs syms) r |