More refactoring and moving code around
authorIan Lynagh <igloo@earth.li>
Wed, 23 Mar 2011 18:30:52 +0000 (18:30 +0000)
committerIan Lynagh <igloo@earth.li>
Wed, 23 Mar 2011 18:30:52 +0000 (18:30 +0000)
DirectCodegen.hs
Main.hs

index 3d479de..44c053b 100644 (file)
@@ -325,26 +325,35 @@ outTokenHs (Special pos key arg) =
         "enum"              -> outCLine pos++outEnum arg
         _                   -> outCLine pos++"    hsc_"++key++" ("++arg++");\n"
 
-outEnum :: String -> String
-outEnum arg =
+parseEnum :: String -> Maybe (String,String,[(Maybe String,String)])
+parseEnum arg =
     case break (== ',') arg of
-        (_, [])        -> ""
+        (_, [])        -> Nothing
         (t, _:afterT) -> case break (== ',') afterT of
             (f, afterF) -> let
-                enums []    = ""
+                enums []    = []
                 enums (_:s) = case break (== ',') s of
                     (enum, rest) -> let
                         this = case break (== '=') $ dropWhile isSpace enum of
-                            (name, []) ->
-                                "    hsc_enum ("++t++", "++f++", " ++
-                                "hsc_haskellize (\""++name++"\"), "++
-                                name++");\n"
-                            (hsName, _:cName) ->
-                                "    hsc_enum ("++t++", "++f++", " ++
-                                "printf (\"%s\", \""++hsName++"\"), "++
-                                cName++");\n"
-                        in this++enums rest
-                in enums afterF
+                            (name, []) -> (Nothing, name)
+                            (hsName, _:cName) -> (Just hsName, cName)
+                        in this:enums rest
+                in Just (t, f, enums afterF)
+
+outEnum :: String -> String
+outEnum arg = case parseEnum arg of
+    Nothing -> ""
+    Just (t,f,enums) ->
+        flip concatMap enums $ \(maybeHsName, cName) ->
+            case maybeHsName of
+               Nothing ->
+                    "    hsc_enum ("++t++", "++f++", " ++
+                    "hsc_haskellize (\""++cName++"\"), "++
+                    cName++");\n"
+               Just hsName ->
+                    "    hsc_enum ("++t++", "++f++", " ++
+                    "printf (\"%s\", \""++hsName++"\"), "++
+                    cName++");\n"
 
 outFlagH :: Flag -> String
 outFlagH (Include  f)          = "#include "++f++"\n"
diff --git a/Main.hs b/Main.hs
index 5cfd95b..d3b2893 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -109,6 +109,15 @@ main = do
         ((_:_), []) -> processFiles flags files usage
         (_,     _ ) -> die (concat errs ++ usage)
 
+getProgramName :: IO String
+getProgramName = liftM (`withoutSuffix` "-bin") getProgName
+   where str `withoutSuffix` suff
+            | suff `isSuffixOf` str = take (length str - length suff) str
+            | otherwise             = str
+
+bye :: String -> IO a
+bye s = putStr s >> exitWith ExitSuccess
+
 processFiles :: [Flag] -> [FilePath] -> String -> IO ()
 processFiles flags files usage = do
     mb_libdir <- getLibDir
@@ -177,15 +186,6 @@ processFiles flags files usage = do
 
     mapM_ (processFile flags_w_tpl compiler) files
 
-getProgramName :: IO String
-getProgramName = liftM (`withoutSuffix` "-bin") getProgName
-   where str `withoutSuffix` suff
-            | suff `isSuffixOf` str = take (length str - length suff) str
-            | otherwise             = str
-
-bye :: String -> IO a
-bye s = putStr s >> exitWith ExitSuccess
-
 processFile :: [Flag] -> FilePath -> String -> IO ()
 processFile flags compiler name
   = do let file_name = dosifyPath name