Commit 089b72f5 authored by Ryan Scott's avatar Ryan Scott Committed by Austin Seipp

DeriveLift extension (#1830)

Summary:
This implements -XDeriveLift, which allows for automatic derivation
of the Lift class from template-haskell. The implementation is based
off of Ian Lynagh's th-lift library
(http://hackage.haskell.org/package/th-lift).

Test Plan: ./validate

Reviewers: hvr, simonpj, bgamari, goldfire, austin

Reviewed By: goldfire, austin

Subscribers: osa1, thomie

Differential Revision: https://phabricator.haskell.org/D1168

GHC Trac Issues: #1830
parent d4d34a73
......@@ -613,6 +613,7 @@ data ExtensionFlag
| Opt_DeriveGeneric -- Allow deriving Generic/1
| Opt_DefaultSignatures -- Allow extra signatures for defmeths
| Opt_DeriveAnyClass -- Allow deriving any class
| Opt_DeriveLift -- Allow deriving Lift
| Opt_TypeSynonymInstances
| Opt_FlexibleContexts
......@@ -3133,6 +3134,7 @@ xFlags = [
flagSpec "DeriveFoldable" Opt_DeriveFoldable,
flagSpec "DeriveFunctor" Opt_DeriveFunctor,
flagSpec "DeriveGeneric" Opt_DeriveGeneric,
flagSpec "DeriveLift" Opt_DeriveLift,
flagSpec "DeriveTraversable" Opt_DeriveTraversable,
flagSpec "DisambiguateRecordFields" Opt_DisambiguateRecordFields,
flagSpec "DoAndIfThenElse" Opt_DoAndIfThenElse,
......
......@@ -599,6 +599,11 @@ minus_RDR = nameRdrName minusName
times_RDR = varQual_RDR gHC_NUM (fsLit "*")
plus_RDR = varQual_RDR gHC_NUM (fsLit "+")
toInteger_RDR, toRational_RDR, fromIntegral_RDR :: RdrName
toInteger_RDR = nameRdrName toIntegerName
toRational_RDR = nameRdrName toRationalName
fromIntegral_RDR = nameRdrName fromIntegralName
fromString_RDR :: RdrName
fromString_RDR = nameRdrName fromStringName
......@@ -1305,6 +1310,10 @@ knownSymbolClassNameKey = mkPreludeClassUnique 43
ghciIoClassKey :: Unique
ghciIoClassKey = mkPreludeClassUnique 44
---------------- Template Haskell -------------------
-- USES ClassUniques 200-299
-----------------------------------------------------
{-
************************************************************************
* *
......
......@@ -9,7 +9,8 @@ module THNames where
import PrelNames( mk_known_key_name )
import Module( Module, mkModuleNameFS, mkModule, thPackageKey )
import Name( Name )
import OccName( tcName, dataName, varName )
import OccName( tcName, clsName, dataName, varName )
import RdrName( RdrName, nameRdrName )
import Unique
import FastString
......@@ -122,6 +123,9 @@ templateHaskellNames = [
-- AnnTarget
valueAnnotationName, typeAnnotationName, moduleAnnotationName,
-- The type classes
liftClassName,
-- And the tycons
qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
......@@ -143,15 +147,19 @@ qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
mkTHModule :: FastString -> Module
mkTHModule m = mkModule thPackageKey (mkModuleNameFS m)
libFun, libTc, thFun, thTc, thCon, qqFun :: FastString -> Unique -> Name
libFun, libTc, thFun, thTc, thCls, thCon, qqFun :: FastString -> Unique -> Name
libFun = mk_known_key_name OccName.varName thLib
libTc = mk_known_key_name OccName.tcName thLib
thFun = mk_known_key_name OccName.varName thSyn
thTc = mk_known_key_name OccName.tcName thSyn
thCls = mk_known_key_name OccName.clsName thSyn
thCon = mk_known_key_name OccName.dataName thSyn
qqFun = mk_known_key_name OccName.varName qqLib
-------------------- TH.Syntax -----------------------
liftClassName :: Name
liftClassName = thCls (fsLit "Lift") liftClassKey
qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
......@@ -512,6 +520,12 @@ quotePatName = qqFun (fsLit "quotePat") quotePatKey
quoteDecName = qqFun (fsLit "quoteDec") quoteDecKey
quoteTypeName = qqFun (fsLit "quoteType") quoteTypeKey
-- ClassUniques available: 200-299
-- Check in PrelNames if you want to change this
liftClassKey :: Unique
liftClassKey = mkPreludeClassUnique 200
-- TyConUniques available: 200-299
-- Check in PrelNames if you want to change this
......@@ -873,3 +887,34 @@ valueAnnotationIdKey, typeAnnotationIdKey, moduleAnnotationIdKey :: Unique
valueAnnotationIdKey = mkPreludeMiscIdUnique 490
typeAnnotationIdKey = mkPreludeMiscIdUnique 491
moduleAnnotationIdKey = mkPreludeMiscIdUnique 492
{-
************************************************************************
* *
RdrNames
* *
************************************************************************
-}
lift_RDR, mkNameG_dRDR, mkNameG_vRDR :: RdrName
lift_RDR = nameRdrName liftName
mkNameG_dRDR = nameRdrName mkNameG_dName
mkNameG_vRDR = nameRdrName mkNameG_vName
-- data Exp = ...
conE_RDR, litE_RDR, appE_RDR, infixApp_RDR :: RdrName
conE_RDR = nameRdrName conEName
litE_RDR = nameRdrName litEName
appE_RDR = nameRdrName appEName
infixApp_RDR = nameRdrName infixAppName
-- data Lit = ...
stringL_RDR, intPrimL_RDR, wordPrimL_RDR, floatPrimL_RDR,
doublePrimL_RDR, stringPrimL_RDR, charPrimL_RDR :: RdrName
stringL_RDR = nameRdrName stringLName
intPrimL_RDR = nameRdrName intPrimLName
wordPrimL_RDR = nameRdrName wordPrimLName
floatPrimL_RDR = nameRdrName floatPrimLName
doublePrimL_RDR = nameRdrName doublePrimLName
stringPrimL_RDR = nameRdrName stringPrimLName
charPrimL_RDR = nameRdrName charPrimLName
......@@ -54,6 +54,7 @@ import TcType
import Var
import VarSet
import PrelNames
import THNames ( liftClassKey )
import SrcLoc
import Util
import Outputable
......@@ -1170,6 +1171,9 @@ sideConditions mtheta cls
| cls_key == gen1ClassKey = Just (checkFlag Opt_DeriveGeneric `andCond`
cond_vanilla `andCond`
cond_Representable1Ok)
| cls_key == liftClassKey = Just (checkFlag Opt_DeriveLift `andCond`
cond_vanilla `andCond`
cond_args cls)
| otherwise = Nothing
where
cls_key = getUnique cls
......@@ -1257,6 +1261,7 @@ cond_args cls (_, tc, _)
| cls_key == eqClassKey = check_in arg_ty ordOpTbl
| cls_key == ordClassKey = check_in arg_ty ordOpTbl
| cls_key == showClassKey = check_in arg_ty boxConTbl
| cls_key == liftClassKey = check_in arg_ty litConTbl
| otherwise = False -- Read, Ix etc
check_in :: Type -> [(Type,a)] -> Bool
......@@ -1355,20 +1360,20 @@ std_class_via_coercible :: Class -> Bool
-- because giving so gives the same results as generating the boilerplate
std_class_via_coercible clas
= classKey clas `elem` [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
-- Not Read/Show because they respect the type
-- Not Read/Show/Lift because they respect the type
-- Not Enum, because newtypes are never in Enum
non_coercible_class :: Class -> Bool
-- *Never* derive Read, Show, Typeable, Data, Generic, Generic1 by Coercible,
-- even with -XGeneralizedNewtypeDeriving
-- *Never* derive Read, Show, Typeable, Data, Generic, Generic1, Lift
-- by Coercible, even with -XGeneralizedNewtypeDeriving
-- Also, avoid Traversable, as the Coercible-derived instance and the "normal"-derived
-- instance behave differently if there's a non-lawful Applicative out there.
-- Besides, with roles, Coercible-deriving Traversable is ill-roled.
non_coercible_class cls
= classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey
, genClassKey, gen1ClassKey, typeableClassKey
, traversableClassKey ])
, traversableClassKey, liftClassKey ])
new_dfun_name :: Class -> TyCon -> TcM Name
new_dfun_name clas tycon -- Just a simple wrapper
......
......@@ -25,7 +25,7 @@ module TcGenDeriv (
mkCoerceClassMethEqn,
gen_Newtype_binds,
genAuxBinds,
ordOpTbl, boxConTbl,
ordOpTbl, boxConTbl, litConTbl,
mkRdrFunBind
) where
......@@ -44,6 +44,9 @@ import PrelInfo
import FamInstEnv( FamInst )
import MkCore ( eRROR_ID )
import PrelNames hiding (error_RDR)
import THNames
import Module ( moduleName, moduleNameString
, modulePackageKey, packageKeyString )
import MkId ( coerceId )
import PrimOp
import SrcLoc
......@@ -130,8 +133,8 @@ genDerivedBinds dflags fix_env clas loc tycon
, (dataClassKey, gen_Data_binds dflags)
, (functorClassKey, gen_Functor_binds)
, (foldableClassKey, gen_Foldable_binds)
, (traversableClassKey, gen_Traversable_binds) ]
, (traversableClassKey, gen_Traversable_binds)
, (liftClassKey, gen_Lift_binds) ]
-- Nothing: we can (try to) derive it via Generics
-- Just s: we can't, reason s
......@@ -1884,6 +1887,90 @@ gen_Traversable_binds loc tycon
mkApCon con (x:xs) = foldl appAp (nlHsApps fmap_RDR [con,x]) xs
where appAp x y = nlHsApps ap_RDR [x,y]
{-
************************************************************************
* *
Lift instances
* *
************************************************************************
Example:
data Foo a = Foo a | a :^: a deriving Lift
==>
instance (Lift a) => Lift (Foo a) where
lift (Foo a)
= appE
(conE
(mkNameG_d "package-name" "ModuleName" "Foo"))
(lift a)
lift (u :^: v)
= infixApp
(lift u)
(conE
(mkNameG_d "package-name" "ModuleName" ":^:"))
(lift v)
Note that (mkNameG_d "package-name" "ModuleName" "Foo") is equivalent to what
'Foo would be when using the -XTemplateHaskell extension. To make sure that
-XDeriveLift can be used on stage-1 compilers, however, we expliticly invoke
makeG_d.
-}
gen_Lift_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
gen_Lift_binds loc tycon
| null data_cons = (unitBag (L loc $ mkFunBind (L loc lift_RDR)
[mkMatch [nlWildPat] errorMsg_Expr emptyLocalBinds])
, emptyBag)
| otherwise = (unitBag lift_bind, emptyBag)
where
errorMsg_Expr = nlHsVar error_RDR `nlHsApp` nlHsLit
(mkHsString $ "Can't lift value of empty datatype " ++ tycon_str)
lift_bind = mk_FunBind loc lift_RDR (map pats_etc data_cons)
data_cons = tyConDataCons tycon
tycon_str = occNameString . nameOccName . tyConName $ tycon
pats_etc data_con
= ([con_pat], lift_Expr)
where
con_pat = nlConVarPat data_con_RDR as_needed
data_con_RDR = getRdrName data_con
con_arity = dataConSourceArity data_con
as_needed = take con_arity as_RDRs
lifted_as = zipWithEqual "mk_lift_app" mk_lift_app
tys_needed as_needed
tycon_name = tyConName tycon
is_infix = dataConIsInfix data_con
tys_needed = dataConOrigArgTys data_con
mk_lift_app ty a
| not (isUnLiftedType ty) = nlHsApp (nlHsVar lift_RDR)
(nlHsVar a)
| otherwise = nlHsApp (nlHsVar litE_RDR)
(primLitOp (mkBoxExp (nlHsVar a)))
where (primLitOp, mkBoxExp) = primLitOps "Lift" tycon ty
pkg_name = packageKeyString . modulePackageKey
. nameModule $ tycon_name
mod_name = moduleNameString . moduleName . nameModule $ tycon_name
con_name = occNameString . nameOccName . dataConName $ data_con
conE_Expr = nlHsApp (nlHsVar conE_RDR)
(nlHsApps mkNameG_dRDR
(map (nlHsLit . mkHsString)
[pkg_name, mod_name, con_name]))
lift_Expr
| is_infix = nlHsApps infixApp_RDR [a1, conE_Expr, a2]
| otherwise = foldl mk_appE_app conE_Expr lifted_as
(a1:a2:_) = lifted_as
mk_appE_app :: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
mk_appE_app a b = nlHsApps appE_RDR [a, b]
{-
************************************************************************
* *
......@@ -2106,6 +2193,20 @@ primOrdOps :: String -- The class involved
-- See Note [Deriving and unboxed types] in TcDeriv
primOrdOps str tycon ty = assoc_ty_id str tycon ordOpTbl ty
primLitOps :: String -- The class involved
-> TyCon -- The tycon involved
-> Type -- The type
-> ( LHsExpr RdrName -> LHsExpr RdrName -- Constructs a Q Exp value
, LHsExpr RdrName -> LHsExpr RdrName -- Constructs a boxed value
)
primLitOps str tycon ty = ( assoc_ty_id str tycon litConTbl ty
, \v -> nlHsVar boxRDR `nlHsApp` v
)
where
boxRDR
| ty == addrPrimTy = unpackCString_RDR
| otherwise = assoc_ty_id str tycon boxConTbl ty
ordOpTbl :: [(Type, (RdrName, RdrName, RdrName, RdrName, RdrName))]
ordOpTbl
= [(charPrimTy , (ltChar_RDR , leChar_RDR , eqChar_RDR , geChar_RDR , gtChar_RDR ))
......@@ -2134,6 +2235,26 @@ postfixModTbl
,(doublePrimTy, "##")
]
litConTbl :: [(Type, LHsExpr RdrName -> LHsExpr RdrName)]
litConTbl
= [(charPrimTy , nlHsApp (nlHsVar charPrimL_RDR))
,(intPrimTy , nlHsApp (nlHsVar intPrimL_RDR)
. nlHsApp (nlHsVar toInteger_RDR))
,(wordPrimTy , nlHsApp (nlHsVar wordPrimL_RDR)
. nlHsApp (nlHsVar toInteger_RDR))
,(addrPrimTy , nlHsApp (nlHsVar stringPrimL_RDR)
. nlHsApp (nlHsApp
(nlHsVar map_RDR)
(compose_RDR `nlHsApps`
[ nlHsVar fromIntegral_RDR
, nlHsVar fromEnum_RDR
])))
,(floatPrimTy , nlHsApp (nlHsVar floatPrimL_RDR)
. nlHsApp (nlHsVar toRational_RDR))
,(doublePrimTy, nlHsApp (nlHsVar doublePrimL_RDR)
. nlHsApp (nlHsVar toRational_RDR))
]
-- | Lookup `Type` in an association list.
assoc_ty_id :: String -- The class involved
-> TyCon -- The tycon involved
......
......@@ -225,6 +225,13 @@
recognized and documented in <xref linkend="th-syntax"/>.
</para>
</listitem>
<listitem>
<para>
The <literal>Lift</literal> class is now derivable via
the <option>-XDeriveLift</option> extension. See
<xref linkend="deriving-lift"/> for more information.
</para>
</listitem>
</itemizedlist>
</sect3>
......
......@@ -904,6 +904,12 @@
<entry><option>-XNoDeriveGeneric</option></entry>
<entry>7.2.1</entry>
</row>
<row>
<entry><option>-XDeriveLift</option></entry>
<entry>Enable <link linkend="deriving-lift">deriving for the Lift class</link>.</entry>
<entry>dynamic</entry>
<entry><option>-XNoDeriveLift</option></entry>
</row>
<row>
<entry><option>-XDeriveTraversable</option></entry>
<entry>Enable <link linkend="deriving-extra">deriving for the Traversable class</link>.
......
......@@ -4222,6 +4222,13 @@ instance dictates the instances of <literal>Functor</literal> and
<option>-XDeriveFunctor</option> and <option>-XDeriveFoldable</option>.
See <xref linkend="deriving-traversable"/>.
</para></listitem>
<listitem><para> With <option>-XDeriveLift</option>, you can derive instances
of the class <literal>Lift</literal>, defined in the
<literal>Language.Haskell.TH.Syntax</literal> module of the
<literal>template-haskell</literal> package.
See <xref linkend="deriving-lift"/>.
</para></listitem>
</itemizedlist>
You can also use a standalone deriving declaration instead
(see <xref linkend="stand-alone-deriving"/>).
......@@ -4546,6 +4553,84 @@ instance Typeable "Hello" -- Type-level symbols
</sect2>
<sect2 id="deriving-lift">
<title>Deriving <literal>Lift</literal> instances</title>
<para>The class <literal>Lift</literal>, unlike other derivable classes, lives
in <literal>template-haskell</literal> instead of <literal>base</literal>.
Having a data type be an instance of <literal>Lift</literal> permits its values
to be promoted to Template Haskell expressions (of type
<literal>ExpQ</literal>), which can then be spliced into Haskell source code.
</para>
<para>Here is an example of how one can derive <literal>Lift</literal>:
<programlisting>
{-# LANGUAGE DeriveLift #-}
module Bar where
import Language.Haskell.TH.Syntax
data Foo a = Foo a | a :^: a deriving Lift
{-
instance (Lift a) => Lift (Foo a) where
lift (Foo a)
= appE
(conE
(mkNameG_d "package-name" "Bar" "Foo"))
(lift a)
lift (u :^: v)
= infixApp
(lift u)
(conE
(mkNameG_d "package-name" "Bar" ":^:"))
(lift v)
-}
-----
{-# LANGUAGE TemplateHaskell #-}
module Baz where
import Bar
import Language.Haskell.TH.Lift
foo :: Foo String
foo = $(lift $ Foo "foo")
fooExp :: Lift a => Foo a -> Q Exp
fooExp f = [| f |]
</programlisting>
<option>-XDeriveLift</option> also works for certain unboxed types
(<literal>Addr#</literal>, <literal>Char#</literal>,
<literal>Double#</literal>, <literal>Float#</literal>,
<literal>Int#</literal>, and <literal>Word#</literal>):
<programlisting>
{-# LANGUAGE DeriveLift, MagicHash #-}
module Unboxed where
import GHC.Exts
import Language.Haskell.TH.Syntax
data IntHash = IntHash Int# deriving Lift
{-
instance Lift IntHash where
lift (IntHash i)
= appE
(conE
(mkNameG_d "package-name" "Unboxed" "IntHash"))
(litE
(intPrimL (toInteger (I# i))))
-}
</programlisting>
</para>
</sect2>
<sect2 id="newtype-deriving">
<title>Generalised derived instances for newtypes</title>
......@@ -10042,6 +10127,70 @@ Wiki page</ulink>.
</para>
</listitem>
<listitem>
<para>
It is possible for a splice to expand to an expression that contain
names which are not in scope at the site of the splice. As an
example, consider the following code:
<programlisting>
module Bar where
import Language.Haskell.TH
add1 :: Int -> Q Exp
add1 x = [| x + 1 |]
</programlisting>
Now consider a splice using <literal>add1</literal> in a separate
module:
<programlisting>
module Foo where
import Bar
two :: Int
two = $(add1 1)
</programlisting>
Template Haskell cannot know what the argument to
<literal>add1</literal> will be at the function's definition site, so
a lifting mechanism is used to promote <literal>x</literal> into a
value of type <literal>Q Exp</literal>. This functionality is exposed
to the user as the <literal>Lift</literal> typeclass in the
<literal>Language.Haskell.TH.Syntax</literal> module. If a type has a
<literal>Lift</literal> instance, then any of its values can be
lifted to a Template Haskell expression:
<programlisting>
class Lift t where
lift :: t -> Q Exp
</programlisting>
In general, if GHC sees an expression within Oxford brackets (e.g.,
<literal>[| foo bar |]</literal>, then GHC looks up each name within
the brackets. If a name is global (e.g., suppose
<literal>foo</literal> comes from an import or a top-level
declaration), then the fully qualified name is used directly in the
quotation. If the name is local (e.g., suppose <literal>bar</literal>
is bound locally in the function definition
<literal>mkFoo bar = [| foo bar |]</literal>), then GHC uses
<literal>lift</literal> on it (so GHC pretends
<literal>[| foo bar |]</literal> actually contains
<literal>[| foo $(lift bar) |]</literal>). Local names, which are not
in scope at splice locations, are actually evaluated when the
quotation is processed.
The <literal>template-haskell</literal> library provides
<literal>Lift</literal> instances for many common data types.
Furthermore, it is possible to derive <literal>Lift</literal>
instances automatically by using the <option>-XDeriveLift</option>
language extension. See <xref linkend="deriving-lift" /> for more
information.
</para>
</listitem>
<listitem><para> You may omit the <literal>$(...)</literal> in a top-level declaration splice.
Simply writing an expression (rather than a declaration) implies a splice. For example, you can write
<programlisting>
......
......@@ -470,7 +470,30 @@ sequenceQ = sequence
--
-----------------------------------------------------
-- | A 'Lift' instance can have any of its values turned into a Template
-- Haskell expression. This is needed when a value used within a Template
-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@) but not
-- at the top level. As an example:
--
-- > add1 :: Int -> Q Exp
-- > add1 x = [| x + 1 |]
--
-- Template Haskell has no way of knowing what value @x@ will take on at
-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.
--
-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@
-- GHC language extension:
--
-- > {-# LANGUAGE DeriveLift #-}
-- > module Foo where
-- >
-- > import Language.Haskell.TH.Syntax
-- >
-- > data Bar a = Bar1 a (Bar a) | Bar2 String
-- > deriving Lift
class Lift t where
-- | Turn a value into a Template Haskell expression, suitable for use in
-- a splice.
lift :: t -> Q Exp
default lift :: Data t => t -> Q Exp
lift = liftData
......
{-# LANGUAGE DeriveLift #-}
module T1830 where
import Language.Haskell.TH.Syntax (Lift)
data Nothing deriving Lift
......@@ -16,6 +16,7 @@ test('drv015', normal, compile, [''])
test('drv020', normal, compile, [''])
test('drv022', normal, compile, [''])
test('deriving-1935', normal, compile, [''])
test('T1830', normal, compile, [''])
test('T2378', normal, compile, [''])
test('T2856', normal, compile, [''])
test('T3057', extra_clean(['T3057A.o', 'T3057A.hi']), multimod_compile, ['T3057', '-v0'])
......
module T1830 where
import Language.Haskell.TH.Syntax (Lift)
data Foo a = Foo a deriving Lift
T1830.hs:5:29: error:
Can't make a derived instance of ‘Lift (Foo a)’:
You need DeriveLift to derive an instance for this class
In the data declaration for ‘Foo’
......@@ -16,6 +16,7 @@ test('drvfail016',
extra_clean(['drvfail016.hi-boot', 'drvfail016.o-boot']),
run_command,
['$MAKE --no-print-directory -s drvfail016'])
test('T1830', normal, compile_fail, [''])
test('T2394', normal, compile_fail, [''])
# T2604 was removed as it was out of date re: fixing #9858
test('T2701', normal, compile_fail, [''])
......
......@@ -35,7 +35,8 @@ expectedGhcOnlyExtensions = ["RelaxedLayout",
"AlternativeLayoutRuleTransitional",
"StaticPointers",
"StrictData",
"ApplicativeDo"] -- TODO add this to Cabal
"ApplicativeDo",
"DeriveLift"] -- TODO add this to Cabal
expectedCabalOnlyExtensions :: [String]
expectedCabalOnlyExtensions = ["Generics",
......
{-# LANGUAGE TemplateHaskell #-}
module Main where
import Language.Haskell.TH.Syntax (lift)
import T1830a
main :: IO ()
main = do
print ($(lift algDT1) == algDT1)
print ($(lift algDT2) == algDT2)
print ($(lift algDT3) == algDT3)
print ($(lift prim) == prim)
print ($(lift df1) == df1)
print ($(lift df2) == df2)
print ($(lift df3) == df3)