carp-lang/Carp
1
1
Fork 0
mirror of https://github.com/carp-lang/Carp.git synced 2024-10-12 13:09:05 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #99 from hellerve/typecheck-main

Browse Source 
Added special cases to typecheck main function
This commit is contained in:
Erik Svedäng 2017-11-17 16:57:20 +01:00 committed by GitHub
commit c3ca5f6772
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Concretize.hs
View File

@ -2,6 +2,7 @@ module Concretize where
import Control.Monad.State
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.List (foldl')
import Debug.Trace
@ -39,13 +40,23 @@ concretizeXObj allowAmbiguity typeEnv rootEnv root =
visitList :: Env -> [XObj] -> State [XObj] (Either TypeError [XObj])
visitList _ [] = return (Right [])
visitList env (defn@(XObj Defn _ _) : nameSymbol@(XObj (Sym (SymPath [] "main")) _ _) : args@(XObj (Arr argsArr) _ _) : body : []) =
do if not (null argsArr)
then return $ Left (MainCannotHaveArguments (length argsArr))
else do visitedBody <- visit env body
return $ do okBody <- visitedBody
let t = fromMaybe UnitTy (ty okBody)
if t /= UnitTy && t /= IntTy
then Left (MainCanOnlyReturnUnitOrInt t)
else return [defn, nameSymbol, args, okBody]
visitList env (defn@(XObj Defn _ _) : nameSymbol : args@(XObj (Arr argsArr) _ _) : body : []) =
do mapM_ checkForNeedOfTypedefs argsArr
let functionEnv = Env Map.empty (Just env) Nothing [] InternalEnv
envWithArgs = foldl' (\e arg@(XObj (Sym (SymPath _ argSymName)) _ _) ->
extendEnv e argSymName arg)
functionEnv argsArr
visitedBody <- (visit envWithArgs) body
visitedBody <- visit envWithArgs body
return $ do okBody <- visitedBody
return [defn, nameSymbol, args, okBody]

7
src/TypeError.hs
View File

@ -29,6 +29,8 @@ data TypeError = SymbolMissingType XObj Env
| GettingReferenceToUnownedValue XObj
| UsingUnownedValue XObj
| ArraysCannotContainRefs XObj
| MainCanOnlyReturnUnitOrInt Ty
| MainCannotHaveArguments Int
instance Show TypeError where
show (SymbolMissingType xobj env) =
@ -93,6 +95,11 @@ instance Show TypeError where
"Using a given-away value '" ++ pretty xobj ++ "' at " ++ prettyInfoFromXObj xobj
show (ArraysCannotContainRefs xobj) =
"Arrays can't contain references: '" ++ pretty xobj ++ "' at " ++ prettyInfoFromXObj xobj
show (MainCanOnlyReturnUnitOrInt t) =
"Main function can only return Int or (), got " ++ show t
show (MainCannotHaveArguments c) =
"Main function can not have arguments, got " ++ show c
recursiveLookupTy :: TypeMappings -> Ty -> Ty
recursiveLookupTy mappings t = case t of