swarm-0.7.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellNone
LanguageHaskell2010

Swarm.Game.World.Typecheck

Description

Typechecking and elaboration for the Swarm world DSL. For more information, see:

https://byorgey.wordpress.com/2023/07/13/compiling-to-intrinsically-typed-combinators/

Synopsis

Documentation

class Empty e where Source #

Methods

empty :: e Source #

Instances

Instances details
Empty CellVal Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

empty :: CellVal Source #

class Over m where Source #

Methods

(<!>) :: m -> m -> m Source #

Instances

Instances details
Over CellVal Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Over Integer Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Over Bool Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

(<!>) :: Bool -> Bool -> Bool Source #

Over Double Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

(<!>) :: Double -> Double -> Double Source #

class Applicable (t :: Type -> Type) where Source #

Methods

($$) :: t (a -> b) -> t a -> t b infixl 1 Source #

Instances

Instances details
Applicable BTerm Source # 
Instance details

Defined in Swarm.Game.World.Abstract

Methods

($$) :: BTerm (a -> b) -> BTerm a -> BTerm b Source #

Applicable CTerm Source # 
Instance details

Defined in Swarm.Game.World.Compile

Methods

($$) :: CTerm (a -> b) -> CTerm a -> CTerm b Source #

Applicable (OTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Abstract

Methods

($$) :: OTerm g (a -> b) -> OTerm g a -> OTerm g b Source #

Applicable (TTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

($$) :: TTerm g (a -> b) -> TTerm g a -> TTerm g b Source #

type family IsFun a :: Bool where ... Source #

Equations

IsFun (_1 -> _2) = 'True 
IsFun _1 = 'False 

type NotFun a = IsFun a ~ 'False Source #

data Const a where Source #

Type-indexed constants. These include both language built-ins (if, arithmetic, comparison, <>, etc.) as well as combinators (S, I, C, K, B, Φ) we will use both for elaboration and later as a compilation target.

Constructors

CLit :: forall a. (Show a, NotFun a) => a -> Const a 
CCell :: CellVal -> Const CellVal 
CFI :: Const (Integer -> Double) 
CIf :: forall a1. Const (Bool -> a1 -> a1 -> a1) 
CNot :: Const (Bool -> Bool) 
CNeg :: forall a1. (Num a1, NotFun a1) => Const (a1 -> a1) 
CAbs :: forall a1. (Num a1, NotFun a1) => Const (a1 -> a1) 
CAnd :: Const (Bool -> Bool -> Bool) 
COr :: Const (Bool -> Bool -> Bool) 
CAdd :: forall a1. (Num a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CSub :: forall a1. (Num a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CMul :: forall a1. (Num a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CDiv :: forall a1. (Fractional a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CIDiv :: forall a1. (Integral a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CMod :: forall a1. (Integral a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CEq :: forall a1. (Eq a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CNeq :: forall a1. (Eq a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CLt :: forall a1. (Ord a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CLeq :: forall a1. (Ord a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CGt :: forall a1. (Ord a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CGeq :: forall a1. (Ord a1, NotFun a1) => Const (a1 -> a1 -> Bool) 
CMask :: forall a1. (Empty a1, NotFun a1) => Const (World Bool -> World a1 -> World a1) 
CSeed :: Const Integer 
CCoord :: Axis -> Const (Coords -> Integer) 
CHash :: Const (Coords -> Integer) 
CPerlin :: Const (Integer -> Integer -> Double -> Double -> World Double) 
COver :: forall a1. (Over a1, NotFun a1) => Const (a1 -> a1 -> a1) 
CIMap :: forall a1. NotFun a1 => Const (World Integer -> World Integer -> World a1 -> World a1) 
K :: forall a1 b. Const (a1 -> b -> a1) 
S :: forall a1 b c. Const ((a1 -> b -> c) -> (a1 -> b) -> a1 -> c) 
I :: forall a1. Const (a1 -> a1) 
B :: forall b c a1. Const ((b -> c) -> (a1 -> b) -> a1 -> c) 
C :: forall a1 b c. Const ((a1 -> b -> c) -> b -> a1 -> c) 
Φ :: forall a1 b c d. Const ((a1 -> b -> c) -> (d -> a1) -> (d -> b) -> d -> c) 

Instances

Instances details
Show (Const ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> Const ty -> ShowS #

show :: Const ty -> String #

showList :: [Const ty] -> ShowS #

PrettyPrec (Const α) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

prettyPrec :: Int -> Const α -> Doc ann

class HasConst (t :: Type -> Type) where Source #

Methods

embed :: Const a -> t a Source #

Instances

Instances details
HasConst BTerm Source # 
Instance details

Defined in Swarm.Game.World.Abstract

Methods

embed :: Const a -> BTerm a Source #

HasConst (OTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Abstract

Methods

embed :: Const a -> OTerm g a Source #

HasConst (TTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

embed :: Const a -> TTerm g a Source #

(.$$) :: (HasConst t, Applicable t) => Const (a -> b) -> t a -> t b infixl 1 Source #

($$.) :: (HasConst t, Applicable t) => t (a -> b) -> Const a -> t b infixl 1 Source #

(.$$.) :: (HasConst t, Applicable t) => Const (a -> b) -> Const a -> t b infixl 1 Source #

type family Append (xs :: [k]) (ys :: [k]) :: [k] where ... Source #

Type-level list append.

Equations

Append ('[] :: [k]) (ys :: [k]) = ys 
Append (x ': xs :: [k]) (ys :: [k]) = x ': Append xs ys 

data Idx (a :: [Type]) b where Source #

Type- and context-indexed de Bruijn indices. (v :: Idx g a) means v represents a variable with type a in a type context g.

Constructors

VZ :: forall b (g :: [Type]). Idx (b ': g) b 
VS :: forall (g :: [Type]) b x. Idx g b -> Idx (x ': g) b 

Instances

Instances details
Show (Idx g ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> Idx g ty -> ShowS #

show :: Idx g ty -> String #

showList :: [Idx g ty] -> ShowS #

idxToNat :: forall (g :: [Type]) a. Idx g a -> Int Source #

weakenVar :: forall (h :: [Type]) (g :: [Type]) a. Idx g a -> Idx (Append g h) a Source #

A variable valid in one context is also valid in another extended context with additional variables.

data TTerm (a :: [Type]) b where Source #

Type-indexed terms. Note this is a stripped-down core language, with only variables, lambdas, application, and constants.

Constructors

TVar :: forall (a :: [Type]) b. Idx a b -> TTerm a b 
TLam :: forall ty1 (a :: [Type]) ty2. TTerm (ty1 ': a) ty2 -> TTerm a (ty1 -> ty2) 
TApp :: forall (a :: [Type]) a1 b. TTerm a (a1 -> b) -> TTerm a a1 -> TTerm a b 
TConst :: forall b (a :: [Type]). Const b -> TTerm a b 

Instances

Instances details
Applicable (TTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

($$) :: TTerm g (a -> b) -> TTerm g a -> TTerm g b Source #

HasConst (TTerm g) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

embed :: Const a -> TTerm g a Source #

Show (TTerm g ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> TTerm g ty -> ShowS #

show :: TTerm g ty -> String #

showList :: [TTerm g ty] -> ShowS #

PrettyPrec (TTerm g α) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

prettyPrec :: Int -> TTerm g α -> Doc ann

weaken :: forall (h :: [Type]) (g :: [Type]) a. TTerm g a -> TTerm (Append g h) a Source #

A term valid in one context is also valid in another extended context with additional variables (which the term does not use).

data CheckErr where Source #

Errors that can occur during typechecking/elaboration.

Constructors

ApplyErr :: forall (g :: [Type]). Some (TTerm g) -> Some (TTerm g) -> CheckErr 
NoInstance :: forall a. Text -> TTy a -> CheckErr 
Unbound :: Text -> CheckErr 
BadType :: forall (g :: [Type]) b. Some (TTerm g) -> TTy b -> CheckErr 
BadDivType :: forall a. TTy a -> CheckErr 
BadInferOp :: [SomeTy] -> Op -> CheckErr 
UnknownImport :: Text -> CheckErr 
NotAThing :: Text -> CellTag -> CheckErr 
NotAnything :: Text -> CheckErr 

Instances

Instances details
Show CheckErr Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

PrettyPrec CheckErr Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

prettyPrec :: Int -> CheckErr -> Doc ann

data Base a where Source #

Base types.

Constructors

BInt :: Base Integer 
BFloat :: Base Double 
BBool :: Base Bool 
BCell :: Base CellVal 

Instances

Instances details
TestEquality Base Source #

Testing base type representations for equality to yield reflected type-level equalities.

Instance details

Defined in Swarm.Game.World.Typecheck

Methods

testEquality :: Base a -> Base b -> Maybe (a :~: b) #

Show (Base ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> Base ty -> ShowS #

show :: Base ty -> String #

showList :: [Base ty] -> ShowS #

PrettyPrec (Base α) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

prettyPrec :: Int -> Base α -> Doc ann

data TTy a where Source #

Type representations indexed by the corresponding host language type.

Constructors

TTyBase :: forall a. Base a -> TTy a 
(:->:) :: forall a1 b. TTy a1 -> TTy b -> TTy (a1 -> b) infixr 0 
TTyWorld :: forall t. TTy t -> TTy (Coords -> t) 

Instances

Instances details
TestEquality TTy Source #

Testing type representations for equality to yield reflected type-level equalities.

Instance details

Defined in Swarm.Game.World.Typecheck

Methods

testEquality :: TTy a -> TTy b -> Maybe (a :~: b) #

Show (TTy ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> TTy ty -> ShowS #

show :: TTy ty -> String #

showList :: [TTy ty] -> ShowS #

PrettyPrec (TTy ty) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

prettyPrec :: Int -> TTy ty -> Doc ann

pattern TTyBool :: TTy Bool Source #

checkEq :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Eq ty, NotFun ty) => m a) -> m a Source #

Check that a particular type has an Eq instance, and run a computation in a context provided with an Eq constraint. The other checkX functions are similar.

checkOrd :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Ord ty, NotFun ty) => m a) -> m a Source #

checkNum :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Num ty, NotFun ty) => m a) -> m a Source #

checkIntegral :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Integral ty, NotFun ty) => m a) -> m a Source #

checkEmpty :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Empty ty, NotFun ty) => m a) -> m a Source #

checkOver :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> ((Over ty, NotFun ty) => m a) -> m a Source #

checkNotFun :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> (NotFun ty => m a) -> m a Source #

data Some (a :: Type -> Type) where Source #

Wrap up a type-indexed thing to hide the type index, but package it with a TTy which we can pattern-match on to recover the type later.

Constructors

Some :: forall α (a :: Type -> Type). TTy α -> a α -> Some a 

Instances

Instances details
(forall α. Show (t α)) => Show (Some t) Source # 
Instance details

Defined in Swarm.Game.World.Typecheck

Methods

showsPrec :: Int -> Some t -> ShowS #

show :: Some t -> String #

showList :: [Some t] -> ShowS #

mapSome :: (forall α. s α -> t α) -> Some s -> Some t Source #

type SomeTy = Some (Const () :: Type -> Type) Source #

pattern SomeTy :: () => TTy α -> SomeTy Source #

type WorldMap = Map Text (Some (TTerm ('[] :: [Type]))) Source #

data Ctx (a :: [Type]) where Source #

Type contexts, indexed by a type-level list of types of all the variables in the context.

Constructors

CNil :: Ctx ('[] :: [Type]) 
CCons :: forall ty (g :: [Type]). Text -> TTy ty -> Ctx g -> Ctx (ty ': g) 

lookup :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => Text -> Ctx g -> m (Some (Idx g)) Source #

Look up a variable name in the context, returning a type-indexed de Bruijn index.

check :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]) t. (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m, Has (Reader WorldMap) sig m) => Ctx g -> TTy t -> WExp -> m (TTerm g t) Source #

Check that a term has a given type, and if so, return a corresponding elaborated and type-indexed term. Note that this also deals with subtyping: for example, if we check that the term 3 has type World Int, we will get back a suitably lifted value (i.e. const 3).

getBaseType :: forall (g :: [Type]). Some (TTerm g) -> SomeTy Source #

Get the underlying base type of a term which either has a base type or a World type.

apply :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => Some (TTerm g) -> Some (TTerm g) -> m (Some (TTerm g)) Source #

Apply one term to another term, automatically handling promotion and lifting, via the fact that World is Applicative. That is, (1) if a term of type T is used where a term of type World T is expected, it will automatically be promoted (by an application of const); (2) if a function of type (T1 -> T2 -> ... -> Tn) is applied to any arguments of type (World Ti), the function will be lifted to (World T1 -> World T2 -> ... -> World Tn).

applyTo :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => Some (TTerm g) -> Some (TTerm g) -> m (Some (TTerm g)) Source #

inferOp :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => [SomeTy] -> Op -> m (Some (TTerm g)) Source #

Infer the type of an operator: turn a raw operator into a type-indexed constant. However, some operators are polymorphic, so we also provide a list of type arguments. For example, the type of the negation operator can be either (Int -> Int) or (Float -> Float) so we provide it as an argument.

Currently, all operators take at most one type argument, so (Maybe SomeTy) might seem more appropriate than [SomeTy], but that is just a coincidence; in general one can easily imagine operators that are polymorphic in more than one type variable, and we may wish to add such in the future.

typeArgsFor :: forall (g :: [Type]). Op -> [Some (TTerm g)] -> [SomeTy] Source #

Given a raw operator and the terms the operator is applied to, select which types should be supplied as the type arguments to the operator. For example, for an operator like + we can just select the type of its first argument; for an operator like if, we must select the type of its second argument, since if : Bool -> a -> a -> a. In all cases we must also select the underlying base type in case the argument has a World type. For example if + is applied to an argument of type World Int we still want to give + the type Int -> Int -> Int. It can be lifted to have type World Int -> World Int -> World Int but that will be taken care of by application, which will insert the right combinators to do the lifting.

applyOp :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m, Has (Reader WorldMap) sig m) => Ctx g -> Op -> [WExp] -> m (Some (TTerm g)) Source #

Typecheck the application of an operator to some terms, returning a typed, elaborated version of the application.

infer :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m, Has (Reader WorldMap) sig m) => Ctx g -> WExp -> m (Some (TTerm g)) Source #

Infer the type of a term, and elaborate along the way.

resolveCell :: forall (sig :: (Type -> Type) -> Type -> Type) m. (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m) => RawCellVal -> m CellVal Source #

Try to resolve a RawCellVal---containing only Text names for terrain, entities, and robots---into a real CellVal with references to actual terrain, entities, and robots.

resolveCellItem :: forall (sig :: (Type -> Type) -> Type -> Type) m. (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m) => (Maybe CellTag, Text) -> m CellVal Source #

Try to resolve one cell item name into an actual item (terrain, entity, robot, etc.).

inferLet :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m, Has (Reader WorldMap) sig m) => Ctx g -> [(Var, WExp)] -> WExp -> m (Some (TTerm g)) Source #

Infer the type of a let expression, and elaborate into a series of lambda applications.

inferOverlay :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m, Has (Reader WorldMap) sig m) => Ctx g -> NonEmpty WExp -> m (Some (TTerm g)) Source #

Infer the type of an overlay expression, and elaborate into a chain of <> (over) operations.