You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
96 lines
2.1 KiB
96 lines
2.1 KiB
{-# LANGUAGE PatternSynonyms #-}
|
|
module Syntax where
|
|
|
|
import Data.Function (on)
|
|
import Data.Text (Text)
|
|
|
|
import Presyntax.Presyntax (Plicity(..))
|
|
import qualified Data.Text as T
|
|
import Data.IORef (IORef)
|
|
|
|
data Term
|
|
= Ref Name
|
|
| App Plicity Term Term
|
|
| Lam Plicity Text Term
|
|
| Pi Plicity Text Term Term
|
|
| Meta MV
|
|
| Type
|
|
|
|
| Sigma Text Term Term
|
|
| Pair Term Term
|
|
| Proj1 Term
|
|
| Proj2 Term
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data MV =
|
|
MV { mvName :: Text
|
|
, mvCell :: {-# UNPACK #-} !(IORef (Maybe Value))
|
|
}
|
|
|
|
instance Eq MV where
|
|
(==) = (==) `on` mvName
|
|
instance Ord MV where
|
|
(<=) = (<=) `on` mvName
|
|
instance Show MV where
|
|
show = ('?':) . T.unpack . mvName
|
|
|
|
data Name
|
|
= Bound Text
|
|
deriving (Eq, Show, Ord)
|
|
|
|
type NFType = Value
|
|
|
|
data Value
|
|
= VNe Head [Projection]
|
|
| VLam Plicity Closure
|
|
| VPi Plicity Value Closure
|
|
| VSigma Value Closure
|
|
| VPair Value Value
|
|
| VType
|
|
deriving (Eq, Show, Ord)
|
|
|
|
pattern VVar :: Name -> Value
|
|
pattern VVar x = VNe (HVar x) []
|
|
|
|
quote :: Value -> Term
|
|
quote (VNe h sp) = foldl goSpine (goHead h) (reverse sp) where
|
|
goHead (HVar v) = Ref v
|
|
goHead (HMeta m) = Meta m
|
|
|
|
goSpine t (PApp p v) = App p t (quote v)
|
|
goSpine t PProj1 = Proj1 t
|
|
goSpine t PProj2 = Proj2 t
|
|
|
|
quote (VLam p (Closure n k)) = Lam p n (quote (k (VVar (Bound n))))
|
|
quote (VPi p d (Closure n k)) = Pi p n (quote d) (quote (k (VVar (Bound n))))
|
|
quote (VSigma d (Closure n k)) = Sigma n (quote d) (quote (k (VVar (Bound n))))
|
|
quote (VPair a b) = Pair (quote a) (quote b)
|
|
quote VType = Type
|
|
|
|
data Closure
|
|
= Closure
|
|
{ clArgName :: Text
|
|
, clCont :: Value -> Value
|
|
}
|
|
|
|
instance Show Closure where
|
|
show (Closure n c) = "Closure \\" ++ show n ++ " -> " ++ show (c (VVar (Bound n)))
|
|
|
|
instance Eq Closure where
|
|
Closure _ k == Closure _ k' =
|
|
k (VVar (Bound (T.pack "_"))) == k' (VVar (Bound (T.pack "_")))
|
|
|
|
instance Ord Closure where
|
|
Closure _ k <= Closure _ k' =
|
|
k (VVar (Bound (T.pack "_"))) <= k' (VVar (Bound (T.pack "_")))
|
|
|
|
data Head
|
|
= HVar Name
|
|
| HMeta MV
|
|
deriving (Eq, Show, Ord)
|
|
|
|
data Projection
|
|
= PApp Plicity Value
|
|
| PProj1
|
|
| PProj2
|
|
deriving (Eq, Show, Ord)
|