on master help sign in
Merge pull request #2251 from Melvar/remove-prefl

Remove PRefl and PEq

commitf07ac4893b7bf69361d0e1b69b515fe2e3e7cb1b authorDavid Christiansen <david@davidchristiansen.dk> dateTue 12 May 2015, 09:49 (11 years ago) parent75e386353e1281
19 files changed+23−141
src/Idris/AbsSyntax.hs−22 src/Idris/AbsSyntaxTree.hs+15−28 src/Idris/CaseSplit.hs−2 src/Idris/DSL.hs−3 src/Idris/DeepSeq.hs−2 src/Idris/Delaborate.hs−33 src/Idris/Elab/Clause.hs+1−1 src/Idris/Elab/Term.hs+1−8 src/Idris/ElabQuasiquote.hs−9 src/Idris/Error.hs−3 src/Idris/IBC.hs−18 src/Idris/IdrisDoc.hs−2 src/Idris/ParseExpr.hs−4 src/Idris/ParseOps.hs+1−1 src/Idris/ProofSearch.hs+1−1 test/reg037/reg037.idr+1−1 test/reg047/reg047.idr+1−1 test/reg047/reg047a.idr+1−1 test/reg056/reg056.idr+1−1
src/Idris/AbsSyntax.hs−22
@@ -972,7 +972,6 @@ expandParams dec ps ns infs tm = en tm
972972 | n `elem` (map fst ps ++ ns) && t /= Placeholder
973973 = let n' = mkShadow n in
974974 PDPair f p (PRef f' n') (en t) (en (shadow n n' r))
975− en (PEq f lt rt l r) = PEq f (en lt) (en rt) (en l) (en r)
976975 en (PRewrite f l r g) = PRewrite f (en l) (en r) (fmap en g)
977976 en (PTyped l r) = PTyped (en l) (en r)
978977 en (PPair f p l r) = PPair f p (en l) (en r)
@@ -1140,8 +1139,6 @@ getPriority i tm = 1 -- pri tm
11401139 [] -> 0 -- must be locally bound, if it's not an error...
11411140 pri (PPi _ _ x y) = max 5 (max (pri x) (pri y))
11421141 pri (PTrue _ _) = 0
1143− pri (PRefl _ _) = 1
1144− pri (PEq _ _ _ l r) = max 1 (max (pri l) (pri r))
11451142 pri (PRewrite _ l r _) = max 1 (max (pri l) (pri r))
11461143 pri (PApp _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.getTm) as)))
11471144 pri (PAppBind _ f as) = max 1 (max (pri f) (foldr max 0 (map (pri.getTm) as)))
@@ -1451,10 +1448,6 @@ implicitise syn ignore ist tm = -- trace ("INCOMING " ++ showImp True tm) $
14511448 put (PTacImplicit 10 l n scr Placeholder : decls,
14521449 nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))
14531450 imps True (n:env) sc
1454− imps top env (PEq _ _ _ l r)
1455− = do (decls, ns) <- get
1456− let isn = namesIn uvars ist l ++ namesIn uvars ist r
1457− put (decls, nub (ns ++ (isn `dropAll` (env ++ map fst (getImps decls)))))
14581451 imps top env (PRewrite _ l r _)
14591452 = do (decls, ns) <- get
14601453 let isn = namesIn uvars ist l ++ namesIn uvars ist r
@@ -1524,12 +1517,6 @@ addImpl' inpat env infns imp_meths ist ptm
15241517 | not (f `elem` map fst env) = handleErr $ aiFn inpat inpat qq imp_meths ist fc f ds []
15251518 ai qq env ds (PHidden (PRef fc f))
15261519 | not (f `elem` map fst env) = PHidden (handleErr $ aiFn inpat False qq imp_meths ist fc f ds [])
1527− ai qq env ds (PEq fc lt rt l r)
1528− = let lt' = ai qq env ds lt
1529− rt' = ai qq env ds rt
1530− l' = ai qq env ds l
1531− r' = ai qq env ds r in
1532− PEq fc lt' rt' l' r'
15331520 ai qq env ds (PRewrite fc l r g)
15341521 = let l' = ai qq env ds l
15351522 r' = ai qq env ds r
@@ -1608,7 +1595,6 @@ addImpl' inpat env infns imp_meths ist ptm
16081595 ai qq env ds (PHidden tm) = PHidden (ai qq env ds tm)
16091596 -- Don't do PProof or PTactics since implicits get added when scope is
16101597 -- properly known in ElabTerm.runTac
1611− ai qq env ds (PRefl fc tm) = PRefl fc (ai qq env ds tm)
16121598 ai qq env ds (PUnifyLog tm) = PUnifyLog (ai qq env ds tm)
16131599 ai qq env ds (PNoImplicits tm) = PNoImplicits (ai qq env ds tm)
16141600 ai qq env ds (PQuasiquote tm g) = PQuasiquote (ai True env ds tm)
@@ -1815,7 +1801,6 @@ stripUnmatchable i (PApp fc fn args) = PApp fc fn (fmap (fmap su) args) where
18151801 su (PDPair fc p l t r) = PDPair fc p (su l) (su t) (su r)
18161802 su t@(PLam fc _ _ _) = PHidden t
18171803 su t@(PPi _ _ _ _) = PHidden t
1818− su t@(PEq _ _ _ _ _) = PHidden t
18191804 su t = t
18201805
18211806 ctxt = tt_ctxt i
@@ -1918,10 +1903,6 @@ matchClause' names i x y = checkRpts $ match (fullApp x) (fullApp y) where
19181903 | not names && (not (isConName n (tt_ctxt i) ||
19191904 isFnName n (tt_ctxt i)) || tm == Placeholder)
19201905 = return [(n, tm)]
1921− match (PEq _ _ _ l r) (PEq _ _ _ l' r')
1922− = do ml <- match' l l'
1923− mr <- match' r r'
1924− return (ml ++ mr)
19251906 match (PRewrite _ l r _) (PRewrite _ l' r' _)
19261907 = do ml <- match' l l'
19271908 mr <- match' r r'
@@ -1952,7 +1933,6 @@ matchClause' names i x y = checkRpts $ match (fullApp x) (fullApp y) where
19521933 match (PQuote _) _ = return []
19531934 match (PProof _) _ = return []
19541935 match (PTactics _) _ = return []
1955− match (PRefl _ _) (PRefl _ _) = return []
19561936 match (PResolveTC _) (PResolveTC _) = return []
19571937 match (PTrue _ _) (PTrue _ _) = return []
19581938 match (PReturn _) (PReturn _) = return []
@@ -2018,7 +1998,6 @@ substMatchShadow n shs tm t = sm shs t where
20181998 sm xs (PApp f x as) = fullApp $ PApp f (sm xs x) (map (fmap (sm xs)) as)
20191999 sm xs (PCase f x as) = PCase f (sm xs x) (map (pmap (sm xs)) as)
20202000 sm xs (PIfThenElse fc c t f) = PIfThenElse fc (sm xs c) (sm xs t) (sm xs f)
2021− sm xs (PEq f xt yt x y) = PEq f (sm xs xt) (sm xs yt) (sm xs x) (sm xs y)
20222001 sm xs (PRewrite f x y tm) = PRewrite f (sm xs x) (sm xs y)
20232002 (fmap (sm xs) tm)
20242003 sm xs (PTyped x y) = PTyped (sm xs x) (sm xs y)
@@ -2047,7 +2026,6 @@ shadow n n' t = sm t where
20472026 sm (PAppBind f x as) = PAppBind f (sm x) (map (fmap sm) as)
20482027 sm (PCase f x as) = PCase f (sm x) (map (pmap sm) as)
20492028 sm (PIfThenElse fc c t f) = PIfThenElse fc (sm c) (sm t) (sm f)
2050− sm (PEq f xt yt x y) = PEq f (sm xt) (sm yt) (sm x) (sm y)
20512029 sm (PRewrite f x y tm) = PRewrite f (sm x) (sm y) (fmap sm tm)
20522030 sm (PTyped x y) = PTyped (sm x) (sm y)
20532031 sm (PPair f p x y) = PPair f p (sm x) (sm y)
src/Idris/AbsSyntaxTree.hs+15−28
@@ -818,9 +818,7 @@ data PTerm = PQuote Raw -- ^ Inclusion of a core term into the high-level langua
818818 | PIfThenElse FC PTerm PTerm PTerm -- ^ Conditional expressions - elaborated to an overloading of ifThenElse
819819 | PCase FC PTerm [(PTerm, PTerm)] -- ^ A case expression. Args are source location, scrutinee, and a list of pattern/RHS pairs
820820 | PTrue FC PunInfo -- ^ Unit type..?
821− | PRefl FC PTerm -- ^ The canonical proof of the equality type
822821 | PResolveTC FC -- ^ Solve this dictionary by type class resolution
823− | PEq FC PTerm PTerm PTerm PTerm -- ^ Heterogeneous equality type: A = B
824822 | PRewrite FC PTerm PTerm (Maybe PTerm) -- ^ "rewrite" syntax, with optional result type
825823 | PPair FC PunInfo PTerm PTerm -- ^ A pair (a, b) and whether it's a product type or a pair (solved by elaboration)
826824 | PDPair FC PunInfo PTerm PTerm PTerm -- ^ A dependent pair (tm : a ** b) and whether it's a sigma type or a pair that inhabits one (solved by elaboration)
@@ -867,7 +865,6 @@ mapPT f t = f (mpt t) where
867865 mpt (PAppBind fc t as) = PAppBind fc (mapPT f t) (map (fmap (mapPT f)) as)
868866 mpt (PCase fc c os) = PCase fc (mapPT f c) (map (pmap (mapPT f)) os)
869867 mpt (PIfThenElse fc c t e) = PIfThenElse fc (mapPT f c) (mapPT f t) (mapPT f e)
870− mpt (PEq fc lt rt l r) = PEq fc (mapPT f lt) (mapPT f rt) (mapPT f l) (mapPT f r)
871868 mpt (PTyped l r) = PTyped (mapPT f l) (mapPT f r)
872869 mpt (PPair fc p l r) = PPair fc p (mapPT f l) (mapPT f r)
873870 mpt (PDPair fc p l t r) = PDPair fc p (mapPT f l) (mapPT f t) (mapPT f r)
@@ -1027,9 +1024,7 @@ highestFC (PMatchApp fc _) = Just fc
10271024highestFC (PCase fc _ _) = Just fc
10281025highestFC (PIfThenElse fc _ _ _) = Just fc
10291026highestFC (PTrue fc _) = Just fc
1030−highestFC (PRefl fc _) = Just fc
10311027highestFC (PResolveTC fc) = Just fc
1032−highestFC (PEq fc _ _ _ _) = Just fc
10331028highestFC (PRewrite fc _ _ _) = Just fc
10341029highestFC (PPair fc _ _ _) = Just fc
10351030highestFC (PDPair fc _ _ _ _) = Just fc
@@ -1481,6 +1476,21 @@ pprintPTerm ppo bnd docArgs infixes = prettySe startPrec bnd
14811476 bracket p startPrec $
14821477 lbrace <> kwd "tacimp" <+> pretty n <+> colon <+> prettySe startPrec bnd ty <>
14831478 rbrace <+> text "->" </> prettySe startPrec ((n, True):bnd) sc
1479+ -- This case preserves the behavior of the former constructor PEq.
1480+ -- It should be removed if feasible when the pretty-printing of infix
1481+ -- operators in general is improved.
1482+ prettySe p bnd (PApp _ (PRef _ n) [lt, rt, l, r])
1483+ | n == eqTy, ppopt_impl ppo =
1484+ bracket p eqPrec $
1485+ enclose lparen rparen eq <+>
1486+ align (group (vsep (map (prettyArgS bnd)
1487+ [lt, rt, l, r])))
1488+ | n == eqTy =
1489+ bracket p eqPrec . align . group $
1490+ prettyTerm (getTm l) <+> eq <$> group (prettyTerm (getTm r))
1491+ where eq = annName eqTy (text "=")
1492+ eqPrec = startPrec
1493+ prettyTerm = prettySe (eqPrec + 1) bnd
14841494 prettySe p bnd (PApp _ (PRef _ f) args) -- normal names, no explicit args
14851495 | UN nm <- basename f
14861496 , not (ppopt_impl ppo) && null (getShowArgs args) =
@@ -1556,26 +1566,10 @@ pprintPTerm ppo bnd docArgs infixes = prettySe startPrec bnd
15561566 , kwd "else" <+> prettySe startPrec bnd f
15571567 ]
15581568 prettySe p bnd (PHidden tm) = text "." <> prettySe funcAppPrec bnd tm
1559− prettySe p bnd (PRefl _ _) = annName eqCon $ text "Refl"
15601569 prettySe p bnd (PResolveTC _) = kwd "%instance"
15611570 prettySe p bnd (PTrue _ IsType) = annName unitTy $ text "()"
15621571 prettySe p bnd (PTrue _ IsTerm) = annName unitCon $ text "()"
15631572 prettySe p bnd (PTrue _ TypeOrTerm) = text "()"
1564− prettySe p bnd (PEq _ lt rt l r)
1565− | ppopt_impl ppo =
1566− bracket p eqPrec $
1567− enclose lparen rparen eq <+>
1568− align (group (vsep (map (prettyArgS bnd)
1569− [PImp 0 False [] (sUN "A") lt,
1570− PImp 0 False [] (sUN "B") rt,
1571− PExp 0 [] (sUN "x") l,
1572− PExp 0 [] (sUN "y") r])))
1573− | otherwise =
1574− bracket p eqPrec . align . group $
1575− prettyTerm l <+> eq <$> group (prettyTerm r)
1576− where eq = annName eqTy (text "=")
1577− eqPrec = startPrec
1578− prettyTerm = prettySe (eqPrec + 1) bnd
15791573 prettySe p bnd (PRewrite _ l r _) =
15801574 bracket p startPrec $
15811575 text "rewrite" <+> prettySe (startPrec + 1) bnd l <+> text "in" <+> prettySe startPrec bnd r
@@ -1872,9 +1866,7 @@ instance Sized PTerm where
18721866 size (PCase fc trm bdy) = 1 + size trm + size bdy
18731867 size (PIfThenElse fc c t f) = 1 + sum (map size [c, t, f])
18741868 size (PTrue fc _) = 1
1875− size (PRefl fc _) = 1
18761869 size (PResolveTC fc) = 1
1877− size (PEq fc _ _ left right) = 1 + size left + size right
18781870 size (PRewrite fc left right _) = 1 + size left + size right
18791871 size (PPair fc _ left right) = 1 + size left + size right
18801872 size (PDPair fs _ left ty right) = 1 + size left + size ty + size right
@@ -1915,7 +1907,6 @@ allNamesIn tm = nub $ ni [] tm
19151907 ni env (PLam fc n ty sc) = ni env ty ++ ni (n:env) sc
19161908 ni env (PPi p n ty sc) = niTacImp env p ++ ni env ty ++ ni (n:env) sc
19171909 ni env (PHidden tm) = ni env tm
1918− ni env (PEq _ _ _ l r) = ni env l ++ ni env r
19191910 ni env (PRewrite _ l r _) = ni env l ++ ni env r
19201911 ni env (PTyped l r) = ni env l ++ ni env r
19211912 ni env (PPair _ _ l r) = ni env l ++ ni env r
@@ -1942,7 +1933,6 @@ boundNamesIn tm = S.toList (ni S.empty tm)
19421933 ni set (PLam fc n ty sc) = S.insert n $ ni (ni set ty) sc
19431934 ni set (PLet fc n ty val sc) = S.insert n $ ni (ni (ni set ty) val) sc
19441935 ni set (PPi p n ty sc) = niTacImp (S.insert n $ ni (ni set ty) sc) p
1945− ni set (PEq _ _ _ l r) = ni (ni set l) r
19461936 ni set (PRewrite _ l r _) = ni (ni set l) r
19471937 ni set (PTyped l r) = ni (ni set l) r
19481938 ni set (PPair _ _ l r) = ni (ni set l) r
@@ -1982,7 +1972,6 @@ implicitNamesIn uvars ist tm = nub $ ni [] tm
19821972 ni env (PIfThenElse _ c t f) = concatMap (ni env) [c, t, f]
19831973 ni env (PLam fc n ty sc) = ni env ty ++ ni (n:env) sc
19841974 ni env (PPi p n ty sc) = ni env ty ++ ni (n:env) sc
1985− ni env (PEq _ _ _ l r) = ni env l ++ ni env r
19861975 ni env (PRewrite _ l r _) = ni env l ++ ni env r
19871976 ni env (PTyped l r) = ni env l ++ ni env r
19881977 ni env (PPair _ _ l r) = ni env l ++ ni env r
@@ -2013,7 +2002,6 @@ namesIn uvars ist tm = nub $ ni [] tm
20132002 ni env (PIfThenElse _ c t f) = concatMap (ni env) [c, t, f]
20142003 ni env (PLam fc n ty sc) = ni env ty ++ ni (n:env) sc
20152004 ni env (PPi p n ty sc) = niTacImp env p ++ ni env ty ++ ni (n:env) sc
2016− ni env (PEq _ _ _ l r) = ni env l ++ ni env r
20172005 ni env (PRewrite _ l r _) = ni env l ++ ni env r
20182006 ni env (PTyped l r) = ni env l ++ ni env r
20192007 ni env (PPair _ _ l r) = ni env l ++ ni env r
@@ -2045,7 +2033,6 @@ usedNamesIn vars ist tm = nub $ ni [] tm
20452033 ni env (PIfThenElse _ c t f) = concatMap (ni env) [c, t, f]
20462034 ni env (PLam fc n ty sc) = ni env ty ++ ni (n:env) sc
20472035 ni env (PPi p n ty sc) = niTacImp env p ++ ni env ty ++ ni (n:env) sc
2048− ni env (PEq _ _ _ l r) = ni env l ++ ni env r
20492036 ni env (PRewrite _ l r _) = ni env l ++ ni env r
20502037 ni env (PTyped l r) = ni env l ++ ni env r
20512038 ni env (PPair _ _ l r) = ni env l ++ ni env r
src/Idris/CaseSplit.hs−2
@@ -240,7 +240,6 @@ replaceVar ctxt n t (PApp fc f pats) = PApp fc f (map substArg pats)
240240 subst (PApp fc (PRef _ t) pats)
241241 | isTConName t ctxt = Placeholder -- infer types
242242 subst (PApp fc f pats) = PApp fc f (map substArg pats)
243− subst (PEq fc _ _ l r) = Placeholder -- PEq fc (subst l) (subst r)
244243 subst x = x
245244
246245 substArg arg = arg { getTm = subst (getTm arg) }
@@ -361,7 +360,6 @@ getClause l fn fp
361360 getNameFrom i used (PPi _ _ _ _)
362361 = uniqueNameFrom (mkSupply [sUN "f", sUN "g"]) used
363362 getNameFrom i used (PApp fc f as) = getNameFrom i used f
364− getNameFrom i used (PEq _ _ _ _ _) = uniqueNameFrom (mkSupply [sUN "prf"]) used
365363 getNameFrom i used (PRef fc f)
366364 = case getNameHints i f of
367365 [] -> uniqueName (sUN "x") used
src/Idris/DSL.hs−3
@@ -77,8 +77,6 @@ expandSugar dsl (PIfThenElse fc c t f) =
7777 , PExp 0 [] (sMN 0 "whenTrue") $ expandSugar dsl t
7878 , PExp 0 [] (sMN 0 "whenFalse") $ expandSugar dsl f
7979 ]
80−expandSugar dsl (PEq fc lt rt l r) = PEq fc (expandSugar dsl lt) (expandSugar dsl rt)
81− (expandSugar dsl l) (expandSugar dsl r)
8280expandSugar dsl (PPair fc p l r) = PPair fc p (expandSugar dsl l) (expandSugar dsl r)
8381expandSugar dsl (PDPair fc p l t r) = PDPair fc p (expandSugar dsl l) (expandSugar dsl t)
8482 (expandSugar dsl r)
@@ -139,7 +137,6 @@ var dsl n t i = v' i t where
139137 v' i (PTyped l r) = PTyped (v' i l) (v' i r)
140138 v' i (PApp f x as) = PApp f (v' i x) (fmap (fmap (v' i)) as)
141139 v' i (PCase f t as) = PCase f (v' i t) (fmap (pmap (v' i)) as)
142− v' i (PEq f lt rt l r) = PEq f (v' i lt) (v' i rt) (v' i l) (v' i r)
143140 v' i (PPair f p l r) = PPair f p (v' i l) (v' i r)
144141 v' i (PDPair f p l t r) = PDPair f p (v' i l) (v' i t) (v' i r)
145142 v' i (PAlternative a as) = PAlternative a $ map (v' i) as
src/Idris/DeepSeq.hs−2
@@ -219,9 +219,7 @@ instance NFData PTerm where
219219 rnf (PCase x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` ()
220220 rnf (PIfThenElse x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
221221 rnf (PTrue x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
222− rnf (PRefl x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
223222 rnf (PResolveTC x1) = rnf x1 `seq` ()
224− rnf (PEq x1 x2 x3 x4 x5) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` rnf x5 `seq` ()
225223 rnf (PRewrite x1 x2 x3 x4)
226224 = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
227225 rnf (PPair x1 x2 x3 x4) = rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` rnf x4 `seq` ()
src/Idris/Delaborate.hs−33
@@ -107,7 +107,6 @@ delabTy' ist imps tm fullname mvs = de [] imps tm
107107 deFn env (App _ f a) args = deFn env f (a:args)
108108 deFn env (P _ n _) [l,r]
109109 | n == pairTy = PPair un IsType (de env [] l) (de env [] r)
110− | n == eqCon = PRefl un (de env [] r)
111110 | n == sUN "lazy" = de env [] r -- TODO: Fix string based matching
112111 deFn env (P _ n _) [ty, Bind x (Lam _) r]
113112 | n == sigmaTy
@@ -115,8 +114,6 @@ delabTy' ist imps tm fullname mvs = de [] imps tm
115114 (de ((x,x):env) [] (instantiate (P Bound x ty) r))
116115 deFn env (P _ n _) [lt,rt,l,r]
117116 | n == pairCon = PPair un IsTerm (de env [] l) (de env [] r)
118− | n == eqTy = PEq un (de env [] lt) (de env [] rt)
119− (de env [] l) (de env [] r)
120117 | n == sigmaCon = PDPair un IsTerm (de env [] l) Placeholder
121118 (de env [] r)
122119 deFn env f@(P _ n _) args
@@ -485,33 +482,6 @@ addImplicitDiffs x y
485482 = let (a', c') = addI a c
486483 (b', d') = addI b d in
487484 (PPi p n a' b', PPi p' n' c' d')
488− addI (PRefl fc a) (PRefl fc' b)
489− = let (a', b') = addI a b in
490− (PRefl fc a', PRefl fc' b')
491− addI (PEq fc at bt a b) (PEq fc' ct dt c d)
492− | trace (show (at,bt)) False = undefined
493− | at `expLike` ct && bt `expLike` dt
494− = let (a', c') = addI a c
495− (b', d') = addI b d in
496− (PEq fc at bt a' b', PEq fc' ct dt c' d')
497− | otherwise
498− = let (at', ct') = addI at ct
499− (bt', dt') = addI bt dt
500− (a', c') = addI a c
501− (b', d') = addI b d
502− showa = if at `expLike` ct then [] else [AlwaysShow]
503− showb = if bt `expLike` dt then [] else [AlwaysShow] in
504− (PApp fc (PRef fc eqTy) [(pimp (sUN "A") at' True)
505− { argopts = showa },
506− (pimp (sUN "B") bt' True)
507− { argopts = showb },
508− pexp a', pexp b'],
509− PApp fc (PRef fc eqTy) [(pimp (sUN "A") ct' True)
510− { argopts = showa },
511− (pimp (sUN "B") dt' True)
512− { argopts = showb },
513− pexp c', pexp d'])
514−
515485 addI (PPair fc pi a b) (PPair fc' pi' c d)
516486 = let (a', c') = addI a c
517487 (b', d') = addI b d in
@@ -534,9 +504,6 @@ addImplicitDiffs x y
534504 = n == n' && expLike s s' && expLike t t'
535505 expLike (PPair _ _ x y) (PPair _ _ x' y') = expLike x x' && expLike y y'
536506 expLike (PDPair _ _ x _ y) (PDPair _ _ x' _ y') = expLike x x' && expLike y y'
537− expLike (PEq _ xt yt x y) (PEq _ xt' yt' x' y')
538− = expLike x x' && expLike y y'
539− expLike (PRefl _ x) (PRefl _ x') = expLike x x'
540507 expLike x y = x == y
541508
542509-- Issue #1589 on the issue tracker
src/Idris/Elab/Clause.hs+1−1
@@ -885,7 +885,7 @@ elabClause info opts (_, PWith fc fname lhs_in withs wval_in pn_in withblock)
885885 (map (pexp . (PRef fc) . fst) bargs_post) ++
886886 case mpn of
887887 Nothing -> []
888− Just _ -> [pexp (PRefl fc Placeholder)])
888+ Just _ -> [pexp (PRef fc eqCon)])
889889 logLvl 5 ("New RHS " ++ showTmImpls rhs)
890890 ctxt <- getContext -- New context with block added
891891 i <- getIState
src/Idris/Elab/Term.hs+1−8
@@ -343,10 +343,7 @@ elab ist info emode opts fn tm
343343 elab' ina fc (PResolveTC fc')
344344 = do c <- getNameFrom (sMN 0 "class")
345345 instanceArg c
346− elab' ina _ (PRefl fc t)
347− = elab' ina (Just fc) (PApp fc (PRef fc eqCon) [pimp (sMN 0 "A") Placeholder True,
348− pimp (sMN 0 "x") t False])
349− elab' ina _ (PEq fc Placeholder Placeholder l r)
346+ elab' ina _ (PApp fc (PRef _ n) args) | n == eqTy, [Placeholder, Placeholder, l, r] <- map getTm args
350347 = try (do tyn <- getNameFrom (sMN 0 "aqty")
351348 claim tyn RType
352349 movelast tyn
@@ -365,10 +362,6 @@ elab ist info emode opts fn tm
365362 pimp (sUN "B") (PRef fc btyn) False,
366363 pexp l, pexp r]))
367364
368− elab' ina _ (PEq fc lt rt l r) = elab' ina (Just fc) (PApp fc (PRef fc eqTy)
369− [pimp (sUN "A") lt True,
370− pimp (sUN "B") rt False,
371− pexp l, pexp r])
372365 elab' ina _ (PPair fc _ l r)
373366 = do hnf_compute
374367 g <- goal
src/Idris/ElabQuasiquote.hs−9
@@ -109,15 +109,6 @@ extractUnquotes n (PIfThenElse fc c t f)
109109 (t', ex2) <- extractUnquotes n t
110110 (f', ex3) <- extractUnquotes n f
111111 return (PIfThenElse fc c' t' f', ex1 ++ ex2 ++ ex3)
112−extractUnquotes n (PRefl fc x)
113− = do (x', ex) <- extractUnquotes n x
114− return (PRefl fc x', ex)
115−extractUnquotes n (PEq fc at bt a b)
116− = do (at', ex1) <- extractUnquotes n at
117− (bt', ex2) <- extractUnquotes n bt
118− (a', ex1) <- extractUnquotes n a
119− (b', ex2) <- extractUnquotes n b
120− return (PEq fc at' bt' a' b', ex1 ++ ex2)
121112extractUnquotes n (PRewrite fc x y z)
122113 = do (x', ex1) <- extractUnquotes n x
123114 (y', ex2) <- extractUnquotes n y
src/Idris/Error.hs−3
@@ -104,10 +104,7 @@ warnDisamb ist (PCase _ tm cases) = warnDisamb ist tm >>
104104 mapM_ (\(x,y)-> warnDisamb ist x >> warnDisamb ist y) cases
105105warnDisamb ist (PIfThenElse _ c t f) = mapM_ (warnDisamb ist) [c, t, f]
106106warnDisamb ist (PTrue _ _) = return ()
107−warnDisamb ist (PRefl _ tm) = warnDisamb ist tm
108107warnDisamb ist (PResolveTC _) = return ()
109−warnDisamb ist (PEq _ a b x y) = warnDisamb ist a >> warnDisamb ist b >>
110− warnDisamb ist x >> warnDisamb ist y
111108warnDisamb ist (PRewrite _ x y z) = warnDisamb ist x >> warnDisamb ist y >>
112109 Foldable.mapM_ (warnDisamb ist) z
113110warnDisamb ist (PPair _ _ x y) = warnDisamb ist x >> warnDisamb ist y
src/Idris/IBC.hs−18
@@ -1542,17 +1542,8 @@ instance Binary PTerm where
15421542 PTrue x1 x2 -> do putWord8 12
15431543 put x1
15441544 put x2
1545− PRefl x1 x2 -> do putWord8 14
1546− put x1
1547− put x2
15481545 PResolveTC x1 -> do putWord8 15
15491546 put x1
1550− PEq x1 x2 x3 x4 x5 -> do putWord8 16
1551− put x1
1552− put x2
1553− put x3
1554− put x4
1555− put x5
15561547 PRewrite x1 x2 x3 x4 -> do putWord8 17
15571548 put x1
15581549 put x2
@@ -1681,17 +1672,8 @@ instance Binary PTerm where
16811672 12 -> do x1 <- get
16821673 x2 <- get
16831674 return (PTrue x1 x2)
1684− 14 -> do x1 <- get
1685− x2 <- get
1686− return (PRefl x1 x2)
16871675 15 -> do x1 <- get
16881676 return (PResolveTC x1)
1689− 16 -> do x1 <- get
1690− x2 <- get
1691− x3 <- get
1692− x4 <- get
1693− x5 <- get
1694− return (PEq x1 x2 x3 x4 x5)
16951677 17 -> do x1 <- get
16961678 x2 <- get
16971679 x3 <- get
src/Idris/IdrisDoc.hs−2
@@ -303,8 +303,6 @@ extractPTermNames (PMatchApp _ n) = [n]
303303extractPTermNames (PCase _ p ps) = let (ps1, ps2) = unzip ps
304304 in concatMap extract (p:(ps1 ++ ps2))
305305extractPTermNames (PIfThenElse _ c t f) = concatMap extract [c, t, f]
306−extractPTermNames (PRefl _ p) = extract p
307−extractPTermNames (PEq _ _ _ p1 p2) = concatMap extract [p1, p2]
308306extractPTermNames (PRewrite _ a b m) | Just c <- m =
309307 concatMap extract [a, b, c]
310308extractPTermNames (PRewrite _ a b _) = concatMap extract [a, b]
src/Idris/ParseExpr.hs−4
@@ -326,10 +326,6 @@ simpleExpr syn =
326326 try (simpleExternalExpr syn)
327327 <|> do x <- try (lchar '?' *> name); return (PMetavar x)
328328 <|> do lchar '%'; fc <- getFC; reserved "instance"; return (PResolveTC fc)
329− <|> do reserved "Refl"; fc <- getFC;
330− tm <- option Placeholder (do lchar '{'; t <- expr syn; lchar '}';
331− return t)
332− return (PRefl fc tm)
333329 <|> do reserved "elim_for"; fc <- getFC; t <- fnName; return (PRef fc (SN $ ElimN t))
334330 <|> proofExpr syn
335331 <|> tacticsExpr syn
src/Idris/ParseOps.hs+1−1
@@ -37,7 +37,7 @@ table fixes
3737 toTable (reverse fixes) ++
3838 [[backtick],
3939 [binary "$" (\fc x y -> flatten $ PApp fc x [pexp y]) AssocRight],
40− [binary "=" (\fc x y -> PEq fc Placeholder Placeholder x y) AssocLeft],
40+ [binary "=" (\fc x y -> PApp fc (PRef fc eqTy) [pexp x, pexp y]) AssocLeft],
4141 [nofixityoperator]]
4242 where
4343 flatten :: PTerm -> PTerm -- flatten application
src/Idris/ProofSearch.hs+1−1
@@ -22,7 +22,7 @@ import Debug.Trace
2222-- Pass in a term elaborator to avoid a cyclic dependency with ElabTerm
2323
2424trivial :: (PTerm -> ElabD ()) -> IState -> ElabD ()
25−trivial elab ist = try' (do elab (PRefl (fileFC "prf") Placeholder)
25+trivial elab ist = try' (do elab (PApp (fileFC "prf") (PRef (fileFC "prf") eqCon) [pimp (sUN "A") Placeholder False, pimp (sUN "x") Placeholder False])
2626 return ())
2727 (do env <- get_env
2828 g <- goal
test/reg037/reg037.idr+1−1
@@ -4,6 +4,6 @@
44class Foo (t : a -> b -> Type) where
55 foo : (x : _) -> (y : _) -> t x y -> t x y
66
7−instance Foo (=) where
7+instance Foo ((=) {A=a} {B=b}) where
88 foo x y prf = prf
99
test/reg047/reg047.idr+1−1
@@ -9,7 +9,7 @@ Id : (A : Type) -> A -> A -> Type
99Id A = (=) {A = A} {B = A}
1010
1111IdRefl : (A : Type) -> (a : A) -> Id A a a
12−IdRefl A a = Refl {a}
12+IdRefl A a = Refl {x = a}
1313
1414zzz : Id Nat zero zero
1515zzz = IdRefl Nat zero
test/reg047/reg047a.idr+1−1
@@ -9,7 +9,7 @@ Id : (A : Type) -> A -> A -> Type
99Id = \A,x,y => x = y -- {a = A} {b = A}
1010
1111IdRefl : (A : Type) -> (a : A) -> Id A a a
12−IdRefl A a = Refl {a}
12+IdRefl A a = Refl {x = a}
1313
1414zzzz : Id MNat zero zero
1515zzzz = IdRefl MNat zero
test/reg056/reg056.idr+1−1
@@ -6,7 +6,7 @@ postulate trap : Z = Z
66dodgy : (a, b : ()) -> a = b -> Void
77dodgy n m Refl impossible
88
9−nonk : (trap = Refl {Z}) -> Void
9+nonk : (trap = Refl {x = Z}) -> Void
1010nonk Refl impossible
1111
1212false : Void