ecta-plugin 0.1.0.1 → 0.1.1.1
raw patch · 3 files changed
+42/−19 lines, 3 files
Files
- ECTA/Plugin.hs +32/−10
- ECTA/Plugin/Utils.hs +9/−8
- ecta-plugin.cabal +1/−1
ECTA/Plugin.hs view
@@ -38,8 +38,11 @@ import Debug.Trace import Data.Either (partitionEithers) import Text.Read (readMaybe)+import qualified Data.Set as Set ++ plugin :: Plugin plugin = defaultPlugin@@ -49,8 +52,8 @@ hfPluginInit = newTcRef [], hfPluginRun = \ref -> ( HoleFitPlugin- { candPlugin = \_ c -> writeTcRef ref c >> return [],- fitPlugin = \h _ -> readTcRef ref >>= ectaPlugin opts h+ { candPlugin = \_ c -> writeTcRef ref c >> return c,+ fitPlugin = \h fts -> readTcRef ref >>= ectaPlugin opts h fts } ), hfPluginStop = const (return ())@@ -108,12 +111,19 @@ getExprSize (o:opts) | ("expr-size",'=':n) <- span (/= '=') o, Just x <- readMaybe n = x getExprSize _ = defaultSize- + -ectaPlugin :: [CommandLineOption] -> TypedHole -> [HoleFitCandidate] -> TcM [HoleFit]-ectaPlugin opts TyH{..} scope | Just hole <- tyHCt,- expr_size <- getExprSize opts,- ty <- ctPred hole = do+dedup :: [Text] -> [Text]+dedup ts = dedup' Set.empty ts+ where dedup' seen [] = []+ dedup' seen (t:ts) | Set.member t seen = dedup' seen ts+ dedup' seen (t:ts) = t:dedup' (Set.insert t seen) ts++ectaPlugin :: [CommandLineOption] -> TypedHole+ -> [HoleFit] -> [HoleFitCandidate] -> TcM [HoleFit]+ectaPlugin opts TyH{..} found_fits scope | Just hole <- tyHCt,+ expr_size <- getExprSize opts,+ ty <- ctPred hole = do (fun_comps, scons) <- fmap (nubBy eqType . concat) . unzip <$> candsToComps scope let (local_comps, global_comps) = partitionEithers $ map to_e fun_comps to_e (Left t,ts) = Left (t,ts)@@ -149,12 +159,24 @@ case typeToSkeleton ty of Just (t, cons) | resNode <- typeToFta t -> do let res = getAllTerms $ refold $ reduceFully $ filterType scopeNode resNode- ppterms <- concatMapM (prettyMatch skels groups . prettyTerm ) res+ -- We ignore ppterms for now, because they need to be printed differently.+ -- ppterms <- concatMapM (prettyMatch skels groups . prettyTerm ) res let even_more_terms =- map (pp . prettyTerm) $+ map (ppNoPar . prettyTerm) $ concatMap (getAllTerms . refold . reduceFully . flip filterType resNode ) (rtkUpToKAtLeast1 argNodes scope_comps anyArg True expr_size)- return $ map (RawHoleFit . text . unpack) $ ppterms ++ even_more_terms+ --text_fits = ppterms ++ even_more_terms+ ecta_fits = dedup even_more_terms+ fit_set = Set.fromList $ mapMaybe f found_fits+ where f (HoleFit {hfCand=c}) = Just (pack $ occNameString $ occName c)+ f _ = Nothing+ filtered_fits = map (RawHoleFit . text . unpack . parIfReq) $+ filter (not . flip Set.member fit_set) ecta_fits+ + ++ + return $ found_fits ++ filtered_fits _ -> do liftIO $ putStrLn $ "Could not skeleton `" ++ showSDocUnsafe (ppr ty) ++"`" return []
ECTA/Plugin/Utils.hs view
@@ -208,17 +208,18 @@ cleanup (Term (Symbol "app") [arg]) = cleanup arg cleanup (Term (Symbol t) args) = Term (Symbol t) $ map cleanup args -+parIfReq :: Text -> Text+parIfReq t | (s:_) <- unpack t,+ s /= '(',+ not (isAlpha s) = "(" <> t <> ")"+ | otherwise = t pp :: Term -> Text-pp = parIfReq . mconcat . pp' False . removeDicts- where- parIfReq :: Text -> Text- parIfReq t | (s:_) <- unpack t,- s /= '(',- not (isAlpha s) = "(" <> t <> ")"- | otherwise = t+pp = parIfReq . ppNoPar +ppNoPar :: Term -> Text+ppNoPar = mconcat . pp' False . removeDicts+ where pp' :: Bool -> Term -> [Text] pp' _ (Term (Symbol t) []) = [t] pp' par (Term (Symbol "app") (arg:rest)) | res@(_:_) <- concatMap (pp' True) rest =
ecta-plugin.cabal view
@@ -1,7 +1,7 @@ name: ecta-plugin cabal-version: 1.24 build-type: Simple-version: 0.1.0.1+version: 0.1.1.1 author: Matthías Páll Gissurarson maintainer: mpg@mpg.is synopsis: Hole-Fit Synthesis using ECTAs