sync with uhc-util

Author: atzedijkstra

EHC/src/ehc/CHR/Constraint.chs

@@ -86,10 +86,13 @@ instance (CHRMatchable env p s, TTKey p ~ Key) => CHRMatchable env (Constraint'
          ; (_,p2,_) <- cnstrReducablePart c2
          ; chrMatchTo env s p1 p2
          }
+  chrBuiltinSolve e s x = Nothing
 
+{-
 -- not yet supported
 instance (CHREmptySubstitution s, VarLookupCmb s s) => CHRBuiltinSolvable env (Constraint' p info) s where
   chrBuiltinSolve e s x = Nothing
+-}
 %%]
 
 %%[(9 hmtyinfer || hmtyast)

EHC/src/ehc/CHR/Solve.chs

@@ -41,6 +41,8 @@ type SolveStep  e c g p s = Mono.SolveStep  c g s
 %%% For Poly variant
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+-- 20160331 AD: no longer supported, support removed from uhc-util lib
+
 %%[(9999 hmtyinfer) import(UHC.Util.CHR.Solve.TreeTrie.Poly hiding(IsCHRSolvable(..), SolveState, SolveTrace, SolveStep, CHRStore), qualified UHC.Util.CHR.Solve.TreeTrie.Poly as Poly) export(module UHC.Util.CHR.Solve.TreeTrie.Poly, IsCHRSolvable(..), SolveState, SolveTrace, SolveStep, CHRStore', CHRSolverConstraint)
 instance Poly.IsCHRSolvable FIIn VarMp
 

EHC/src/ehc/EH/UsedNames.cag

@@ -35,7 +35,7 @@ gathMentrelFilterMpFromSimplifyResult :: HsName -> SimplifyResult -> ModEntRelFi
 gathMentrelFilterMpFromSimplifyResult moduleNm simpRes
   = mentrelFilterMpUnions
       [ mentrelFilterMpSingleton [moduleNm] IdOcc_Val nm
-      | (Reduction {cnstrInfo=RedHow_ByInstance nm _ _}) <- (filterMb fromSolverConstraint $ chrSolveStateDoneConstraints $ simpresSolveState simpRes :: [Constraint])
+      | (Reduction {cnstrInfo=RedHow_ByInstance nm _ _}) <- ({- filterMb fromSolverConstraint $ -} chrSolveStateDoneConstraints $ simpresSolveState simpRes :: [Constraint])
       ]
 %%]
 

EHC/src/ehc/Pred/ToCHR.chs

@@ -211,9 +211,9 @@ mkClassSimplChrs env rules (context, head, infos)
   = simps
   where simps        = chrStoreFromElems $ mapTrans (Set.fromList [head1]) [] head1 (zip infos (map (\p -> Red_Pred $ mkCHRPredOcc p sc1) context))
         (superClassesWork, superClassesDone, _ :: SolveTrace FIIn Constraint Guard Prio VarMp)
-                     = chrSolve' [] env rules (map (\p -> toSolverConstraint $ mkAssume $ mkCHRPredOcc p sc1) context)
+                     = chrSolve' [] env rules (map (\p -> {- toSolverConstraint $ -} mkAssume $ mkCHRPredOcc p sc1) context)
         superClasses = superClassesWork ++ superClassesDone
-        graph        = mkRedGraphFromReductions $ filterMb fromSolverConstraint superClasses
+        graph        = mkRedGraphFromReductions {- $ filterMb fromSolverConstraint -} superClasses
         head1        = mkCHRPredOcc head sc1
         head2        = mkCHRPredOcc head sc2
         head3        = mkCHRPredOcc head sc3
@@ -448,10 +448,10 @@ chrSimplifySolveToRedGraph env chrStore cnstrInfoMpPrev cnstrInfoMp prevRes
         }
     )
   where (_,u1,u2) = mkNewLevUID2 $ fiUniq env
-        solveState = chrSolve'' [] (env {fiUniq = u1}) chrStore (map toSolverConstraint $ Map.keys $ cnstrInfoMp `Map.difference` cnstrInfoMpPrev) (simpresSolveState prevRes)
+        solveState = chrSolve'' [] (env {fiUniq = u1}) chrStore ({- map toSolverConstraint $ -} Map.keys $ cnstrInfoMp `Map.difference` cnstrInfoMpPrev) (simpresSolveState prevRes)
         cnstrInfoMpAll = cnstrMpUnion cnstrInfoMp cnstrInfoMpPrev
         redGraph
-          = addToRedGraphFromReductions (filterMb fromSolverConstraint $ chrSolveStateDoneConstraints solveState)
+          = addToRedGraphFromReductions ({- filterMb fromSolverConstraint $ -} chrSolveStateDoneConstraints solveState)
             $ addToRedGraphFromAssumes cnstrInfoMpAll
             $ simpresRedGraph prevRes
 %%]

EHC/src/ehc/VarMp.chs

@@ -361,7 +361,7 @@ varmpTyUnit = varmpSingleton
 
 %%[(6 hmtyinfer || hmtyast).VarMp.varmpTyUnit -2.VarMp.varmpTyUnit export(varmpMetaLevTyUnit,varmpTyUnit)
 varmpMetaLevTyUnit :: Ord k => MetaLev -> k -> Ty -> VarMp' k VarMpInfo
-varmpMetaLevTyUnit mlev v t = varmpMetaLevSingleton mlev v (VMITy t)
+varmpMetaLevTyUnit mlev v t = varlookupSingletonWithMetaLev mlev v (VMITy t)
 
 varmpTyUnit :: Ord k => k -> Ty -> VarMp' k VarMpInfo
 varmpTyUnit = varmpMetaLevTyUnit metaLevVal