-
Notifications
You must be signed in to change notification settings - Fork 18
Open
Labels
Description
using unbind2Plus on two different term types results in an error when printing the terms out, see an example below.
Using it on two terms of the same type doesn't cause errors, as far as I can see.
Example
{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-}
import qualified Unbound.Generics.LocallyNameless as Unbound
import GHC.Generics (Generic)
import Control.DeepSeq (NFData, force)
type LName = Unbound.Name LTerm
data LTerm
= -- | variables `x`
LVar LName
| -- | abstraction `\x. a`
LLam (Unbound.Bind LName LTerm)
| -- | application `a b`
LApp LTerm LTerm
deriving (Show, Generic, Unbound.Alpha, NFData)
type RName = Unbound.Name RTerm
data RTerm
= -- | variables `x`
RVar RName
| -- | abstraction `\x. a`
RLam (Unbound.Bind RName RTerm)
| -- | application `a b`
RApp RTerm RTerm
deriving (Show, Generic, Unbound.Alpha, NFData)
lterm :: LTerm
lterm =
let name = (Unbound.s2n "left")
var = LVar name
in LLam (Unbound.bind name var)
rterm :: RTerm
rterm =
let name = (Unbound.s2n "right")
var = RVar name
in RLam (Unbound.bind name var)
test :: IO (LTerm, RTerm)
test = Unbound.runFreshMT $ do
let (LLam lbind) = lterm
let (RLam rbind) = rterm
(lv, lb, rv, rb) <- Unbound.unbind2Plus lbind rbind
return (lb, rb)
main :: IO ()
main = do
(l,r) <- test
-- this doesn't cause errors
let dl = force l
let dr = force r
-- this does
putStrLn $ show $ dl
putStrLn $ show $ dr
-- that's it
putStrLn "done"
Error
The error I'm getting while printing the right subterm is
LocallyNameless.open: inconsistent sorts
CallStack (from HasCallStack):
error, called at src/Unbound/Generics/LocallyNameless/Alpha.hs:717:20 in unbound-generics-0.4.2-B2j2SNQtM51IWCI7gQ83CW:Unbound.Generics.LocallyNameless.Alpha
Version
this is using GHC 9.02, but also works on at least 9.2.2
unbound-generics version is the current revision a2a5580
How to build the example
I have this example in a reproducible build. Here is a gist with all relevant files.