Commit bda55fa0 authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski Committed by Marge Bot
Browse files

Make 'undefined x' linear in 'x' (#18731)

parent 1cde295c
......@@ -19,6 +19,7 @@ module GHC.Tc.Gen.App
import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcCheckPolyExprNC )
import GHC.Builtin.Types (multiplicityTy)
import GHC.Tc.Gen.Head
import GHC.Hs
import GHC.Tc.Utils.Monad
......@@ -499,13 +500,17 @@ tcInstFun do_ql inst_final rn_fun fun_sigma rn_args
-- - We need the freshly allocated unification variables, to extend
-- delta with.
-- It's easier just to do the job directly here.
do { arg_nus <- replicateM (countLeadingValArgs args) newOpenFlexiTyVar
do { let valArgsCount = countLeadingValArgs args
; arg_nus <- replicateM valArgsCount newOpenFlexiTyVar
-- We need variables for multiplicity (#18731)
-- Otherwise, 'undefined x' wouldn't be linear in x
; mults <- replicateM valArgsCount (newFlexiTyVarTy multiplicityTy)
; res_nu <- newOpenFlexiTyVar
; kind_co <- unifyKind Nothing liftedTypeKind (tyVarKind kappa)
; let delta' = delta `extendVarSetList` (res_nu:arg_nus)
arg_tys = mkTyVarTys arg_nus
res_ty = mkTyVarTy res_nu
fun_ty' = mkVisFunTysMany arg_tys res_ty
fun_ty' = mkVisFunTys (zipWithEqual "tcInstFun" mkScaled mults arg_tys) res_ty
co_wrap = mkWpCastN (mkTcGReflLeftCo Nominal fun_ty' kind_co)
acc' = addArgWrap co_wrap acc
-- Suppose kappa :: kk
......
{-# LANGUAGE LinearTypes #-}
module T18731 where
f :: a #-> b
f x = undefined x
......@@ -36,3 +36,4 @@ test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint'])
test('LinearTH1', normal, compile, [''])
test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, [''])
test('LinearHole', normal, compile, [''])
test('T18731', normal, compile, [''])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment