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.
110 lines
2.6 KiB
110 lines
2.6 KiB
{-# LANGUAGE BlockArguments #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DerivingStrategies #-}
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
|
module Elab.WiredIn where
|
|
|
|
import Syntax
|
|
import Data.Map.Strict (Map)
|
|
import Data.Text (Text)
|
|
import qualified Data.Map.Strict as Map
|
|
import Control.Exception
|
|
import Data.Typeable
|
|
import qualified Presyntax.Presyntax as P
|
|
import Elab.Eval
|
|
import qualified Data.Sequence as Seq
|
|
|
|
wiType :: WiredIn -> NFType
|
|
wiType WiType = VType
|
|
wiType WiPretype = VTypeω
|
|
|
|
wiType WiInterval = VTypeω
|
|
wiType WiI0 = VI
|
|
wiType WiI1 = VI
|
|
|
|
wiType WiIAnd = VI ~> VI ~> VI
|
|
wiType WiIOr = VI ~> VI ~> VI
|
|
wiType WiINot = VI ~> VI
|
|
wiType WiPathP = dprod (VI ~> VTypeω) \a -> a @@ VI0 ~> a @@ VI1 ~> VType
|
|
|
|
wiValue :: WiredIn -> Value
|
|
wiValue WiType = VType
|
|
wiValue WiPretype = VTypeω
|
|
|
|
wiValue WiInterval = VI
|
|
wiValue WiI0 = VI0
|
|
wiValue WiI1 = VI1
|
|
|
|
wiValue WiIAnd = fun \x -> fun \y -> iand x y
|
|
wiValue WiIOr = fun \x -> fun \y -> ior x y
|
|
wiValue WiINot = fun inot
|
|
wiValue WiPathP = fun \a -> fun \x -> fun \y -> VPath a x y
|
|
|
|
(~>) :: Value -> Value -> Value
|
|
a ~> b = VPi P.Ex a (Closure "_" (const b))
|
|
infixr 7 ~>
|
|
|
|
fun :: (Value -> Value) -> Value
|
|
fun k = VLam P.Ex $ Closure "x" (k . force)
|
|
|
|
forallI :: (Value -> Value) -> Value
|
|
forallI k = VLam P.Im $ Closure "x" (k . force)
|
|
|
|
dprod :: Value -> (Value -> Value) -> Value
|
|
dprod a b = VPi P.Ex a (Closure "x" b)
|
|
|
|
forAll :: Value -> (Value -> Value) -> Value
|
|
forAll a b = VPi P.Im a (Closure "x" b)
|
|
|
|
wiredInNames :: Map Text WiredIn
|
|
wiredInNames = Map.fromList
|
|
[ ("Pretype", WiPretype)
|
|
, ("Type", WiType)
|
|
, ("Interval", WiInterval)
|
|
, ("i0", WiI0)
|
|
, ("i1", WiI1)
|
|
, ("iand", WiIAnd)
|
|
, ("ior", WiIOr)
|
|
, ("inot", WiINot)
|
|
, ("PathP", WiPathP)
|
|
]
|
|
|
|
newtype NoSuchPrimitive = NoSuchPrimitive { getUnknownPrim :: Text }
|
|
deriving (Show, Typeable)
|
|
deriving anyclass (Exception)
|
|
|
|
-- Interval operations
|
|
|
|
iand, ior :: Value -> Value -> Value
|
|
iand = \case
|
|
VI1 -> id
|
|
VI0 -> const VI0
|
|
x -> \case
|
|
VI0 -> VI0
|
|
VI1 -> x
|
|
y -> VIAnd x y
|
|
|
|
ior = \case
|
|
VI0 -> id
|
|
VI1 -> const VI1
|
|
x -> \case
|
|
VI1 -> VI1
|
|
VI0 -> x
|
|
y -> VIOr x y
|
|
|
|
inot :: Value -> Value
|
|
inot = \case
|
|
VI0 -> VI1
|
|
VI1 -> VI0
|
|
VIOr x y -> VIAnd (inot x) (inot y)
|
|
VIAnd x y -> VIOr (inot x) (inot y)
|
|
VINot x -> x
|
|
x -> VINot x
|
|
|
|
ielim :: Value -> Value -> Value -> Value -> NFEndp -> Value
|
|
ielim _line _left _right fn i =
|
|
case force fn of
|
|
VLine _ fun -> fun @@ i
|
|
VNe n sp -> VNe n (sp Seq.:|> PIElim _line _left _right i)
|
|
_ -> error $ "can't ielim " ++ show fn
|