From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 22 Apr 2016 11:28:25 +0000 (+0200)
Subject: sanity checks
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=220cb1cc56feab3f818503838b3afd7ea2225403;p=cc1516.git

sanity checks
---

diff --git a/AST.dcl b/AST.dcl
index 45eab9e..463c7b7 100644
--- 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
--- 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
--- 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 ()