MagicHaskeller 0.8.6.2 → 0.8.6.3
raw patch · 5 files changed
+64/−12 lines, 5 files
Files
- LICENSE +25/−0
- MagicHaskeller.cabal +4/−2
- MagicHaskeller/Expression.hs +15/−3
- MagicHaskeller/ProgGenSF.lhs +11/−5
- MagicHaskeller/Types.lhs +9/−2
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2004-2012, Susumu Katayama. +All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:+- Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.+ +- The name of its author may not be used to endorse or promote products+ derived from this software without specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY SUSUMU KATAYAMA "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL SUSUMU KATAYAMA BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
MagicHaskeller.cabal view
@@ -1,7 +1,8 @@ Name: MagicHaskeller-Version: 0.8.6.2+Version: 0.8.6.3 Cabal-Version: >= 1.2 License: BSD3+License-file: LICENSE Author: Susumu Katayama Maintainer: Susumu Katayama <skata@cs.miyazaki-u.ac.jp> Stability: experimental@@ -11,7 +12,8 @@ Build-Type: Simple Category: Language data-files: ExperimIOP.hs-Tested-with: GHC == 6.10.4+-- Tested-with: GHC == 6.10.4+Tested-with: GHC == 6.12.1 Flag GHCAPI Description: Enable execution using the GHC API rather than the combinatory interpreter
MagicHaskeller/Expression.hs view
@@ -20,6 +20,9 @@ import MagicHaskeller.Instantiate(RTrie, uncurryDyn, uncurryTy, mkUncurry, mkCurry, curryDyn) import MagicHaskeller.DebMT +import qualified Data.Set as S+import qualified Data.IntMap as IM+ -- AnnExpr remembers each Dynamic corresponding to the CoreExpr. data AnnExpr = AE CoreExpr Dynamic deriving Show instance Eq AnnExpr where@@ -184,10 +187,10 @@ -- Moved from T10 -- uniqSorter :: (Ord e) => [(e,Int)] -> [(e,Int)]-uniqSorter :: (Expression e) => [(e,Int)] -> [(e,Int)]-uniqSorter = annUniqSort -- swapUniqSort -- id -- uniqSort -- annUniqSort+uniqSorter, uniqSortPatAVL, annUniqSortAVL :: (Expression e) => [(e,Int)] -> [(e,Int)]+uniqSorter = annUniqSortAVL -- uniqSortPatAVL -- annUniqSort -- swapUniqSort -- id -- uniqSort -- annUniqSort -uniqSort :: Ord a => [a] -> [a]+uniqSort, uniqSortAVL :: Ord a => [a] -> [a] uniqSort = mergesortWithBy const compare swapUniqSort :: (Ord a, Ord b) => [(a,b)] -> [(a,b)] swapUniqSort = mergesortWithBy const (\(a,b) (c,d) -> compare (b,a) (d,c))@@ -195,3 +198,12 @@ annUniqSort = map snd . mergesortWithBy const (\a b -> compare (fst a) (fst b)) . map (\t@(ce,_i) -> (fromEnum $ toCE ce, t)) aUS :: Expression e => [e] -> [e] aUS = map snd . mergesortWithBy const (\a b -> compare (fst a) (fst b)) . map (\e -> (fromEnum $ toCE e, e))++uniqSortAVL = S.toList . S.fromList++-- $B$^$:$O8e$m$N(BInt$B$GJ,$1$k$N$G!$(BIntMap$B$H$N(B2$BCJ9=$((B+uniqSortPatAVL ts = [ (x,j) | (j, set) <- IM.toList $ IM.fromListWith S.union $ map (\(x,i) -> (i, S.singleton x)) ts+ , x <- S.toList set ]++annUniqSortAVL = IM.elems . IM.fromList . map (\t@(ce,_i) -> (fromEnum $ toCE ce, t))+-- fromEnum$B2?EY$b$d$jD>$9$N$bGO</GO</$7$$5$$b!%
MagicHaskeller/ProgGenSF.lhs view
@@ -29,6 +29,8 @@ import MagicHaskeller.T10(mergesortWithBy) +import qualified Data.Map as M+ import MagicHaskeller.DebMT import Debug.Trace@@ -99,7 +101,7 @@ unifyingPossibilities ty memodeb = unPS (unifyableExprs memodeb [] ty) emptySubst 0 matchProgs :: Expression e => MemoDeb e -> Type -> Matrix AnnExpr-matchProgs memodeb ty = fmap (toAnnExprWindWind (reducer $ PGSF memodeb) ty) $ lmt memodeb $ normalize $ unquantify ty -- ¤³¤Ã¤Á¤À¤Èlookup+matchProgs memodeb ty = fmap (toAnnExprWindWind (reducer $ PGSF memodeb) ty) $ lmt memodeb $ normalize ty -- ¤³¤Ã¤Á¤À¤Èlookup {- matchProgs memodeb ty = fmap toAnnExpr $ wind (fmap (mapCE Lambda)) (lookupFuns memodeb) [] (quantify ty) -- ¤³¤Ã¤Á¤À¤Èrecompute ¤È¤¤¤¦¤È¸ìÊÀ¤¬¤¢¤ë¡¥recompute¤·¤¿¤¤ãlmt¤Î¤È¤³¤í¤òÊѤ¨¤ë¤Ù¤·¡¥ @@ -169,7 +171,8 @@ -- tokoro10fstfst = mergesortWithBy const (\ ((k,_),_,_) ((l,_),_,_) -> k `compare` l) tokoro10ap :: Type -> [(a,Subst,i)] -> [(a,Subst,i)]-tokoro10ap ty = mergesortWithBy const (\ (_,k,_) (_,l,_) -> normalize (apply k ty) `compare` normalize (apply l ty))+-- tokoro10ap ty = mergesortWithBy const (\ (_,k,_) (_,l,_) -> normalize (apply k ty) `compare` normalize (apply l ty))+tokoro10ap ty = M.elems . M.fromListWith const . map (\ t@(_,k,_) -> ( {- normalize -} (apply k ty), t)) -- avail¤Ë¤·¤íType¤Ë¤·¤íapply¤µ¤ì¤Æ¤¤¤ë¡¥ -- ¤À¤«¤é¤³¤½¡¤runAnotherPSŪ¤ËemptySubst¤ËÂФ·¤Æ¼Â¹Ô¤·¤¿Êý¤¬¸úΨŪ¤Ê¤Ï¤º¡© ¤Ç¤â¡¤Substitution¤Ã¤Æ¤½¤ó¤Ê¤Ë¤Ç¤«¤¯¤Ê¤é¤Ê¤«¤Ã¤¿¤Î¤Ç¤Ï¡©FiniteMap¤Ç¤âassoc list¤Ç¤âÊѤï¤é¤Ê¤«¤Ã¤¿µ¤¤¬¡¥@@ -218,7 +221,7 @@ reorganize_ (\av -> specCases' memodeb av t) avail -- quantify¤ÏmemoÀè¤Ç´û¤Ë¤ä¤é¤ì¤Æ¤¤¤ë¤Î¤ÇÉÔÍ× typ <- applyPS ty- return (lmt memodeb $ normalize $ unquantify typ)+ return (lmt memodeb $ normalize typ) funApSub_ :: Search m => (Type -> PriorSubsts m ()) -> (Type -> PriorSubsts m ()) -> Type -> PriorSubsts m ()@@ -284,11 +287,14 @@ return es tokoro10fst :: (Eq k, Ord k) => [(k,s,i)] -> [(k,s,i)]-tokoro10fst = mergesortWithBy const (\ (k,_,_) (l,_,_) -> k `compare` l)+-- tokoro10fst = mergesortWithBy const (\ (k,_,_) (l,_,_) -> k `compare` l)+tokoro10fst = M.elems . M.fromListWith const . map (\ t@(k,_,_) -> (k,t)) -- entry for memoization matchFunctions :: Expression e => MemoDeb e -> Type -> DBound e-matchFunctions memodeb ty = case splitArgs (quantify ty) of (avail,t) -> matchFuns memodeb avail t+matchFunctions memodeb ty = case splitArgs (saferQuantify ty) of (avail,t) -> matchFuns memodeb avail t++-- saferQuantify ty = let offset = maxVarID (unquantify ty) + 1 in quantify' $ mapTV (offset+) ty matchFuns :: Expression e => MemoDeb e -> [Type] -> Type -> DBound e matchFuns memodeb avail reqret = catBags $ runPS (matchFuns' unifyableExprs memodeb avail reqret)
MagicHaskeller/Types.lhs view
@@ -8,7 +8,7 @@ {-# OPTIONS -cpp -funbox-strict-fields #-} module MagicHaskeller.Types(Type(..), Kind, TyCon, TyVar, TypeName, Class(..), Typed(..), tyvars, Subst, plusSubst, emptySubst, apply, mgu, varBind, match, maxVarID, normalizeVarIDs, normalize, - Decoder(..), typer, typee, negateTVIDs, limitType, quantify, quantify', unquantify, lookupSubst, unifyFunAp,+ Decoder(..), typer, typee, negateTVIDs, limitType, saferQuantify, quantify, quantify', unquantify, lookupSubst, unifyFunAp, alltyvars, mapTV, size, unitSubst, applyCheck, assertsubst, substOK, eqType, getRet, getArity, splitArgs, getArgs, pushArgs, popArgs, mguFunAp, strToVarType, revSplitArgs, revGetArgs, splitArgsCPS, bakaHash ) where import Data.List@@ -173,7 +173,14 @@ -- quantify freezes tyvars into tycons whose IDs are negative.-quantify, quantify', unquantify :: Type -> Type+saferQuantify, quantify, quantify', unquantify :: Type -> Type+saferQuantify = quantify . negUnquantify+negUnquantify (TC i) | i < 0 = TV i+negUnquantify (TA t u) = TA (negUnquantify t) (negUnquantify u)+negUnquantify (u :-> t) = negUnquantify u :-> negUnquantify t+negUnquantify (u :> t) = negUnquantify u :> negUnquantify t+negUnquantify t = t+ quantify ty = quantify' (normalize ty) quantify' (TV iD) = TC (-iD-1) quantify' tc@(TC _) = tc