Better project layout, removed warnings

1 files changed, 0 insertions, 203 deletions

diff --git a/src/Compiler.hs b/src/Compiler.hs
deleted file mode 100644
index f895613..0000000
--- a/src/Compiler.hs
+++ /dev/null
@@ -1,203 +0,0 @@
-module 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))
-
-type CompState = (Env, [Error])
-
-type CompResult = Either [Error] (Maybe A.Type)
-
-startState :: CompState
-startState = (emptyEnv, [])
-
--- | @foldlEither fn init xs@ folds left @xs@ applying a function @fn@ that
--- returns either, returning accumulated right and the collected lefts as a
--- list.
-foldlEither :: (accr -> b -> Either accl accr) -> (accr, [accl]) -> [b] -> (accr, [accl])
-foldlEither fn init xs =
-  foldl
-    ( \(r, l) x -> case fn r x of
-        Left e -> (r, e : l)
-        Right x -> (x, l)
-    )
-    init
-    xs
-
--- | @addError error@ adds @error@ to the state and returns no type to allow
--- the compilation to continue.
-addError :: Error -> State CompState CompResult
-addError e = do
-  (ev, errs) <- get
-  put (ev, e : errs)
-  pure $ Right Nothing
-
--- | @typecheckCall args params@ resolves @args@ and compares it with @params@,
--- returning a string describing an error or Nothing in case of type match.
-typecheckCall :: [A.Expr] -> [A.Type] -> State CompState (Maybe String)
-typecheckCall args params
-  | length args /= length params = return $ Just "invalid number of arguments in function call"
-  | length params == 0 = pure Nothing
-  | otherwise = do
-      -- resolve all args types
-      targs <- fmap rights $ traverse compile args
-      case sequence targs of
-        Just t
-          -- after resolution, we could have less "rights"
-          | length t /= length params -> return $ Nothing
-          -- compare types
-          | all (\(a, b) -> a == b) $ zip t params ->
-              return $ Nothing -- all good!
-          | otherwise -> return $ Just ("type mismatch in function call\n     found: " ++ A.showList t ++ "\n  expected: " ++ A.showList params)
-        Nothing ->
-          -- there was an error in on argument
-          pure Nothing
-
-showMaybet :: Maybe A.Type -> String
-showMaybet Nothing = "()"
-showMaybet (Just t) = show t
-
--- | @typecheckVal value typ@ resolves @value@ and compares it to @typ@ type,
--- returning a string describing an error or Nothing in case of type match.
-typecheckVal :: A.Expr -> Maybe A.Type -> State CompState (Maybe String)
-typecheckVal value typ = do
-  r <- compile value
-  case r of
-    Right r
-      | r == typ -> pure Nothing
-      | otherwise -> return $ Just $ "type mismatch\n     found: " ++ showMaybet r ++ "\n  expected: " ++ showMaybet typ
-    Left _ -> pure Nothing -- error resolving value
-
--- | @typecheckReturn value fret@ resolves @value@ and compares it with @fret@,
--- returning a string decribing an error or Nothing in case of a type match.
-typecheckReturn :: Maybe A.Expr -> Maybe A.Type -> State CompState (Maybe String)
-typecheckReturn Nothing Nothing = return $ Nothing
-typecheckReturn Nothing fret = return $ Just $ "invalid return value\n     found: ()\n  expected: " ++ showMaybet fret
-typecheckReturn (Just value) fret = typecheckVal value fret
-
--- | @typecheckBinOp a b pos@ resolves @a@ (left) and compares it to the type
--- of @b@ via typecheckVal.
-typecheckBinOp :: A.Expr -> A.Expr -> SourcePos -> State CompState CompResult
-typecheckBinOp a b pos = do
-  l <- compile a
-  case l of
-    Right tl -> do
-      tr <- typecheckVal b $ tl
-      case tr of
-        Just err -> addError $ Error TypeError err pos
-        Nothing -> return $ Right $ tl
-    _ -> return $ Right Nothing -- error resolving left
-
--- built-in types
-types = ["bool", "u8", "s8", "u16", "s16"]
-
-definedType :: A.Type -> Bool
-definedType (A.Type t) = t `elem` types
-definedType (A.FuncType ts r) =
-  all definedType ts && fromMaybe False (fmap definedType r)
-
-verifyFuncType :: String -> [A.FuncParam] -> Maybe A.Type -> SourcePos -> [Error]
-verifyFuncType ident params ret pos = do
-  ( catMaybes $
-      map
-        ( \(id, t, _, pos) ->
-            if not (definedType t)
-              then Just $ Error UndefinedType ("undefined type in function declaration \"" ++ id ++ "\"") pos
-              else Nothing
-        )
-        params
-    )
-    ++ if not (fromMaybe True (fmap definedType ret))
-      then [Error UndefinedType ("undefined return type in \"" ++ ident ++ "\"") pos]
-      else []
-
-compile :: A.Expr -> State CompState CompResult
-compile x = do
-  case x of
-    (A.Module name pos) -> 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) ->
-      addError $ Error InvalidTarget "invalid assignment target" pos
-    (A.BinOp op pos a b) ->
-      -- TODO: types and invalid operators
-      typecheckBinOp a b pos
-    (A.Func ident params ret body priv anon pos) -> do
-      -- current env
-      (ev, errs) <- get
-      -- check for undefined types
-      (ev, errs) <- return $ (ev, (verifyFuncType ident params ret pos) ++ errs)
-      -- updated with the function
-      (ev, errs) <-
-        return $ case addSymUniq ev (ident, ftype, priv, pos) of
-          Left err -> (ev, err : errs)
-          Right ev -> (ev, errs)
-      -- lambdas can only access local variables (closures aren't supported)
-      fev <- return $ if anon then emptyEnv else ev
-      -- with parameters
-      (nev, errs) <- return $ foldlEither addSymUniq (addEnv fev, errs) params
-      -- helper for return
-      nev <- return $ addSym nev ("$fn$", ftype, True, pos)
-      put (nev, errs)
-      r <- compileAll body
-      (_, errs) <- get
-      -- store updated errors and the env with the function
-      put (ev, errs)
-      return $ Right $ Just ftype
-      where
-        ftype = A.toFuncType params ret
-    (A.Call ident args pos) -> do
-      r <- compile ident
-      case r of
-        Right (Just (A.FuncType params rtyp)) -> do
-          r <- typecheckCall args params
-          case r of
-            Just err -> addError $ Error TypeError err pos
-            Nothing -> return $ Right rtyp
-        Right _ -> addError $ Error NonCallable "non callable value in function call" pos
-        _ -> pure $ Right Nothing
-    (A.Var ident typ val priv pos) -> do
-      (ev, errs) <- get
-      (ev, errs) <- return $ foldlEither addSymUniq (ev, errs) [(ident, typ, priv, pos)]
-      errs <-
-        return $
-          if not (definedType typ)
-            then Error UndefinedType ("undefined type in variable declaration \"" ++ ident ++ "\"") pos : errs
-            else errs
-      put (ev, errs)
-      vt <- typecheckVal val $ Just typ
-      case vt of
-        Just err -> addError $ Error TypeError err pos
-        Nothing -> return $ Right $ Just typ
-    (A.Return value pos) -> do
-      (ev, errs) <- 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
-    (A.Variable ident pos) -> do
-      (ev, errs) <- 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
-  compileAll xs
-compileAll [] = do
-  (_, errs) <- get
-  case errs of
-    [] -> pure $ Right Nothing
-    _ -> return $ Left errs