on master help sign in
Fix parameter name propagation
9c0581eEdwin Brady
idris.cabal+3
@@ -218,6 +218,9 @@ Extra-source-files:
218 test/reg035/*.idr
218 test/reg035/*.idr
219 test/reg035/*.lidr
219 test/reg035/*.lidr
220 test/reg035/expected
220 test/reg035/expected
221+ test/reg036/run
222+ test/reg036/*.idr
223+ test/reg036/expected
221
224
222 test/basic001/run
225 test/basic001/run
223 test/basic001/*.idr
226 test/basic001/*.idr
src/Idris/ElabDecls.hs+15−16
@@ -1282,27 +1282,27 @@ getFixedInType i env is tm@(App f a)
1282 getFixedInType i env is a
1282 getFixedInType i env is a
1283getFixedInType i _ _ _ = []
1283getFixedInType i _ _ _ = []
1284
1284
1285−getFlexInType i env (Bind n (Pi t) sc)
1285+getFlexInType i env ps (Bind n (Pi t) sc)
1286− = nub $ getFlexInType i env t ++
1286+ = nub $ (if (not (n `elem` ps)) then getFlexInType i env ps t else []) ++
1287− getFlexInType i (n : env) (instantiate (P Bound n t) sc)
1287+ getFlexInType i (n : env) ps (instantiate (P Bound n t) sc)
1288−getFlexInType i env tm@(App f a)
1288+getFlexInType i env ps tm@(App f a)
1289 | (P _ tn _, args) <- unApply tm
1289 | (P _ tn _, args) <- unApply tm
1290 = case lookupCtxt tn (idris_datatypes i) of
1290 = case lookupCtxt tn (idris_datatypes i) of
1291 [t] -> nub $ paramNames args env [x | x <- [0..length args],
1291 [t] -> nub $ paramNames args env [x | x <- [0..length args],
1292 not (x `elem` param_pos t)]
1292 not (x `elem` param_pos t)]
1293− ++ getFlexInType i env f ++
1293+ ++ getFlexInType i env ps f ++
1294− getFlexInType i env a
1294+ getFlexInType i env ps a
1295− [] -> nub $ getFlexInType i env f ++
1295+ [] -> nub $ getFlexInType i env ps f ++
1296− getFlexInType i env a
1296+ getFlexInType i env ps a
1297− | otherwise = nub $ getFlexInType i env f ++
1297+ | otherwise = nub $ getFlexInType i env ps f ++
1298− getFlexInType i env a
1298+ getFlexInType i env ps a
1299−getFlexInType i _ _ = []
1299+getFlexInType i _ _ _ = []
1300
1300
1301-- Treat a name as a parameter if it appears in parameter positions in
1301-- Treat a name as a parameter if it appears in parameter positions in
1302−-- types, and never in a non-parameter position in a type.
1302+-- types, and never in a non-parameter position in a (non-param) argument type.
1303
1303
1304getParamsInType i env ps t = let fix = getFixedInType i env ps t
1304getParamsInType i env ps t = let fix = getFixedInType i env ps t
1305− flex = getFlexInType i env t in
1305+ flex = getFlexInType i env fix t in
1306 [x | x <- fix, not (x `elem` flex)]
1306 [x | x <- fix, not (x `elem` flex)]
1307
1307
1308paramNames args env [] = []
1308paramNames args env [] = []
@@ -1354,11 +1354,10 @@ elabClause info opts (cnum, PClause fc fname lhs_in withs rhs_in whereblock)
1354 [t] -> t
1354 [t] -> t
1355 _ -> []
1355 _ -> []
1356 let params = getParamsInType i [] fn_is fn_ty
1356 let params = getParamsInType i [] fn_is fn_ty
1357− let flex = getFlexInType i [] fn_ty
1358 let lhs = mkLHSapp $ stripUnmatchable i $
1357 let lhs = mkLHSapp $ stripUnmatchable i $
1359 propagateParams params fn_ty (addImplPat i (stripLinear i lhs_in))
1358 propagateParams params fn_ty (addImplPat i (stripLinear i lhs_in))
1360− logLvl 5 ("LHS: " ++ show fc ++ " " ++ show lhs)
1359+ logLvl 5 ("LHS: " ++ show fc ++ " " ++ showTmImpls lhs)
1361− logLvl 4 ("Fixed parameters: " ++ show (flex, params) ++ " from " ++ show lhs_in ++
1360+ logLvl 4 ("Fixed parameters: " ++ show params ++ " from " ++ show lhs_in ++
1362 "\n" ++ show (fn_ty, fn_is))
1361 "\n" ++ show (fn_ty, fn_is))
1363
1362
1364 (((lhs', dlhs, []), probs, inj), _) <-
1363 (((lhs', dlhs, []), probs, inj), _) <-
test/reg036/expectednew file

No changes to the content.

test/reg036/reg036.idrnew file+12
@@ -0,0 +1,12 @@
1+import Data.HVect
2+
3+using (m : Nat, ts : Vect m Type)
4+
5+ data HV : Vect n Type -> Type where
6+ MkHV : HVect ts -> HV ts
7+
8+ showHV : Shows m ts => HV ts -> String
9+ showHV (MkHV v) = show v
10+
11+ instance Shows m ts => Show (HV ts) where
12+ show = showHV
test/reg036/runnew file+3
@@ -0,0 +1,3 @@
1+#!/usr/bin/env bash
2+idris --check reg036.idr
3+rm -f reg036 *.ibc