{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE PatternGuards #-} module Language.Haskell.Exference.SimpleDict ( -- defaultBindings emptyClassEnv -- , defaultClassEnv , defaultHeuristicsConfig -- , testQueryClassEnv -- , typeId -- , typeReturn -- , typeUnsafe -- , typeBind -- , typeJoin ) where import Language.Haskell.Exference.Core ( ExferenceHeuristicsConfig(..) ) import Language.Haskell.Exference.Core.Types import Language.Haskell.Exference.Core.TypeUtils import Language.Haskell.Exference.FunctionDecl import Language.Haskell.Exference.TypeDeclsFromHaskellSrc ( unsafeReadType0 ) import qualified Data.Set as S import qualified Data.Map.Strict as M import qualified Data.IntMap.Strict as IntMap import Control.Arrow ( second ) -- import Debug.Hood.Observe -- typeReturn, typeUnsafe, typeBind, typeJoin, typeId :: HsType -- typeId = read "a -> a" -- typeReturn = read "a -> m a" -- typeUnsafe = read "a -> b" -- typeBind = read "m a -> (a -> m b) -> m b" -- typeJoin = read "m (m a) -> m a" -- toBindings :: [(String, Float, String)] -> [(QualifiedName, Float, HsType)] -- toBindings = map (\(a,b,c) -> (QualifiedName [] a, b, unsafeReadType0 c)) -- function, penalty for using that function, type -- value ignored for pattern-matches -- defaultBindings :: [RatedHsFunctionDecl] -- defaultBindings = toBindings -- [ -- -- functor -- ("fmap", 1.0, "(Functor f) => (a -> b) -> f a -> f b") -- -- applicative -- , ("pure", 3.0, "(Applicative f) => a -> f a") -- , ("(<*>)", 3.0, "(Applicative f) => f (a->b) -> f a -> f b") -- -- monad -- , ("(>>=)", 0.0, "(Monad m) => m a -> (a -> m b) -> m b") -- --, ("(>>)", 8.0, "Monad m => m a -> m b -> m b") -- -- show -- , ("show", 3.0, "(Show a) => a -> String") -- -- eq -- , ("(==)", 4.0, "Eq a => a -> a -> Bool") -- , ("(/=)", 10.0, "Eq a => a -> a -> Bool") -- bad, cause same sig as (==).. -- -- num -- , ("fromInteger", 9.9, "Num a => Integer -> a") -- -- real -- , ("toRational", 9.9, "Real a => a -> Rational") -- -- integral -- , ("toInteger", 9.9, "Integral a => a -> Integer") -- -- fractional -- , ("fromRational", 9.9, "Fractional a => Rational -> a") -- -- realfrac -- , ("truncate", 9.9, "RealFrac a, Integral b => a -> b") -- , ("round" , 9.9, "RealFrac a, Integral b => a -> b") -- , ("ceiling" , 9.9, "RealFrac a, Integral b => a -> b") -- , ("floor" , 9.9, "RealFrac a, Integral b => a -> b") -- -- other -- , ("(,)", 0.0, "a -> b -> Tuple2 a b") -- , ("zip", 0.0, "List a -> List b -> List (Tuple2 a b)") -- , ("repeat", 5.0, "a -> List a") -- , ("foldr", 0.0, "(a -> b -> b) -> b -> List a -> b") -- --, ("foldr0", 0.0, "(a -> List a -> List a) -> a -> List a") -- , ("()", 9.9, "Unit") -- , ("State", 3.0, "(s -> Tuple2 a s) -> State s a") -- , ("[]", 40.0, "List a") -- , ("(:)", 4.0, "a -> List a -> List a") -- , ("(,)", 0.0, "Tuple2 a b -> INFPATTERN a b") -- , ("State", 0.0, "State s a -> INFPATTERN (s -> Tuple2 a s)") -- , ("Just", 5.0, "a -> Maybe a") -- , ("sequence", 3.0, "Monad m => List (m a) -> m (List a)") -- ] emptyClassEnv :: StaticClassEnv emptyClassEnv = StaticClassEnv { sClassEnv_tclasses = [], sClassEnv_instances = M.empty } -- defaultClassEnv :: StaticClassEnv -- defaultClassEnv = mkStaticClassEnv classes instances -- where -- classes = [ c_show -- , c_functor, c_applicative, c_monad -- , c_eq, c_ord -- , c_enum -- , c_num, c_real, c_integral -- , c_fractional, c_realfrac, c_floating, c_realfloat] -- instances = inflateInstances -- $ [ list_show, list_monad, maybe_monad, maybe_show, tuple_show] -- ++ integral_instances -- ++ realfloat_instances -- -- c_show = HsTypeClass (QualifiedName [] "Show") [badReadVar "a"] [] -- c_functor = HsTypeClass (QualifiedName [] "Functor") [badReadVar "f"] [] -- c_applicative = HsTypeClass (QualifiedName [] "Applicative") [badReadVar "f"] -- [HsConstraint c_functor [read "f"]] -- c_monad = HsTypeClass (QualifiedName [] "Monad") [badReadVar "m"] -- [HsConstraint c_applicative [read "m"]] -- c_monadState = HsTypeClass -- (QualifiedName [] "MonadState") -- [badReadVar "s", badReadVar "m"] -- [HsConstraint c_monad [read "m"]] -- c_eq = HsTypeClass -- (QualifiedName [] "Eq") -- [badReadVar "a"] -- [] -- c_num = HsTypeClass -- (QualifiedName [] "Num") -- [badReadVar "a"] -- [ HsConstraint c_show [read "a"] -- , HsConstraint c_eq [read "a"]] -- c_ord = HsTypeClass -- (QualifiedName [] "Ord") -- [badReadVar "a"] -- [HsConstraint c_eq [read "a"]] -- c_real = HsTypeClass -- (QualifiedName [] "Real") -- [badReadVar "a"] -- [ HsConstraint c_ord [read "a"] -- , HsConstraint c_num [read "a"]] -- c_fractional = HsTypeClass -- (QualifiedName [] "Fractional") -- [badReadVar "a"] -- [HsConstraint c_num [read "a"]] -- c_enum = HsTypeClass -- (QualifiedName [] "Enum") -- [badReadVar "a"] -- [] -- c_integral = HsTypeClass -- (QualifiedName [] "Integral") -- [badReadVar "a"] -- [ HsConstraint c_real [read "a"] -- , HsConstraint c_enum [read "a"]] -- c_realfrac = HsTypeClass -- (QualifiedName [] "RealFrac") -- [badReadVar "a"] -- [ HsConstraint c_real [read "a"] -- , HsConstraint c_fractional [read "a"]] -- c_floating = HsTypeClass -- (QualifiedName [] "Floating") -- [badReadVar "a"] -- [HsConstraint c_fractional [read "a"]] -- c_realfloat = HsTypeClass -- (QualifiedName [] "RealFloat") -- [badReadVar "a"] -- [ HsConstraint c_realfrac [read "a"] -- , HsConstraint c_floating [read "a"]] -- -- list_show = HsInstance [HsConstraint c_show [read "a"]] c_show [read "List a"] -- --list_functor = HsInstance [] c_functor [read "List"] -- --list_applicative = HsInstance [] c_applicative [read "List"] -- list_monad = HsInstance [] c_monad [read "List"] -- --maybe_functor = HsInstance [] c_functor [read "Maybe"] -- --maybe_applicative = HsInstance [] c_functor [read "Maybe"] -- maybe_monad = HsInstance [] c_functor [read "Maybe"] -- maybe_show = HsInstance [HsConstraint c_show [read "a"]] c_show [read "Maybe a"] -- tuple_show = HsInstance [HsConstraint c_show [read "a"] -- ,HsConstraint c_show [read "b"]] c_show [read "Tuple2 a b"] -- integral_instances = mkInstances c_integral ["Int", "Integer"] -- realfloat_instances = mkInstances c_realfloat ["Float", "Double"] -- mkInstances :: HsTypeClass -> [String] -> [HsInstance] -- mkInstances tc strs = map f strs -- where -- f s = HsInstance [] tc [read s] -- testQueryClassEnv = mkQueryClassEnv defaultClassEnv -- [ HsConstraint c_show [read "v"] -- , HsConstraint c_show [read "w"] -- , HsConstraint c_functor [read "x"] -- , HsConstraint c_monad [read "y"] -- , HsConstraint c_monadState [read "s", read "z"] -- , HsConstraint c_show [read "MyFoo"] -- , HsConstraint c_show [read "B"] -- ] defaultHeuristicsConfig :: ExferenceHeuristicsConfig defaultHeuristicsConfig = ExferenceHeuristicsConfig { heuristics_goalVar = 4.0 , heuristics_goalCons = 0.55 , heuristics_goalArrow = 5.0 , heuristics_goalApp = 1.9 , heuristics_stepProvidedGood = 0.2 , heuristics_stepProvidedBad = 5.0 , heuristics_stepEnvGood = 6.0 , heuristics_stepEnvBad = 22.0 , heuristics_tempUnusedVarPenalty = 5.0 , heuristics_tempMultiVarUsePenalty = 3.0 , heuristics_functionGoalTransform = 0.0 , heuristics_unusedVar = 20.0 , heuristics_solutionLength = 0.0153 }