License | BSD-3-Clause |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
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
- class Empty e where
- empty :: e
- class Over m where
- (<!>) :: m -> m -> m
- class Applicable (t :: Type -> Type) where
- ($$) :: t (a -> b) -> t a -> t b
- type family IsFun a :: Bool where ...
- type NotFun a = IsFun a ~ 'False
- data Const a where
- 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)
- class HasConst (t :: Type -> Type) where
- (.$$) :: (HasConst t, Applicable t) => Const (a -> b) -> t a -> t b
- ($$.) :: (HasConst t, Applicable t) => t (a -> b) -> Const a -> t b
- (.$$.) :: (HasConst t, Applicable t) => Const (a -> b) -> Const a -> t b
- type family Append (xs :: [k]) (ys :: [k]) :: [k] where ...
- data Idx (a :: [Type]) b where
- idxToNat :: forall (g :: [Type]) a. Idx g a -> Int
- weakenVar :: forall (h :: [Type]) (g :: [Type]) a. Idx g a -> Idx (Append g h) a
- data TTerm (a :: [Type]) b where
- weaken :: forall (h :: [Type]) (g :: [Type]) a. TTerm g a -> TTerm (Append g h) a
- data CheckErr where
- 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
- data Base a where
- data TTy a where
- pattern TTyBool :: TTy Bool
- pattern TTyInt :: TTy Integer
- pattern TTyFloat :: TTy Double
- pattern TTyCell :: TTy CellVal
- 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
- 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
- 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
- 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
- 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
- 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
- checkNotFun :: forall (sig :: (Type -> Type) -> Type -> Type) m ty a. Has (Throw CheckErr) sig m => TTy ty -> (NotFun ty => m a) -> m a
- data Some (a :: Type -> Type) where
- mapSome :: (forall α. s α -> t α) -> Some s -> Some t
- type SomeTy = Some (Const () :: Type -> Type)
- pattern SomeTy :: () => TTy α -> SomeTy
- type WorldMap = Map Text (Some (TTerm ('[] :: [Type])))
- data Ctx (a :: [Type]) where
- lookup :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => Text -> Ctx g -> m (Some (Idx g))
- 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)
- getBaseType :: forall (g :: [Type]). Some (TTerm g) -> SomeTy
- 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))
- 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))
- inferOp :: forall (sig :: (Type -> Type) -> Type -> Type) m (g :: [Type]). Has (Throw CheckErr) sig m => [SomeTy] -> Op -> m (Some (TTerm g))
- typeArgsFor :: forall (g :: [Type]). Op -> [Some (TTerm g)] -> [SomeTy]
- 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))
- 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))
- resolveCell :: forall (sig :: (Type -> Type) -> Type -> Type) m. (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m) => RawCellVal -> m CellVal
- resolveCellItem :: forall (sig :: (Type -> Type) -> Type -> Type) m. (Has (Throw CheckErr) sig m, Has (Reader TerrainEntityMaps) sig m) => (Maybe CellTag, Text) -> m CellVal
- 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))
- 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))
Documentation
class Applicable (t :: Type -> Type) where Source #
Instances
Applicable BTerm Source # | |
Applicable CTerm Source # | |
Applicable (OTerm g) Source # | |
Applicable (TTerm g) 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) |
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.
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 |
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).
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 |
Base types.
Instances
TestEquality Base Source # | Testing base type representations for equality to yield reflected type-level equalities. |
Defined in Swarm.Game.World.Typecheck | |
Show (Base ty) Source # | |
PrettyPrec (Base α) Source # | |
Defined in Swarm.Game.World.Typecheck Methods prettyPrec :: Int -> Base α -> Doc ann |
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
TestEquality TTy Source # | Testing type representations for equality to yield reflected type-level equalities. |
Defined in Swarm.Game.World.Typecheck | |
Show (TTy ty) Source # | |
PrettyPrec (TTy ty) Source # | |
Defined in Swarm.Game.World.Typecheck Methods prettyPrec :: Int -> TTy ty -> Doc ann |
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 #
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.
data Ctx (a :: [Type]) where Source #
Type contexts, indexed by a type-level list of types of all the variables in the context.
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.