Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Wingman: Don't introduce too many variables #1961

Merged
merged 4 commits into from
Jun 25, 2021
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 9 additions & 7 deletions plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -127,21 +127,23 @@ intros' names = rule $ \jdg -> do
let g = jGoal jdg
case tacticsSplitFunTy $ unCType g of
(_, _, [], _) -> throwError $ GoalMismatch "intros" g
(_, _, as, b) -> do
(_, _, args, res) -> do
ctx <- ask
let vs = fromMaybe (mkManyGoodNames (hyNamesInScope $ jEntireHypothesis jdg) as) names
num_args = length vs
let occs = fromMaybe (mkManyGoodNames (hyNamesInScope $ jEntireHypothesis jdg) args) names
num_occs = length occs
top_hole = isTopHole ctx jdg
hy' = lambdaHypothesis top_hole $ zip vs $ coerce as
bindings = zip occs $ coerce args
bound_occs = fmap fst bindings
hy' = lambdaHypothesis top_hole bindings
jdg' = introduce ctx hy'
$ withNewGoal (CType $ mkFunTys' (drop num_args as) b) jdg
$ withNewGoal (CType $ mkFunTys' (drop num_occs args) res) jdg
ext <- newSubgoal jdg'
pure $
ext
& #syn_trace %~ rose ("intros {" <> intercalate ", " (fmap show vs) <> "}")
& #syn_trace %~ rose ("intros {" <> intercalate ", " (fmap show bound_occs) <> "}")
. pure
& #syn_scoped <>~ hy'
& #syn_val %~ noLoc . lambda (fmap bvar' vs) . unLoc
& #syn_val %~ noLoc . lambda (fmap bvar' bound_occs) . unLoc


------------------------------------------------------------------------------
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -38,4 +38,5 @@ spec = do
metaTest 4 28 "MetaUseSymbol"
metaTest 7 53 "MetaDeepOf"
metaTest 2 34 "MetaWithArg"
metaTest 2 12 "IntrosTooMany"

Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
too_many :: a -> b -> c
too_many a b = _
2 changes: 2 additions & 0 deletions plugins/hls-tactics-plugin/test/golden/IntrosTooMany.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
too_many :: a -> b -> c
too_many = [wingman| intros a b c d e f g h i j k l m n o p q r s t u v w x y z |]