From cab564e400590cbd8a88e190fe381a74655005cf Mon Sep 17 00:00:00 2001
From: Marvin Borner
Date: Sat, 5 Mar 2022 18:14:28 +0100
Subject: Multiple file support for generating assembly

---
 src/Fun/Compiler.hs | 36 +++++++++++++++++++++++++-----------
 1 file changed, 25 insertions(+), 11 deletions(-)

(limited to 'src/Fun/Compiler.hs')

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
-- 
cgit v1.2.3