Better project layout, removed warnings

9 files changed, 49 insertions, 120 deletions

diff --git a/src/Main.hs b/src/Main.hs
deleted file mode 100644
index 6e57ba4..0000000
--- a/src/Main.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-module Main where
-
-import Compiler
-import Control.Monad (when)
-import Control.Monad.State (evalState)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
-import Error (showErrorList, showParserError)
-import Lexer (scan)
-import Parser (parse, parseFromFile)
-import System.Console.GetOpt
-import System.Environment (getProgName)
-import System.Environment.Blank (getArgs)
-import System.Exit (exitFailure, exitSuccess)
-import System.IO (hPutStr, hPutStrLn, stderr, stdout)
-
-version = "0.1.0"
-
-data Options = Options
-  { optParse :: Bool,
-    optHelp :: Bool,
-    optVersion :: Bool
-  }
-
-defOptions =
-  Options
-    { optParse = False,
-      optHelp = False,
-      optVersion = False
-    }
-
-options :: [OptDescr (Options -> Options)]
-options =
-  [ Option
-      ['p']
-      ["parse"]
-      (NoArg (\opts -> opts {optParse = True}))
-      "only parse, reporting any errors",
-    Option
-      ['h']
-      ["help"]
-      (NoArg (\opts -> opts {optHelp = True}))
-      "show help",
-    Option
-      ['v']
-      ["version"]
-      (NoArg (\opts -> opts {optVersion = True}))
-      "output version and exit"
-  ]
-
-usage :: String -> [String] -> IO ()
-usage progName errs
-  | null errs = do
-      putStrLn helpText
-      exitSuccess
-  | otherwise = do
-      hPutStrLn stderr ("error: " ++ concat errs ++ "Try " ++ progName ++ " -h for more information.")
-      exitFailure
-  where
-    header =
-      "Usage: "
-        ++ progName
-        ++ " [OPTION...] file"
-    helpText =
-      usageInfo header options
-
-compileFile :: String -> Bool -> IO ()
-compileFile filename onlyParse = do
-  res <- parseFromFile (scan parse) filename
-  case res of
-    Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
-    Right ast -> do
-      res <- return $ evalState (compileAll ast) startState
-      case res of
-        Right _ -> if onlyParse then exitSuccess else print ast
-        Left errs -> hPutStr stderr (showErrorList errs) >> exitFailure
-
-main :: IO ()
-main = do
-  progName <- getProgName
-  argv <- getArgs
-  case getOpt Permute options argv of
-    (o, n, []) ->
-      do
-        when (optHelp opts) $ usage progName []
-        when (optVersion opts) $ putStrLn (progName ++ " " ++ version) >> exitSuccess
-        case n of
-          [filename] -> compileFile filename $ optParse opts
-          _ -> usage progName []
-      where
-        opts = foldl (flip id) defOptions o
-    (_, _, errs) -> usage progName errs
diff --git a/src/Micro.hs b/src/Micro.hs
new file mode 100644
index 0000000..c2c4f35
--- /dev/null
+++ b/src/Micro.hs
@@ -0,0 +1,16 @@
+module Micro
+  ( module Micro.Ast,
+    module Micro.Error,
+    module Micro.Env,
+    module Micro.Lexer,
+    module Micro.Parser,
+    module Micro.Compiler,
+  )
+where
+
+import Micro.Ast
+import Micro.Compiler
+import Micro.Env
+import Micro.Error
+import Micro.Lexer
+import Micro.Parser
diff --git a/src/Micro/Asm/Sdcc.hs b/src/Micro/Asm/Sdcc.hs
new file mode 100644
index 0000000..60a2caf
--- /dev/null
+++ b/src/Micro/Asm/Sdcc.hs
@@ -0,0 +1 @@
+module Micro.Asm.Sdcc where
diff --git a/src/Ast.hs b/src/Micro/Ast.hs
index 4f4a2f9..45697de 100644
--- a/src/Ast.hs
+++ b/src/Micro/Ast.hs
@@ -1,4 +1,4 @@
-module Ast where
+module Micro.Ast where
 
 import Data.List (intercalate)
 import Text.Parsec (SourcePos)
