diff --git a/plugins/tactics/src/Ide/Plugin/Tactic.hs b/plugins/tactics/src/Ide/Plugin/Tactic.hs index 25874bf242..54b0ad9028 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic.hs @@ -31,6 +31,7 @@ import Data.Monoid import qualified Data.Set as S import qualified Data.Text as T import Data.Traversable +import Development.IDE (HscEnvEq(hscEnv)) import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service (runAction) @@ -258,11 +259,13 @@ judgementForHole state nfp range = do resulting_range <- liftMaybe $ toCurrentRange amapping $ realSrcSpanToRange rss (tcmod, _) <- MaybeT $ runIde state $ useWithStale TypeCheck nfp + (hsc, _) <- MaybeT $ runIde state $ useWithStale GhcSession nfp let tcg = fst $ tm_internals_ $ tmrModule tcmod tcs = tm_typechecked_source $ tmrModule tcmod ctx = mkContext (mapMaybe (sequenceA . (occName *** coerce)) $ getDefiningBindings binds rss) + (hscEnv hsc) tcg hyps = hypothesisFromBindings rss binds ambient = M.fromList $ contextMethodHypothesis ctx @@ -289,11 +292,12 @@ tacticCmd tac lf state (TacticParams uri range var_name) (range', jdg, ctx, dflags) <- judgementForHole state nfp range let span = rangeToRealSrcSpan (fromNormalizedFilePath nfp) range' pm <- MaybeT $ useAnnotatedSource "tacticsCmd" state nfp - x <- lift $ timeout 2e8 $ - case runTactic ctx jdg - $ tac - $ mkVarOcc - $ T.unpack var_name of + x <- lift $ timeout 2e8 $ do + res <- runTactic ctx jdg + $ tac + $ mkVarOcc + $ T.unpack var_name + case res of Left err -> pure $ (, Nothing) $ Left diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs index db20420ede..fa5b512926 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Tactic.CodeGen where @@ -211,6 +212,16 @@ coerceName :: HasOccName a => a -> RdrNameStr coerceName = fromString . occNameString . occName +------------------------------------------------------------------------------ +-- | Converts a function application into applicative form +idiomize :: LHsExpr GhcPs -> LHsExpr GhcPs +idiomize x = noLoc $ case unLoc x of + HsApp _ (L _ (HsVar _ (L _ x))) gshgp3 -> + op (bvar' $ occName x) "<$>" (unLoc gshgp3) + HsApp _ gsigp gshgp3 -> + op (unLoc $ idiomize gsigp) "<*>" (unLoc gshgp3) + y -> y + ------------------------------------------------------------------------------ -- | Like 'var', but works over standard GHC 'OccName's. diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs index 1621c36393..0290951314 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Context.hs @@ -11,26 +11,33 @@ import Data.Maybe (mapMaybe) import Data.Set (Set) import qualified Data.Set as S import Development.IDE.GHC.Compat +import FastString (fsLit) import Ide.Plugin.Tactic.GHC (tacticsThetaTy) import Ide.Plugin.Tactic.Machinery (methodHypothesis) import Ide.Plugin.Tactic.Types import OccName +import SrcLoc +import TcRnMonad (initTcWithGbl) import TcRnTypes import TcType (substTy, tcSplitSigmaTy) import Unify (tcUnifyTy) -mkContext :: [(OccName, CType)] -> TcGblEnv -> Context -mkContext locals tcg = Context +mkContext :: [(OccName, CType)] -> HscEnv -> TcGblEnv -> Context +mkContext locals env tcg = Context { ctxDefiningFuncs = locals , ctxModuleFuncs = fmap splitId . (getFunBindId =<<) . fmap unLoc . bagToList $ tcg_binds tcg + , ctxRunTcM = \tcr -> do + let loc = mkRealSrcLoc (fsLit "generated") 0 0 + fmap snd $ initTcWithGbl env tcg (mkRealSrcSpan loc loc) tcr } + ------------------------------------------------------------------------------ -- | Find all of the class methods that exist from the givens in the context. contextMethodHypothesis :: Context -> [(OccName, CType)] @@ -56,8 +63,34 @@ excludeForbiddenMethods = filter (not . flip S.member forbiddenMethods . fst) where forbiddenMethods :: Set OccName forbiddenMethods = S.map mkVarOcc $ S.fromList - [ -- monadfail - "fail" + [ -- applicative methods + "<*" + , "<$" + -- monad methods + , ">>" + , "return" + -- foldable methods + , "foldMap'" + , "foldr" + , "foldl" + , "foldr'" + , "foldl'" + , "foldr1" + , "foldl1" + , "maximum" + , "minimum" + , "sum" + , "product" + , "elem" + , "null" + , "mapM" + -- traversable methods + , "sequence" + , "pass" + , "censor" + , "state" + -- monadfail methods + , "fail" ] diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs b/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs index 3b66956257..9ba69623c5 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs @@ -5,14 +5,21 @@ module Ide.Plugin.Tactic.GHC where +import Control.Arrow import Control.Monad.State import qualified Data.Map as M import Data.Maybe (isJust) import Data.Traversable import Development.IDE.GHC.Compat import Generics.SYB (mkT, everywhere) +import Id (mkVanillaGlobal) import Ide.Plugin.Tactic.Types import OccName +import TcEnv (tcLookupTyCon) +import TcEvidence (TcEvBinds (..), evBindMapBinds) +import TcRnMonad +import TcSMonad (runTcS) +import TcSimplify (solveWanteds) import TcType import TyCoRep import Type @@ -20,6 +27,10 @@ import TysWiredIn (intTyCon, floatTyCon, doubleTyCon, charTyCon) import Unique import Var +#if __GLASGOW_HASKELL__ >= 810 +import Constraint +#endif + tcTyVar_maybe :: Type -> Maybe Var tcTyVar_maybe ty | Just ty' <- tcView ty = tcTyVar_maybe ty' @@ -148,3 +159,31 @@ getPatName (fromPatCompat -> p0) = #endif _ -> Nothing + +-- Generates the evidence for `Show ()`. +generateDictionary :: Name -> [Type] -> TcM (Var, TcEvBinds) +generateDictionary cls tys = do + showTyCon <- tcLookupTyCon cls + dictName <- newName $ mkDictOcc $ mkVarOcc "magic" + let dict_ty = mkTyConApp showTyCon tys + dict_var = mkVanillaGlobal dictName dict_ty + ev <- getDictionaryBindings dict_var + return (dict_var, ev) + + +-- Pass in a variable `x` which has type `Show ()` (for example) to generate +-- evidence for `Show ()` which will be bound to `x`. +getDictionaryBindings :: Var -> TcM TcEvBinds +getDictionaryBindings dict_var = do + loc <- getCtLocM (GivenOrigin UnkSkol) Nothing + let nonC = mkNonCanonical CtWanted + { ctev_pred = varType dict_var + , ctev_nosh = WDeriv + , ctev_dest = EvVarDest dict_var + , ctev_loc = loc + } + wCs = mkSimpleWC [cc_ev nonC] + traceMX "looking for a wanted: " $ unsafeRender wCs + (_, evBinds) <- second evBindMapBinds <$> runTcS (solveWanteds wCs) + return (EvBinds evBinds) + diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs index 3beb40daa4..bf472e9a57 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs @@ -70,6 +70,13 @@ withNewGoal :: a -> Judgement' a -> Judgement' a withNewGoal t = field @"_jGoal" .~ t +------------------------------------------------------------------------------ +-- | Like 'withNewGoal' but allows you to modify the goal rather than replacing +-- it. +withModifiedGoal :: (a -> a) -> Judgement' a -> Judgement' a +withModifiedGoal f = field @"_jGoal" %~ f + + introducing :: [(OccName, a)] -> Judgement' a -> Judgement' a introducing ns = field @"_jHypothesis" <>~ M.fromList ns diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs index f3e41c0061..c10a093977 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs @@ -32,17 +32,25 @@ import Data.Functor ((<&>)) import Data.Generics (mkQ, everything, gcount) import Data.List (nub, sortBy) import Data.Ord (comparing, Down(..)) +import Data.Set (Set) import qualified Data.Set as S import Development.IDE.GHC.Compat +import HscTypes (lookupTypeEnv) import Ide.Plugin.Tactic.Judgements import Ide.Plugin.Tactic.Types -import OccName (HasOccName(occName)) +import InstEnv (emptyInstEnv, lookupInstEnv, InstEnvs(InstEnvs)) +import Module (emptyModuleSet) +import OccName (mkVarOcc, HasOccName(occName)) import Refinery.ProofState import Refinery.Tactic import Refinery.Tactic.Internal import TcType import Type import Unify +import TcEnv (tcLookupGlobal) +import Ide.Plugin.Tactic.GHC (generateDictionary) +import TcEvidence (TcEvBinds(EvBinds)) +import Bag (isEmptyBag) substCTy :: TCvSubst -> CType -> CType @@ -69,8 +77,8 @@ runTactic :: Context -> Judgement -> TacticsM () -- ^ Tactic to use - -> Either [TacticError] RunTacticResults -runTactic ctx jdg t = + -> IO (Either [TacticError] RunTacticResults) +runTactic ctx jdg t = do let skolems = nub $ foldMap (tyCoVarsOfTypeWellScoped . unCType) $ jGoal jdg @@ -81,10 +89,10 @@ runTactic ctx jdg t = { ts_skolems = skolems , ts_unused_top_vals = S.fromList unused_topvals } - in case partitionEithers - . flip runReader ctx + res <- flip runReaderT ctx . unExtractM - $ runTacticT t jdg tacticState of + $ runTacticT t jdg tacticState + pure $ case partitionEithers res of (errs, []) -> Left $ take 50 $ errs (_, fmap assoc23 -> solns) -> do let sorted = @@ -229,6 +237,20 @@ methodHypothesis ty = do ------------------------------------------------------------------------------ +-- | Check if the types have a MPTC instance for the given clas name.; +hasInstance :: MonadTc m => Name -> [Type] -> m Bool +hasInstance nm tys = do + liftTc (generateDictionary nm tys) >>= \case + Just (_, ev) -> do + case ev of + EvBinds bag -> do + pure $ not $ isEmptyBag bag + _ -> pure False + Nothing -> do + pure False + + +-------------------------------------------------------------------------------- -- | Run the given tactic iff the current hole contains no univars. Skolems and -- already decided univars are OK though. requireConcreteHole :: TacticsM a -> TacticsM a @@ -240,3 +262,16 @@ requireConcreteHole m = do 0 -> m _ -> throwError TooPolymorphic + +------------------------------------------------------------------------------ +-- | Prevent the tactic from running when deriving a function with a name in +-- the given set. Useful for preventing bottoms. +disallowWhenDeriving + :: Set String + -> TacticsM a + -> TacticsM a +disallowWhenDeriving what m = do + defs <- asks $ S.fromList . fmap fst . ctxDefiningFuncs + case S.null $ S.intersection defs $ S.map mkVarOcc what of + True -> m + False -> throwError NoProgress diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs index f1c2a6d220..5435effd57 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs @@ -14,11 +14,14 @@ module Ide.Plugin.Tactic.Tactics , runTactic ) where +import Control.Applicative (Alternative((<|>))) +import Control.Arrow import Control.Monad (when) import Control.Monad.Except (throwError) +import Control.Monad.Extra (unlessM) import Control.Monad.Reader.Class (MonadReader(ask)) import Control.Monad.State.Class -import Control.Monad.State.Strict (StateT(..), runStateT) +import Control.Monad.State.Strict (execStateT, StateT(..), runStateT) import Data.Bool (bool) import Data.List import qualified Data.Map as M @@ -37,6 +40,7 @@ import Ide.Plugin.Tactic.Machinery import Ide.Plugin.Tactic.Naming import Ide.Plugin.Tactic.Types import Name (occNameString) +import PrelNames (applicativeClassName) import Refinery.Tactic import Refinery.Tactic.Internal import TcType @@ -113,7 +117,7 @@ destructAuto name = requireConcreteHole $ tracing "destruct(auto)" $ do case hasDestructed jdg name of True -> throwError $ AlreadyDestructed name False -> - let subtactic = rule $ destruct' (const subgoal) name + let subtactic = rule $ destruct' (const $ newSubgoal . disallowing [name]) name in case isPatVal jdg name of True -> pruning subtactic $ \jdgs -> @@ -132,7 +136,7 @@ destruct name = requireConcreteHole $ tracing "destruct(user)" $ do jdg <- goal case hasDestructed jdg name of True -> throwError $ AlreadyDestructed name - False -> rule $ \jdg -> destruct' (const subgoal) name jdg + False -> rule $ \jdg -> destruct' (const newSubgoal) name jdg ------------------------------------------------------------------------------ @@ -264,6 +268,49 @@ localTactic t f = do runStateT (unTacticT t) $ f jdg +------------------------------------------------------------------------------ +-- | Attempt to run the given tactic in "idiom bracket" mode. For example, if +-- the current goal is +-- +-- (_ :: [r]) +-- +-- then @idiom apply@ will remove the applicative context, resulting in a hole: +-- +-- (_ :: r) +-- +-- and then use @apply@ to solve it. Let's say this results in: +-- +-- (f (_ :: a) (_ :: b)) +-- +-- Finally, @idiom@ lifts this back into the original applicative: +-- +-- (f <$> (_ :: [a]) <*> (_ :: [b])) +-- +-- Idiom will fail fast if the current goal doesn't have an applicative +-- instance. +idiom :: TacticsM () -> TacticsM () +idiom m = do -- disallowWhenDeriving (S.fromList ["fmap", "<*>", "liftA2"]) $ do + jdg <- goal + let hole = unCType $ jGoal jdg + when (isFunction hole) $ + throwError $ GoalMismatch "idiom" $ jGoal jdg + case splitAppTy_maybe hole of + Just (applic, ty) -> do + unlessM (hasInstance applicativeClassName [applic]) $ + throwError $ GoalMismatch "idiom" $ CType applic + rule $ \jdg -> do + (tr, expr) <- subgoalWith (withNewGoal (CType ty) jdg) m + case unLoc expr of + HsApp{} -> pure (tr, idiomize expr) + _ -> throwError $ GoalMismatch "idiom" $ jGoal jdg + rule $ newSubgoal . withModifiedGoal (CType . mkAppTy applic . unCType) + Nothing -> throwError $ GoalMismatch "idiom" $ jGoal jdg + + +subgoalWith :: Judgement -> TacticsM () -> RuleM (Trace, LHsExpr GhcPs) +subgoalWith jdg t = RuleT $ flip execStateT jdg $ unTacticT t + + auto' :: Int -> TacticsM () auto' 0 = throwError NoProgress auto' n = do @@ -271,12 +318,18 @@ auto' n = do try intros choice [ overFunctions $ \fname -> do - apply fname - loop + choice + [ idiom (apply fname) >> assumption + , apply fname >> loop + ] , overAlgebraicTerms $ \aname -> do destructAuto aname loop - , splitAuto >> loop + , do + choice + [ idiom splitAuto >> assumption + , splitAuto >> loop + ] , assumption >> loop , recursion ] diff --git a/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs b/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs index 6b4201b49a..6b77b8c89b 100644 --- a/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs +++ b/plugins/tactics/src/Ide/Plugin/Tactic/Types.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -37,6 +38,7 @@ import Ide.Plugin.Tactic.Debug import OccName import Refinery.Tactic import System.IO.Unsafe (unsafePerformIO) +import TcRnMonad (TcM) import Type import UniqSupply (takeUniqFromSupply, mkSplitUniqSupply, UniqSupply) import Unique (Unique) @@ -167,7 +169,7 @@ data Judgement' a = Judgement type Judgement = Judgement' CType -newtype ExtractM a = ExtractM { unExtractM :: Reader Context a } +newtype ExtractM a = ExtractM { unExtractM :: ReaderT Context IO a } deriving (Functor, Applicative, Monad, MonadReader Context) ------------------------------------------------------------------------------ @@ -246,14 +248,35 @@ data Context = Context -- ^ The functions currently being defined , ctxModuleFuncs :: [(OccName, CType)] -- ^ Everything defined in the current module + , ctxRunTcM :: forall x. TcM x -> IO (Maybe x) } - deriving stock (Eq, Ord) + + +------------------------------------------------------------------------------ +-- | Allows us to run TcM without directly exposing MonadIO. +class Monad m => MonadTc m where + liftTc :: TcM a -> m (Maybe a) + +instance MonadTc ExtractM where + liftTc tcm = do + runtc <- asks ctxRunTcM + ExtractM $ liftIO $ runtc tcm + +instance MonadTc RuleM where + liftTc = lift . liftTc + +instance MonadTc TacticsM where + liftTc = lift . liftTc ------------------------------------------------------------------------------ -- | An empty context emptyContext :: Context -emptyContext = Context mempty mempty +emptyContext + = Context mempty mempty + $ trace "using empty context; TcM operations will always fail" + $ const + $ pure Nothing newtype Rose a = Rose (Tree a) diff --git a/plugins/tactics/test/AutoTupleSpec.hs b/plugins/tactics/test/AutoTupleSpec.hs index 9b73c7c2f9..ff546ed864 100644 --- a/plugins/tactics/test/AutoTupleSpec.hs +++ b/plugins/tactics/test/AutoTupleSpec.hs @@ -2,6 +2,7 @@ module AutoTupleSpec where +import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Either (isRight) import qualified Data.Map as M import Ide.Plugin.Tactic.Debug @@ -37,17 +38,19 @@ spec = describe "auto for tuple" $ do out_type <- mkBoxedTupleTy . fmap mkBoxedTupleTy <$> randomGroups vars - pure $ - -- We should always be able to find a solution - runTactic - (Context [] []) - (mkFirstJudgement - (M.singleton (mkVarOcc "x") $ CType in_type) - mempty - True - mempty - out_type) - (auto' $ n * 2) `shouldSatisfy` isRight + pure $ do + -- We should always be able to find a solution + res <- liftIO + $ runTactic + emptyContext + (mkFirstJudgement + (M.singleton (mkVarOcc "x") $ CType in_type) + mempty + True + mempty + out_type) + (auto' $ n * 2) + res `shouldSatisfy` isRight randomGroups :: [a] -> Gen [[a]] diff --git a/test/functional/Tactic.hs b/test/functional/Tactic.hs index a37474771b..7e3eabb88d 100644 --- a/test/functional/Tactic.hs +++ b/test/functional/Tactic.hs @@ -98,7 +98,7 @@ tests = testGroup , goldenTest "GoldenEitherHomomorphic.hs" 2 15 Auto "" , goldenTest "GoldenNote.hs" 2 8 Auto "" , goldenTest "GoldenPureList.hs" 2 12 Auto "" - , goldenTest "GoldenListFmap.hs" 2 12 Auto "" + , goldenTest "GoldenListFmap.hs" 2 8 Auto "" , goldenTest "GoldenFromMaybe.hs" 2 13 Auto "" , goldenTest "GoldenFoldr.hs" 2 10 Auto "" , goldenTest "GoldenSwap.hs" 2 8 Auto "" @@ -111,8 +111,7 @@ tests = testGroup , goldenTest "GoldenShowCompose.hs" 2 15 Auto "" , goldenTest "GoldenShowMapChar.hs" 2 8 Auto "" , goldenTest "GoldenSuperclass.hs" 7 8 Auto "" - , ignoreTestBecause "It is unreliable in circleci builds" - $ goldenTest "GoldenApplicativeThen.hs" 2 11 Auto "" + , goldenTest "GoldenApplicativeThen.hs" 2 11 Auto "" , goldenTest "GoldenSafeHead.hs" 2 12 Auto "" , expectFail "GoldenFish.hs" 5 18 Auto "" ] diff --git a/test/testdata/tactic/GoldenApplicativeThen.hs.expected b/test/testdata/tactic/GoldenApplicativeThen.hs.expected index fc7816581b..de6616d50c 100644 --- a/test/testdata/tactic/GoldenApplicativeThen.hs.expected +++ b/test/testdata/tactic/GoldenApplicativeThen.hs.expected @@ -1,2 +1,2 @@ useThen :: Applicative f => f Int -> f a -> f a -useThen = (\ x x8 -> (*>) x x8) +useThen = (\ x x6 -> (*>) x x6) diff --git a/test/testdata/tactic/GoldenListFmap.hs b/test/testdata/tactic/GoldenListFmap.hs index 85293daaf4..4dbfb72199 100644 --- a/test/testdata/tactic/GoldenListFmap.hs +++ b/test/testdata/tactic/GoldenListFmap.hs @@ -1,2 +1,2 @@ -fmapList :: (a -> b) -> [a] -> [b] -fmapList = _ +fmap :: (a -> b) -> [a] -> [b] +fmap = _ diff --git a/test/testdata/tactic/GoldenListFmap.hs.expected b/test/testdata/tactic/GoldenListFmap.hs.expected index 6d183a9578..aa562b96b3 100644 --- a/test/testdata/tactic/GoldenListFmap.hs.expected +++ b/test/testdata/tactic/GoldenListFmap.hs.expected @@ -1,5 +1,5 @@ -fmapList :: (a -> b) -> [a] -> [b] -fmapList = (\ fab l_a +fmap :: (a -> b) -> [a] -> [b] +fmap = (\ fab l_a -> case l_a of [] -> [] - (a : l_a3) -> fab a : fmapList fab l_a3) + (a : l_a3) -> fab a : fmap fab l_a3)