summaryrefslogtreecommitdiff
path: root/src/Language.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language.hs')
-rw-r--r--src/Language.hs104
1 files changed, 104 insertions, 0 deletions
diff --git a/src/Language.hs b/src/Language.hs
new file mode 100644
index 0000000..b76e07f
--- /dev/null
+++ b/src/Language.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE TypeOperators #-}
+module Language (
+ scopeCheck,
+ SExpr,
+ module Language,
+) where
+
+import AST
+import Data
+import Language.AST
+
+
+lambda :: forall a args t. KnownTy a => (SExpr a -> SFun args t) -> SFun (Append args '[a]) t
+lambda f = case mkLambda f f of
+ Lambda tag (SFun args e) ->
+ SFun (sappend args (tag `SCons` SNil)) e
+
+body :: SExpr t -> SFun '[] t
+body e = SFun SNil e
+
+
+let_ :: KnownTy a => SExpr a -> (SExpr a -> SExpr t) -> SExpr t
+let_ rhs f = SELet rhs (mkLambda (rhs, f) f)
+
+pair :: SExpr a -> SExpr b -> SExpr (TPair a b)
+pair = SEPair
+
+fst_ :: SExpr (TPair a b) -> SExpr a
+fst_ = SEFst
+
+snd_ :: SExpr (TPair a b) -> SExpr b
+snd_ = SESnd
+
+nil :: SExpr TNil
+nil = SENil
+
+inl :: STy b -> SExpr a -> SExpr (TEither a b)
+inl = SEInl
+
+inr :: STy a -> SExpr b -> SExpr (TEither a b)
+inr = SEInr
+
+case_ :: (KnownTy a, KnownTy b)
+ => SExpr (TEither a b) -> (SExpr a -> SExpr c) -> (SExpr b -> SExpr c) -> SExpr c
+case_ e f g = SECase e (mkLambda (e, f) f) (mkLambda (e, g) g)
+
+build1 :: SExpr TIx -> (SExpr TIx -> SExpr t) -> SExpr (TArr (S Z) t)
+build1 e f = SEBuild1 e (mkLambda (e, f) f)
+
+build :: SNat n -> SExpr (Tup (Replicate n TIx)) -> (SExpr (Tup (Replicate n TIx)) -> SExpr t) -> SExpr (TArr n t)
+build n e f = SEBuild n e (mkLambda' (e, f) (tTup (sreplicate n tIx)) f)
+
+fold1 :: KnownTy t => (SExpr t -> SExpr t -> SExpr t) -> SExpr (TArr (S n) t) -> SExpr (TArr n t)
+fold1 f e = SEFold1 (mkLambda2 (f, e) f) e
+
+unit :: SExpr t -> SExpr (TArr Z t)
+unit = SEUnit
+
+const_ :: KnownScalTy t => ScalRep t -> SExpr (TScal t)
+const_ x =
+ let ty = knownScalTy
+ in case scalRepIsShow ty of
+ Dict -> SEConst ty x
+
+idx0 :: SExpr (TArr Z t) -> SExpr t
+idx0 = SEIdx0
+
+(.!) :: SExpr (TArr (S n) t) -> SExpr TIx -> SExpr (TArr n t)
+(.!) = SEIdx1
+
+(!) :: SNat n -> SExpr (TArr n t) -> SExpr (Tup (Replicate n TIx)) -> SExpr t
+(!) = SEIdx
+
+shape :: SExpr (TArr n t) -> SExpr (Tup (Replicate n TIx))
+shape = SEShape
+
+oper :: SOp a t -> SExpr a -> SExpr t
+oper = SEOp
+
+error_ :: KnownTy t => String -> SExpr t
+error_ s = SEError knownTy s
+
+(.==) :: KnownScalTy st => SExpr (TScal st) -> SExpr (TScal st) -> SExpr (TScal TBool)
+a .== b = oper (OEq knownScalTy) (pair a b)
+
+(.<) :: KnownScalTy st => SExpr (TScal st) -> SExpr (TScal st) -> SExpr (TScal TBool)
+a .< b = oper (OLt knownScalTy) (pair a b)
+
+(.>) :: KnownScalTy st => SExpr (TScal st) -> SExpr (TScal st) -> SExpr (TScal TBool)
+(.>) = flip (.<)
+
+(.<=) :: KnownScalTy st => SExpr (TScal st) -> SExpr (TScal st) -> SExpr (TScal TBool)
+a .<= b = oper (OLe knownScalTy) (pair a b)
+
+(.>=) :: KnownScalTy st => SExpr (TScal st) -> SExpr (TScal st) -> SExpr (TScal TBool)
+(.>=) = flip (.<=)
+
+not_ :: SExpr (TScal TBool) -> SExpr (TScal TBool)
+not_ = oper ONot
+
+if_ :: SExpr (TScal TBool) -> SExpr t -> SExpr t -> SExpr t
+if_ e a b = case_ (oper OIf e) (\_ -> a) (\_ -> b)