[Refactored the MatchingTypes and ~TExps instances to share more code
tobias@goedderz.info**20150327171014
 Ignore-this: 41fbf4a31a1876b2e54f402950d2fd67
] hunk ./src/Tests.hs 20
-import Syntax (AUnify(), C, Position(Root, Dot), TExp(TVarE, TWildE, TAppE,
-    TConE), Term(), Type(AppT, ForallT, VarT, ConT), Unify(),
+import Syntax (AUnify(), C, Position(Root, Dot), Size(), TExp(TVarE, TWildE,
+    TAppE, TConE), Term(), Type(AppT, ForallT, VarT, ConT), Unify(),
hunk ./src/Tests.hs 74
-        numSubsts <- chooseLog (size baseType)
-        poss <- liftM (take numSubsts) $ nonOverlappingPos baseType
-        let subTerms = map (fromJust . subtermAt baseType) poss
-        let takenNames = S.fromList (getVarNames baseType)
-        let varPrefix = "mtyvar"
-        let freeNames = St.evalState (freeNamesM varPrefix) (takenNames, 1)
-        let names = St.evalState (mapM assignName subTerms) (M.empty, freeNames)
+        possWithSubterms <- randomPossWithSubterms baseType
+        let names = getConsistentNames "mtyvar" baseType (map snd possWithSubterms)
hunk ./src/Tests.hs 77
-        let substType = foldl (\term (subst, pos) -> substitute subst pos term) baseType (zip vars poss)
+        let substType = replaceSubterms const baseType vars (map fst possWithSubterms)
hunk ./src/Tests.hs 86
-        numVarSubsts <- chooseLog (size baseTExp)
-        numWildSubsts <- chooseLog (size baseTExp)
-        varPoss <- liftM (take numVarSubsts) $ nonOverlappingPos baseTExp
-        wildPoss <- liftM (take numWildSubsts) $ nonOverlappingPos baseTExp
-        let varSubTerms = map (fromJust . subtermAt baseTExp) varPoss
-        let wildSubTerms = map (fromJust . subtermAt baseTExp) wildPoss
-        let takenNames = S.fromList (getVarNames baseTExp)
-        let varPrefix = "mtevar"
-        let freeNames = St.evalState (freeNamesM varPrefix) (takenNames, 1)
-        let names = St.evalState (mapM assignName varSubTerms) (M.empty, freeNames)
+        varPossWithSubterms <- randomPossWithSubterms baseTExp
+        wildPossWithSubterms <- randomPossWithSubterms baseTExp
+        let names = getConsistentNames "mtevar" baseTExp (map snd varPossWithSubterms)
hunk ./src/Tests.hs 90
-        let varSubstTExp = foldl (\term (subst, pos) -> applyAtPos (subst . typeOf) pos term) baseTExp (zip vars varPoss)
+        let varSubstTExp = replaceSubterms (. typeOf) baseTExp vars (map fst varPossWithSubterms)
hunk ./src/Tests.hs 92
-        let wildSubstTExp = foldl (\term pos -> applyAtPos (wildSubst . typeOf) pos term) baseTExp wildPoss
+        let wildSubstTExp = replaceSubterms (. typeOf) baseTExp (repeat wildSubst) (map fst wildPossWithSubterms)
hunk ./src/Tests.hs 95
+randomPossWithSubterms :: (Term t, Size t) => t -> QC.Gen [(Position, t)]
+randomPossWithSubterms term = do
+    numSubsts <- chooseLog (size term)
+    poss <- liftM (take numSubsts) $ nonOverlappingPos term
+    return $ map (\pos -> (pos, fromJust (subtermAt term pos))) poss
+
+replaceSubterms apply term0 substs poss =
+        foldl (\term (subst, pos) -> applyAtPos (apply subst) pos term)
+              term0
+              (zip substs poss)
+
+getConsistentNames :: (Ord t, Term t) => String -> t -> [t] -> [Name]
+getConsistentNames prefix term subTerms =
+    let takenNames = S.fromList (getVarNames term)
+        freeNames = St.evalState (freeNamesM prefix) (takenNames, 1)
+    in St.evalState (mapM assignName subTerms) (M.empty, freeNames)
+