module Infernu.Builtins.Array
(arrayRowType)
where
import Control.Monad (foldM, forM)
import Infernu.Types
import Infernu.InferState
import Infernu.Lib (safeLookup)
func :: Type -> Type -> Type -> Type
func this x y = Fix $ TFunc [this, x] y
funcN :: [Fix FType] -> Fix FType -> Fix FType
funcN xs tres = Fix $ TFunc xs tres
string :: Type
string = Fix $ TBody TString
number :: Type
number = Fix $ TBody TNumber
undef :: Type
undef = Fix $ TBody TUndefined
array :: Type -> Type
array t = Fix $ TCons TArray [t]
boolean :: Fix FType
boolean = Fix $ TBody TBoolean
ts :: t -> TScheme t
ts t = TScheme [] $ qualEmpty t
tvar :: TVarName -> Type
tvar = Fix . TBody . TVar
arrayProps :: Type -> [(String, TypeScheme)]
arrayProps elemType = let aType = array elemType in
[ ("length", ts number)
, ("concat", ts $ func aType aType aType)
, ("every", ts $ func aType (funcN [undef, elemType, number, aType] boolean) boolean)
, ("filter", ts $ func aType (funcN [undef, elemType, number, aType] boolean) aType)
, ("indexOf", ts $ funcN [aType, elemType, number] number)
, ("join", ts $ func aType string string)
, ("lastIndexOf", ts $ func aType number number)
, ("map", TScheme [0] $ qualEmpty (func aType (funcN [undef, elemType, number, aType] (tvar 0)) (array $ tvar 0)))
, ("pop", ts $ funcN [aType] elemType)
, ("push", ts $ funcN [aType, elemType] number)
, ("reverse", ts $ funcN [aType] aType)
, ("shift", ts $ funcN [aType] elemType)
, ("slice", ts $ funcN [aType, number, number] aType)
, ("some", ts $ func aType (funcN [undef, elemType, number, aType] boolean) aType)
, ("sort", ts $ func aType (funcN [undef, elemType, elemType] number) aType)
, ("splice", ts $ funcN [aType, number, number] aType)
, ("unshift", ts $ funcN [aType] elemType)
]
arrayRowType :: Type -> Infer (TRowList Type)
arrayRowType elemType = foldM addProp (TRowEnd Nothing) $ arrayProps elemType
where addProp rowlist (name, propTS) =
do allocNames <- forM (schemeVars propTS) $ \tvName -> (fresh >>= return . (tvName,))
let ts' = mapVarNames (safeLookup allocNames) propTS
return $ TRowProp name ts' rowlist