diff --git a/src/Compiler.hs b/src/Micro/Compiler.hs
index f895613..90e710b 100644
--- a/src/Compiler.hs
+++ b/src/Micro/Compiler.hs
@@ -1,14 +1,12 @@
-module Compiler where
+module Micro.Compiler where
 
-import qualified Ast as A
 import Control.Monad.State
 import Data.Either (rights)
 import Data.Maybe (catMaybes, fromMaybe)
-import Env
-import Error
-import System.Environment (getEnv, getEnvironment)
-import Text.Parsec (ParseError, SourcePos)
-import Text.Read (Lexeme (String))
+import qualified Micro.Ast as A
+import Micro.Env
+import Micro.Error
+import Text.Parsec (SourcePos)
 
 type CompState = (Env, [Error])
 
@@ -95,6 +93,7 @@ typecheckBinOp a b pos = do
     _ -> return $ Right Nothing -- error resolving left
 
 -- built-in types
+types :: [String]
 types = ["bool", "u8", "s8", "u16", "s16"]
 
 definedType :: A.Type -> Bool
@@ -120,14 +119,14 @@ verifyFuncType ident params ret pos = do
 compile :: A.Expr -> State CompState CompResult
 compile x = do
   case x of
-    (A.Module name pos) -> return $ Right Nothing
+    (A.Module _ _) -> return $ Right Nothing
     (A.Num _ _) -> return $ Right $ Just $ A.Type "u8" -- TODO: placeholder
     (A.Bool' _ _) -> return $ Right $ Just $ A.Type "bool"
     (A.BinOp A.Assign pos a@(A.Variable _ _) b) ->
       typecheckBinOp a b pos
-    (A.BinOp A.Assign pos _ b) ->
+    (A.BinOp A.Assign pos _ _) ->
       addError $ Error InvalidTarget "invalid assignment target" pos
-    (A.BinOp op pos a b) ->
+    (A.BinOp _ pos a b) ->
       -- TODO: types and invalid operators
       typecheckBinOp a b pos
     (A.Func ident params ret body priv anon pos) -> do
@@ -147,7 +146,7 @@ compile x = do
       -- helper for return
       nev <- return $ addSym nev ("$fn$", ftype, True, pos)
       put (nev, errs)
-      r <- compileAll body
+      _ <- compileAll body
       (_, errs) <- get
       -- store updated errors and the env with the function
       put (ev, errs)
@@ -178,23 +177,23 @@ compile x = do
         Just err -> addError $ Error TypeError err pos
         Nothing -> return $ Right $ Just typ
     (A.Return value pos) -> do
-      (ev, errs) <- get
+      (ev, _) <- get
       case getSyml ev "$fn$" of
-        Nothing -> addError $ Error UnexpectedReturn "return without function call" pos
         Just (_, A.FuncType _ rtyp, _, _) -> do
           r <- typecheckReturn value rtyp
           case r of
             Just err -> addError $ Error TypeError err pos
             Nothing -> return $ Right rtyp
+        _ -> addError $ Error UnexpectedReturn "return without function call" pos
     (A.Variable ident pos) -> do
-      (ev, errs) <- get
+      (ev, _) <- get
       case getSym ev ident of
         Just (_, t, _, _) -> return $ Right $ Just t
         Nothing -> addError $ Error Undefined ("undefined variable \"" ++ ident ++ "\"") pos
 
 compileAll :: [A.Expr] -> State CompState CompResult
 compileAll (x : xs) = do
-  compile x
+  _ <- compile x
   compileAll xs
 compileAll [] = do
   (_, errs) <- get
diff --git a/src/Env.hs b/src/Micro/Env.hs
index 5433de0..4174158 100644
--- a/src/Env.hs
+++ b/src/Micro/Env.hs
@@ -1,9 +1,9 @@
-module Env where
+module Micro.Env where
 
-import qualified Ast as A
 import qualified Data.Map as Map
 import Data.Maybe (isJust)
-import Error
+import qualified Micro.Ast as A
+import Micro.Error
 import Text.Parsec (SourcePos)
 
 type Sym = (A.Ident, A.Type, Bool, SourcePos)
@@ -12,6 +12,7 @@ type SymMap = Map.Map A.Ident Sym
 
 data Env = Env SymMap (Maybe Env) deriving (Show)
 
+emptyEnv :: Env
 emptyEnv = Env Map.empty Nothing
 
 -- | @getSymB local env ident@ checks @local@ parameter to tell if we look on
@@ -46,7 +47,7 @@ existsSyml env sym = isJust $ getSyml env sym
 addSym :: Env -> Sym -> Env
 addSym env@(Env m parent) sym@(id, _, _, _) = case getSym env id of
   Nothing -> Env (Map.insert id sym m) parent
-  Just s -> Env (Map.singleton id sym) $ Just env
+  Just _ -> Env (Map.singleton id sym) $ Just env
 
 -- | @addEnv e@ adds a new local environment using @e@ as parent.
 addEnv :: Env -> Env
diff --git a/src/Error.hs b/src/Micro/Error.hs
index d128d32..ced1318 100644
--- a/src/Error.hs
+++ b/src/Micro/Error.hs
@@ -1,4 +1,4 @@
-module Error where
+module Micro.Error where
 
 import Data.List (sort)
 import Text.Parsec (SourcePos, errorPos)
@@ -25,9 +25,9 @@ instance Show Error where
     show pos ++ " error: " ++ message
 
 showParserError :: ParseError -> String
-showParserError error =
-  show (errorPos error) ++ " error: syntax error"
-    ++ showErrorMessages "or" "unknown parser error" "  expected:" "     found:" "end of input" (errorMessages error)
+showParserError err =
+  show (errorPos err) ++ " error: syntax error"
+    ++ showErrorMessages "or" "unknown parser error" "  expected:" "     found:" "end of input" (errorMessages err)
 
 instance Ord Error where
   compare (Error _ _ pos1) (Error _ _ pos2) = compare pos1 pos2
diff --git a/src/Lexer.hs b/src/Micro/Lexer.hs
index 1a7df62..5496af1 100644
--- a/src/Lexer.hs
+++ b/src/Micro/Lexer.hs
@@ -1,4 +1,4 @@
-module Lexer where
+module Micro.Lexer where
 
 import Data.Char (digitToInt)
 import Text.Parsec
diff --git a/src/Parser.hs b/src/Micro/Parser.hs
index 12f04d9..ea4873e 100644
--- a/src/Parser.hs
+++ b/src/Micro/Parser.hs
@@ -1,12 +1,14 @@
-module Parser where
+module Micro.Parser where
 
-import Ast
+import Control.Monad.Identity (Identity)
 import Data.Maybe (isJust)
-import Lexer
+import Micro.Ast
+import Micro.Lexer
 import Text.Parsec
 import qualified Text.Parsec.Expr as E
 import Text.Parsec.String (Parser)
 
+binary :: String -> Op -> E.Assoc -> E.Operator String () Identity Expr
 binary s f assoc =
   E.Infix
     ( reservedOp s
@@ -16,6 +18,7 @@ binary s f assoc =
     )
     assoc
 
+opTable :: [[E.Operator String () Identity Expr]]
 opTable =
   [ [binary "=" Assign E.AssocLeft],
     [ binary "*" Mul E.AssocLeft,
@@ -214,6 +217,7 @@ program = do
 parse :: Parser [Expr]
 parse = program
 
+parseFromFile :: Parsec String () a -> FilePath -> IO (Either ParseError a)
 parseFromFile p fname = do
   input <- readFile fname
   return (runParser p () fname input)