Skip to content

Commit

Permalink
Add coerce primitive
Browse files Browse the repository at this point in the history
Use `unsafeCoerce` when there is an (erased) proof that types are identical.

Fixes: #135
  • Loading branch information
naucke authored and jespercockx committed Dec 6, 2023
1 parent a5683b4 commit ef4d175
Show file tree
Hide file tree
Showing 8 changed files with 53 additions and 14 deletions.
5 changes: 5 additions & 0 deletions lib/Haskell/Prelude.agda
Original file line number Diff line number Diff line change
Expand Up @@ -135,3 +135,8 @@ xs !! n = xs !!ᴺ intToNat n
lookup : ⦃ Eq a ⦄ a List (a × b) Maybe b
lookup x [] = Nothing
lookup x ((x₁ , y) ∷ xs) = if x == x₁ then Just y else lookup x xs

private variable A B : Set

coerce : @0 A ≡ B A B
coerce refl x = x
21 changes: 11 additions & 10 deletions src/Agda2Hs/Compile/Name.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,16 +61,17 @@ toNameImport x (Just mod) =
-- | Default rewrite rules.
defaultSpecialRules :: SpecialRules
defaultSpecialRules = Map.fromList
[ "Agda.Builtin.Nat.Nat" `to` "Natural" `importing` Just "Numeric.Natural"
, "Haskell.Control.Monad.guard" `to` "guard" `importing` Just "Control.Monad"
, "Agda.Builtin.Int.Int" `to` "Integer" `importing` Nothing
, "Agda.Builtin.Word.Word64" `to` "Word" `importing` Nothing
, "Agda.Builtin.Float.Float" `to` "Double" `importing` Nothing
, "Agda.Builtin.Bool.Bool.false" `to` "False" `importing` Nothing
, "Agda.Builtin.Bool.Bool.true" `to` "True" `importing` Nothing
, "Haskell.Prim._∘_" `to` "_._" `importing` Nothing
, "Haskell.Prim.Monad.Dont._>>=_" `to` "_>>=_" `importing` Nothing
, "Haskell.Prim.Monad.Dont._>>_" `to` "_>>_" `importing` Nothing
[ "Agda.Builtin.Nat.Nat" `to` "Natural" `importing` Just "Numeric.Natural"
, "Haskell.Control.Monad.guard" `to` "guard" `importing` Just "Control.Monad"
, "Haskell.Prelude.coerce" `to` "unsafeCoerce" `importing` Just "Unsafe.Coerce"
, "Agda.Builtin.Int.Int" `to` "Integer" `importing` Nothing
, "Agda.Builtin.Word.Word64" `to` "Word" `importing` Nothing
, "Agda.Builtin.Float.Float" `to` "Double" `importing` Nothing
, "Agda.Builtin.Bool.Bool.false" `to` "False" `importing` Nothing
, "Agda.Builtin.Bool.Bool.true" `to` "True" `importing` Nothing
, "Haskell.Prim._∘_" `to` "_._" `importing` Nothing
, "Haskell.Prim.Monad.Dont._>>=_" `to` "_>>=_" `importing` Nothing
, "Haskell.Prim.Monad.Dont._>>_" `to` "_>>_" `importing` Nothing
]
where infixr 6 `to`, `importing`
to = (,)
Expand Down
2 changes: 2 additions & 0 deletions test/AllTests.agda
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ import Issue169
import Issue210
import ModuleParameters
import ModuleParametersImports
import Coerce

{-# FOREIGN AGDA2HS
import Issue14
Expand Down Expand Up @@ -124,4 +125,5 @@ import Issue169
import Issue210
import ModuleParameters
import ModuleParametersImports
import Coerce
#-}
16 changes: 16 additions & 0 deletions test/Coerce.agda
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
open import Haskell.Prelude

data A : Set where
MkA : Nat A

data B : Set where
MkB : Nat B

postulate A≡B : A ≡ B

coerceExample : B
coerceExample = coerce A≡B (MkA 5)

{-# COMPILE AGDA2HS A newtype #-}
{-# COMPILE AGDA2HS B newtype deriving (Show) #-}
{-# COMPILE AGDA2HS coerceExample #-}
7 changes: 4 additions & 3 deletions test/Fail/Issue142.agda
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module Fail.Issue142 where

open import Haskell.Prelude

coerce : @0 a ≡ b a b
coerce refl x = x
{-# COMPILE AGDA2HS coerce #-}
-- `coerce` is a primitive but this general structure remains disallowed
falseCoerce : @0 a ≡ b a b
falseCoerce refl x = x
{-# COMPILE AGDA2HS falseCoerce #-}
1 change: 1 addition & 0 deletions test/golden/AllTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -60,4 +60,5 @@ import Issue169
import Issue210
import ModuleParameters
import ModuleParametersImports
import Coerce

13 changes: 13 additions & 0 deletions test/golden/Coerce.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
module Coerce where

import Numeric.Natural (Natural)
import Unsafe.Coerce (unsafeCoerce)

newtype A = MkA Natural

newtype B = MkB Natural
deriving (Show)

coerceExample :: B
coerceExample = unsafeCoerce (MkA 5)

2 changes: 1 addition & 1 deletion test/golden/Issue142.err
Original file line number Diff line number Diff line change
@@ -1,2 +1,2 @@
test/Fail/Issue142.agda:5,1-7
test/Fail/Issue142.agda:6,1-12
not supported by agda2hs: forced (dot) patterns in non-erased positions

0 comments on commit ef4d175

Please sign in to comment.