Multiple file support for generating assembly

5 files changed, 55 insertions, 14 deletions

diff --git a/src/Fun/Compiler.hs b/src/Fun/Compiler.hs
index 6a4f8e1..563f039 100644
--- a/src/Fun/Compiler.hs
+++ b/src/Fun/Compiler.hs
@@ -1,12 +1,15 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module Fun.Compiler where
 
 import           Control.Exception
+import           Fun.Generator
 import           Fun.Grammar
 import           Fun.Parser
 import           Fun.Syntax
 import           Fun.Tree
 import           System.Exit
 import           System.IO
+import           Text.Read
 
 traceBranch :: Int -> Trace -> String
 traceBranch c (StringTrace t) = "\n" ++ (replicate c ' ') ++ t
@@ -24,8 +27,8 @@ traceTree c ts = foldr join "" $ map (traceBranch c) ts
 genTrace :: [Trace] -> String
 genTrace ts = "Trace of expectance:\n" ++ traceTree 0 ts
 
-parse :: String -> Either String Tree
-parse s = case tree s of
+parse :: String -> Either String Program
+parse s = case program s of
   Left a -> Left $ "Parse error!\n" ++ case a of
     State [] Nothing    -> "No context available"
     State t  Nothing    -> genTrace t
@@ -40,13 +43,24 @@ check t = case checkTree t of
  where
   join = foldr (\(SyntaxError a) b -> a ++ if b == "" then b else "\n" ++ b) ""
 
-compile :: String -> IO ()
-compile path = do
-  file <- try $ readFile path
-  case file of
+generate :: Tree -> Either String String
+generate t = case generateAsm t of
+  Left  (GenerateError a) -> Left $ "Error while generating ASM!\n" ++ a
+  Right a                 -> Right a
+
+failExit :: String -> IO ()
+failExit err = do
+  hPutStrLn stderr err
+  exitWith (ExitFailure 1)
+
+compile :: [String] -> IO ()
+compile paths = do
+  files <- sequence
+    $ map (\p -> try $ readFile p :: IO (Either IOError String)) paths
+  case sequence files of -- TODO: Improve this left/right chain
     Left  exception -> print (exception :: IOError)
-    Right file      -> case parse file >>= check of
-      Left err -> do
-        hPutStrLn stderr err
-        exitWith (ExitFailure 1)
-      Right block -> putStrLn . show $ block
+    Right files     -> case sequence $ map parse files of
+      Left  err -> failExit err
+      Right ps  -> case check (Tree ps) >>= generate of
+        Left  err -> failExit err
+        Right gen -> putStrLn gen
diff --git a/src/Fun/Generator.hs b/src/Fun/Generator.hs
new file mode 100644
index 0000000..17f47e3
--- /dev/null
+++ b/src/Fun/Generator.hs
@@ -0,0 +1,13 @@
+module Fun.Generator where
+
+import           Fun.Tree
+import           Fun.Typer
+
+-- TODO: 'Merge' syntax for danger-asm: _merge (_asm ..) main (_asm ..)
+
+data GenerateError = GenerateError String
+
+generateAsm :: Tree -> Either GenerateError String
+-- generateAsm (Tree t) = Right $ show t
+generateAsm t =
+  Left $ GenerateError $ show $ getFunction t "_start" [InternalType "_void"]
diff --git a/src/Fun/Syntax.hs b/src/Fun/Syntax.hs
index c426a03..1c4846c 100644
--- a/src/Fun/Syntax.hs
+++ b/src/Fun/Syntax.hs
@@ -10,7 +10,7 @@ mergeSyntax :: [Either [SyntaxError] a] -> ([a] -> b) -> Either [SyntaxError] b
 mergeSyntax d c | any isLeft d = Left $ concat $ lefts d
                 | otherwise    = Right $ c $ rights d
 
--- TODO: Disallow same declarations in entire tree (w/o visibility)
+-- TODO: Overloading only if first element is different
 
 checkFunctionArity :: Block -> Either [SyntaxError] Block
 checkFunctionArity (FunctionBlock decl defns) =
diff --git a/src/Fun/Tree.hs b/src/Fun/Tree.hs
index 26b415f..817a077 100644
--- a/src/Fun/Tree.hs
+++ b/src/Fun/Tree.hs
@@ -26,10 +26,12 @@ data Block = FunctionBlock
   } -- | DataBlock .. TODO
   deriving Show
 
+type FunctionSignature = [Type]
+
 data FunctionDeclaration = FunctionDeclaration
   { dName       :: String
   , dVisibility :: Visibility
-  , dTypes      :: [Type]
+  , dTypes      :: FunctionSignature
   , dFlags      :: [FunctionFlag]
   }
   deriving Show
@@ -55,3 +57,15 @@ data FunctionBody = FunctionBody
 
 data FunctionBodyElement = Statement String | FunctionBodyIdentifier String | FunctionBodyParameter String | FunctionBodyString String | FunctionBodyNumber Integer
   deriving Show
+
+----
+
+-- TODO: This can be optimized
+getFunction :: Tree -> String -> FunctionSignature -> Maybe Block
+getFunction (Tree ps) f sig =
+  let fromProgram (Program bs) =
+        filter (\b -> (dName . bDecl) b == f && (dTypes . bDecl) b == sig) bs
+      fromTree = filter (\b -> length b == 1) (map fromProgram ps)
+  in  case fromTree of
+        [[f]] -> Just f
+        _     -> Nothing
diff --git a/src/Fun/Typer.hs b/src/Fun/Typer.hs
index 5d636f8..656d56b 100644
--- a/src/Fun/Typer.hs
+++ b/src/Fun/Typer.hs
@@ -1,7 +1,7 @@
 module Fun.Typer where
 
 data Type = UnknownType | NormalType String | InternalType String | ListType Type
-  deriving Show
+  deriving (Show, Eq)
 -- TODO: Struct (like 'data' with mutiple), Union (like 'data' with '|')
 
 -- TODO: Handle primary types as normal non-primary types?