sanity checks

diff --git a/AST.dcl b/AST.dcl
index 45eab9e..463c7b7 100644 (file)
--- a/AST.dcl
+++ b/AST.dcl
@@ -1,7 +1,7 @@
 definition module AST
 
 from Data.Maybe import :: Maybe
-from StdOverloaded import class toString, class ==
+from StdOverloaded import class toString, class ==, class zero
 
 :: Pos = {line :: Int, col :: Int}
 :: AST = AST [FunDecl]
@@ -41,3 +41,5 @@ from StdOverloaded import class toString, class ==
 instance toString Pos
 instance toString Type
 instance toString AST
+
+instance zero Pos

diff --git a/AST.icl b/AST.icl
index 90d1e53..6f2e5c6 100644 (file)
--- a/AST.icl
+++ b/AST.icl
@@ -110,3 +110,6 @@ printFunCall s args = [s, "(":printersperse "," args] ++ [")"]
 
 derive gEq Op2
 instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2
+
+instance zero Pos where
+       zero = {line=0, col=0}

diff --git a/sem.icl b/sem.icl
index 23fb04a..d909508 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -3,11 +3,13 @@ implementation module sem
 import qualified Data.Map as Map
 
 from Data.Func import $
-from StdFunc import o
+from StdFunc import o, flip, const
 
 import Control.Monad
 import Data.Either
+import Data.Maybe
 import Data.Monoid
+import Data.List
 
 import StdString
 import StdList
@@ -31,13 +33,41 @@ import AST
        | OperatorError Pos Op2 Type
     | UndeclaredVariableError Pos String
     | ArgumentMisMatchError Pos String
+       | SanityError Pos String
        | Error String
 
 variableStream :: [String]
 variableStream = map toString [1..]
 
 sem :: AST -> SemOutput
-sem (AST fd) = Right (AST fd, 'Map'.newMap)
+sem a=:(AST fd) = case foldM (const $ hasNoDups fd) () fd 
+               >>| foldM (const isNiceMain) () fd
+               >>| hasMain fd of
+       Left e = Left [e]
+       _ = pure (a, 'Map'.newMap)
+where
+               hasNoDups :: [FunDecl] FunDecl -> Either SemError ()
+               hasNoDups fds (FunDecl p n _ _ _ _)
+               # mbs = map (\(FunDecl p` n` _ _ _ _)->if (n == n`) (Just p`) Nothing) fds
+               = case catMaybes mbs of
+                       [] = Left $ SanityError p "HUH THIS SHOULDN'T HAPPEN"
+                       [x] = pure ()
+                       [_:x] = Left $ SanityError p (concat 
+                               [n, " multiply defined at ", toString p])
+
+               hasMain :: [FunDecl] -> Either SemError ()
+               hasMain [(FunDecl _ "main" _ _ _ _):fd] = pure ()
+               hasMain [_:fd] = hasMain fd
+               hasMain [] = Left $ SanityError zero "no main function defined"
+
+               isNiceMain :: FunDecl -> Either SemError ()
+               isNiceMain (FunDecl p "main" as mt _ _) = case (as, mt) of
+                       ([_:_], _) = Left $ SanityError p "main must have arity 0"
+                       ([], t) = (case t of
+                               Nothing = pure ()
+                               Just VoidType = pure ()
+                               _ = Left $ SanityError p "main has to return Void")
+               isNiceMain _ = pure ()
 
 instance toString Scheme where
        toString (Forall x t) = 
@@ -48,6 +78,8 @@ instance toString Gamma where
                concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
 
 instance toString SemError where
+       toString (SanityError p e) = concat [toString p, 
+               "SemError: SanityError: ", e]
        toString se = "SemError: "
 
 uni :: Type Type -> Infer ()