|
{-# 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
|
|
|
|
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
|
|
|
|
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
|
|
|
|
(~>) :: 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)
|
|
|
|
dprod :: Value -> (Value -> Value) -> Value
|
|
dprod a b = VPi P.Ex 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)
|
|
]
|
|
|
|
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
|