on 2deedfb help sign in
elk/src/Type/Constrain/Expression.hs
754 lines 23 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Type.Constrain.Expression
3 ( constrain
4 , constrainDef
5 , constrainRecursiveDefs
6 )
7 where
10import qualified Data.Map.Strict as Map
12import qualified AST.Canonical as Can
13import qualified AST.Module.Name as ModuleName
14import qualified AST.Utils.Shader as Shader
15import qualified Data.Index as Index
16import qualified Elm.Name as N
17import qualified Reporting.Annotation as A
18import qualified Reporting.Region as R
19import Type.Constraint as C
20import qualified Type.Constrain.Pattern as Pattern
21import qualified Type.Instantiate as Instantiate
22import Type.Type as Type hiding (Descriptor(..))
26-- CONSTRAIN
29-- As we step past type annotations, the free type variables are added to
30-- the "rigid type variables" dict. Allowing sharing of rigid variables
31-- between nested type annotations.
32--
33-- So if you have a top-level type annotation like (func : a -> b) the RTV
34-- dictionary will hold variables for `a` and `b`
35--
36type RTV =
37 Map.Map N.Name Type
40constrain :: RTV -> Can.Expr -> Expected Type -> IO Constraint
41constrain rtv (A.At region expression) expected =
42 case expression of
43 Can.VarLocal name ->
44 return (CLookup region name expected)
46 Can.VarTopLevel _ name ->
47 return (CLookup region name expected)
49 Can.VarKernel _ _ ->
50 return CTrue
52 Can.VarForeign _ name annotation ->
53 return $ CInstance region (FuncName name) annotation expected
55 Can.VarDebug _ name annotation ->
56 return $ CInstance region (FuncName name) annotation expected
58 Can.VarOperator op _ _ annotation ->
59 return $ CInstance region (OpName op) annotation expected
61 Can.Str _ ->
62 return $ CEqual region String Type.string expected
64 Can.Chr _ ->
65 return $ CEqual region Char Type.char expected
67 Can.Int _ ->
68 do var <- mkFlexNumber
69 return $ exists [var] $ CEqual region C.Number (VarN var) expected
71 Can.Float _ ->
72 return $ CEqual region Float Type.float expected
74 Can.List elements ->
75 constrainList rtv region elements expected
77 Can.Negate expr ->
78 do numberVar <- mkFlexNumber
79 let numberType = VarN numberVar
80 numberCon <- constrain rtv expr (FromContext region Negate numberType)
81 let negateCon = CEqual region C.Number numberType expected
82 return $ exists [numberVar] $ CAnd [ numberCon, negateCon ]
84 Can.Binop op _ _ annotation leftExpr rightExpr ->
85 constrainBinop rtv region op annotation leftExpr rightExpr expected
87 Can.Lambda args body ->
88 constrainLambda rtv region args body expected
90 Can.Call func args ->
91 constrainCall rtv region func args expected
93 Can.If branches finally ->
94 constrainIf rtv region branches finally expected
96 Can.Case expr branches ->
97 constrainCase rtv region expr branches expected
99 Can.Let def body ->
100 constrainDef rtv def
101 =<< constrain rtv body expected
103 Can.LetRec defs body ->
104 constrainRecursiveDefs rtv defs
105 =<< constrain rtv body expected
107 Can.LetDestruct pattern expr body ->
108 constrainDestruct rtv region pattern expr
109 =<< constrain rtv body expected
111 Can.Accessor field ->
112 do extVar <- mkFlexVar
113 fieldVar <- mkFlexVar
114 let extType = VarN extVar
115 let fieldType = VarN fieldVar
116 let recordType = RecordN (Map.singleton field fieldType) extType
117 return $ exists [ fieldVar, extVar ] $
118 CEqual region (Accessor field) (FunN recordType fieldType) expected
120 Can.Access expr field ->
121 do extVar <- mkFlexVar
122 fieldVar <- mkFlexVar
123 let extType = VarN extVar
124 let fieldType = VarN fieldVar
125 let recordType = RecordN (Map.singleton field fieldType) extType
127 recordCon <-
128 constrain rtv expr (FromContext region (RecordAccess field) recordType)
130 return $ exists [ fieldVar, extVar ] $
131 CAnd
132 [ recordCon
133 , CEqual region (Access field) recordType expected
134 ]
136 Can.Update expr fields ->
137 constrainUpdate rtv region expr fields expected
139 Can.Record fields ->
140 constrainRecord rtv region fields expected
142 Can.Unit ->
143 return $ CEqual region Unit UnitN expected
145 Can.Tuple a b maybeC ->
146 constrainTuple rtv region a b maybeC expected
148 Can.Shader _uid _src glType ->
149 constrainShader region glType expected
153-- CONSTRAIN LAMBDA
156constrainLambda :: RTV -> R.Region -> [Can.Pattern] -> Can.Expr -> Expected Type -> IO Constraint
157constrainLambda rtv region args body expected =
158 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-
159 constrainArgs args
161 bodyCon <-
162 constrain rtv body (NoExpectation resultType)
164 return $ exists vars $
165 CAnd
166 [ CLet
167 { _rigidVars = []
168 , _flexVars = pvars
169 , _header = headers
170 , _headerCon = CAnd (reverse revCons)
171 , _bodyCon = bodyCon
172 }
173 , CEqual region Lambda tipe expected
174 ]
178-- CONSTRAIN CALL
181constrainCall :: RTV -> R.Region -> Can.Expr -> [Can.Expr] -> Expected Type -> IO Constraint
182constrainCall rtv region func args expected =
183 do let maybeFuncName = getFuncName func
185 funcVar <- mkFlexVar
186 resultVar <- mkFlexVar
187 let funcType = VarN funcVar
188 let resultType = VarN resultVar
190 funcCon <- constrain rtv func (NoExpectation funcType)
192 (argVars, argTypes, argCons) <-
193 unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeFuncName) args
195 let arityType = foldr FunN resultType argTypes
196 let resultCon = CEqual region (CallResult maybeFuncName) resultType expected
198 return $ exists (funcVar:resultVar:argVars) $
199 CAnd
200 [ funcCon
201 , CBranch
202 { _a = funcType
203 , _b = arityType
204 , _eq = CAnd [ CAnd argCons, resultCon ]
205 , _neq = constrainCallBackup rtv region maybeFuncName func args
206 }
207 ]
210constrainArg :: RTV -> R.Region -> Maybe FuncName -> Index.ZeroBased -> Can.Expr -> IO (Variable, Type, Constraint)
211constrainArg rtv region maybeFuncName index arg =
212 do argVar <- mkFlexVar
213 let argType = VarN argVar
214 argCon <- constrain rtv arg (FromContext region (CallArg maybeFuncName index) argType)
215 return (argVar, argType, argCon)
218constrainCallBackup :: RTV -> R.Region -> Maybe FuncName -> Can.Expr -> [Can.Expr] -> IO Constraint
219constrainCallBackup rtv region maybeFuncName func args =
220 do (argVars, argTypes, argCons) <-
221 unzip3 <$> Index.indexedTraverse (constrainArg rtv region maybeFuncName) args
223 resultVar <- mkFlexVar
224 let resultType = VarN resultVar
225 let arityType = foldr FunN resultType argTypes
227 funcCon <- constrain rtv func (FromContext region BadArity arityType)
229 return $ exists (resultVar:argVars) $ CAnd [ CAnd argCons, funcCon ]
232getFuncName :: Can.Expr -> Maybe FuncName
233getFuncName (A.At _ expr) =
234 case expr of
235 Can.VarLocal name ->
236 Just (FuncName name)
238 Can.VarTopLevel _ name ->
239 Just (FuncName name)
241 Can.VarKernel _ name ->
242 Just (FuncName name)
244 Can.VarForeign _ name _ ->
245 Just (FuncName name)
247 Can.VarOperator op _ _ _ ->
248 Just (OpName op)
250 _ ->
251 Nothing
255-- CONSTRAIN BINOP
258constrainBinop :: RTV -> R.Region -> N.Name -> Can.Annotation -> Can.Expr -> Can.Expr -> Expected Type -> IO Constraint
259constrainBinop rtv region op annotation leftExpr rightExpr expected =
260 do leftVar <- mkFlexVar
261 rightVar <- mkFlexVar
262 answerVar <- mkFlexVar
263 let leftType = VarN leftVar
264 let rightType = VarN rightVar
265 let answerType = VarN answerVar
266 let binopType = leftType ==> rightType ==> answerType
268 let opCon = CInstance region (OpName op) annotation (NoExpectation binopType)
270 leftCon <- constrain rtv leftExpr (FromContext region (OpLeft op) leftType)
271 rightCon <- constrain rtv rightExpr (FromContext region (OpRight op) rightType)
273 return $ exists [ leftVar, rightVar, answerVar ] $
274 CAnd
275 [ opCon
276 , leftCon
277 , rightCon
278 , CEqual region (CallResult (Just (OpName op))) answerType expected
279 ]
283-- CONSTRAIN LISTS
286constrainList :: RTV -> R.Region -> [Can.Expr] -> Expected Type -> IO Constraint
287constrainList rtv region entries expected =
288 do entryVar <- mkFlexVar
289 let entryType = VarN entryVar
290 let listType = AppN ModuleName.list N.list [entryType]
292 entryCons <-
293 Index.indexedTraverse (constrainListEntry rtv region entryType) entries
295 return $ exists [entryVar] $
296 CAnd
297 [ CAnd entryCons
298 , CEqual region List listType expected
299 ]
302constrainListEntry :: RTV -> R.Region -> Type -> Index.ZeroBased -> Can.Expr -> IO Constraint
303constrainListEntry rtv region tipe index expr =
304 constrain rtv expr (FromContext region (ListEntry index) tipe)
308-- CONSTRAIN IF EXPRESSIONS
311constrainIf :: RTV -> R.Region -> [(Can.Expr, Can.Expr)] -> Can.Expr -> Expected Type -> IO Constraint
312constrainIf rtv region branches final expected =
313 do let boolExpect = FromContext region IfCondition Type.bool
314 let (conditions, exprs) = foldr (\(c,e) (cs,es) -> (c:cs,e:es)) ([],[final]) branches
316 condCons <-
317 traverse (\c -> constrain rtv c boolExpect) conditions
319 case expected of
320 FromAnnotation name arity _ tipe ->
321 do branchCons <- Index.indexedForA exprs $ \index expr ->
322 constrain rtv expr (FromAnnotation name arity (TypedIfBranch index) tipe)
323 return $
324 CAnd
325 [ CAnd condCons
326 , CAnd branchCons
327 ]
329 _ ->
330 do branchVar <- mkFlexVar
331 let branchType = VarN branchVar
333 branchCons <- Index.indexedForA exprs $ \index expr ->
334 constrain rtv expr (FromContext region (IfBranch index) branchType)
336 return $ exists [branchVar] $
337 CAnd
338 [ CAnd condCons
339 , CAnd branchCons
340 , CEqual region If branchType expected
341 ]
345-- CONSTRAIN CASE EXPRESSIONS
348constrainCase :: RTV -> R.Region -> Can.Expr -> [Can.CaseBranch] -> Expected Type -> IO Constraint
349constrainCase rtv region expr branches expected =
350 do ptrnVar <- mkFlexVar
351 let ptrnType = VarN ptrnVar
352 exprCon <- constrain rtv expr (NoExpectation ptrnType)
354 case expected of
355 FromAnnotation name arity _ tipe ->
356 do branchCons <- Index.indexedForA branches $ \index branch ->
357 constrainCaseBranch rtv branch
358 (PFromContext region (PCaseMatch index) ptrnType)
359 (FromAnnotation name arity (TypedCaseBranch index) tipe)
361 return $ exists [ptrnVar] $ CAnd (exprCon:branchCons)
363 _ ->
364 do branchVar <- mkFlexVar
365 let branchType = VarN branchVar
367 branchCons <- Index.indexedForA branches $ \index branch ->
368 constrainCaseBranch rtv branch
369 (PFromContext region (PCaseMatch index) ptrnType)
370 (FromContext region (CaseBranch index) branchType)
372 return $ exists [ptrnVar,branchVar] $
373 CAnd
374 [ exprCon
375 , CAnd branchCons
376 , CEqual region Case branchType expected
377 ]
380constrainCaseBranch :: RTV -> Can.CaseBranch -> PExpected Type -> Expected Type -> IO Constraint
381constrainCaseBranch rtv (Can.CaseBranch pattern expr) pExpect bExpect =
382 do (Pattern.State headers pvars revCons) <-
383 Pattern.add pattern pExpect Pattern.emptyState
385 CLet [] pvars headers (CAnd (reverse revCons))
386 <$> constrain rtv expr bExpect
390-- CONSTRAIN RECORD
393constrainRecord :: RTV -> R.Region -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
394constrainRecord rtv region fields expected =
395 do dict <- traverse (constrainField rtv) fields
397 let getType (_, t, _) = t
398 let recordType = RecordN (Map.map getType dict) EmptyRecordN
399 let recordCon = CEqual region Record recordType expected
401 let vars = Map.foldr (\(v,_,_) vs -> v:vs) [] dict
402 let cons = Map.foldr (\(_,_,c) cs -> c:cs) [recordCon] dict
404 return $ exists vars (CAnd cons)
407constrainField :: RTV -> Can.Expr -> IO (Variable, Type, Constraint)
408constrainField rtv expr =
409 do var <- mkFlexVar
410 let tipe = VarN var
411 con <- constrain rtv expr (NoExpectation tipe)
412 return (var, tipe, con)
416-- CONSTRAIN RECORD UPDATE
419constrainUpdate :: RTV -> R.Region -> Can.Expr -> Map.Map N.Name Can.Expr -> Expected Type -> IO Constraint
420constrainUpdate rtv region expr fields expected =
421 do sharedVar <- mkFlexVar
422 let sharedType = VarN sharedVar
424 oldVars <- traverse (\_ -> mkFlexVar) fields
425 let oldTypes = Map.map VarN oldVars
426 let oldRecordType = RecordN oldTypes sharedType
427 oldCon <- constrain rtv expr (FromContext region RecordUpdate oldRecordType)
429 newDict <- traverse (constrainField rtv) fields
431 let getType (_, t, _) = t
432 let newRecordType = RecordN (Map.map getType newDict) sharedType
433 let newCon = CEqual region Record newRecordType expected
435 let vars = Map.foldr (\(v,_,_) vs -> v:vs) (sharedVar : Map.elems oldVars) newDict
436 let cons = Map.foldr (\(_,_,c) cs -> c:cs) [newCon] newDict
438 return $ exists vars (CAnd (oldCon:cons))
442-- CONSTRAIN TUPLE
445constrainTuple :: RTV -> R.Region -> Can.Expr -> Can.Expr -> Maybe Can.Expr -> Expected Type -> IO Constraint
446constrainTuple rtv region a b maybeC expected =
447 do aVar <- mkFlexVar
448 bVar <- mkFlexVar
449 let aType = VarN aVar
450 let bType = VarN bVar
452 aCon <- constrain rtv a (NoExpectation aType)
453 bCon <- constrain rtv b (NoExpectation bType)
455 case maybeC of
456 Nothing ->
457 do let tupleType = TupleN aType bType Nothing
458 let tupleCon = CEqual region Tuple tupleType expected
459 return $ exists [ aVar, bVar ] $ CAnd [ aCon, bCon, tupleCon ]
461 Just c ->
462 do cVar <- mkFlexVar
463 let cType = VarN cVar
465 cCon <- constrain rtv c (NoExpectation cType)
467 let tupleType = TupleN aType bType (Just cType)
468 let tupleCon = CEqual region Tuple tupleType expected
470 return $ exists [ aVar, bVar, cVar ] $ CAnd [ aCon, bCon, cCon, tupleCon ]
474-- CONSTRAIN SHADER
477constrainShader :: R.Region -> Shader.Shader -> Expected Type -> IO Constraint
478constrainShader region (Shader.Shader attributes uniforms varyings) expected =
479 do attrVar <- mkFlexVar
480 unifVar <- mkFlexVar
481 let attrType = VarN attrVar
482 let unifType = VarN unifVar
484 let shaderType =
485 AppN ModuleName.webgl N.shader
486 [ toShaderRecord attributes attrType
487 , toShaderRecord uniforms unifType
488 , toShaderRecord varyings EmptyRecordN
489 ]
491 return $ exists [ attrVar, unifVar ] $
492 CEqual region Shader shaderType expected
495toShaderRecord :: Map.Map N.Name Shader.Type -> Type -> Type
496toShaderRecord types baseRecType =
497 if Map.null types then
498 baseRecType
499 else
500 RecordN (Map.map glToType types) baseRecType
503glToType :: Shader.Type -> Type
504glToType glType =
505 case glType of
506 Shader.V2 -> Type.vec2
507 Shader.V3 -> Type.vec3
508 Shader.V4 -> Type.vec4
509 Shader.M4 -> Type.mat4
510 Shader.Int -> Type.int
511 Shader.Float -> Type.float
512 Shader.Texture -> Type.texture
516-- CONSTRAIN DESTRUCTURES
519constrainDestruct :: RTV -> R.Region -> Can.Pattern -> Can.Expr -> Constraint -> IO Constraint
520constrainDestruct rtv region pattern expr bodyCon =
521 do patternVar <- mkFlexVar
522 let patternType = VarN patternVar
524 (Pattern.State headers pvars revCons) <-
525 Pattern.add pattern (PNoExpectation patternType) Pattern.emptyState
527 exprCon <-
528 constrain rtv expr (FromContext region Destructure patternType)
530 return $ CLet [] pvars headers (CAnd (reverse (exprCon:revCons))) bodyCon
534-- CONSTRAIN DEF
537constrainDef :: RTV -> Can.Def -> Constraint -> IO Constraint
538constrainDef rtv def bodyCon =
539 case def of
540 Can.Def (A.At region name) args expr ->
541 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-
542 constrainArgs args
544 exprCon <-
545 constrain rtv expr (NoExpectation resultType)
547 return $
548 CLet
549 { _rigidVars = []
550 , _flexVars = vars
551 , _header = Map.singleton name (A.At region tipe)
552 , _headerCon =
553 CLet
554 { _rigidVars = []
555 , _flexVars = pvars
556 , _header = headers
557 , _headerCon = CAnd (reverse revCons)
558 , _bodyCon = exprCon
559 }
560 , _bodyCon = bodyCon
561 }
563 Can.TypedDef (A.At region name) freeVars typedArgs expr srcResultType ->
564 do let newNames = Map.difference freeVars rtv
565 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
566 let newRtv = Map.union rtv (Map.map VarN newRigids)
568 (TypedArgs tipe resultType (Pattern.State headers pvars revCons)) <-
569 constrainTypedArgs newRtv name typedArgs srcResultType
571 let expected = FromAnnotation name (length typedArgs) TypedBody resultType
572 exprCon <-
573 constrain newRtv expr expected
575 return $
576 CLet
577 { _rigidVars = Map.elems newRigids
578 , _flexVars = []
579 , _header = Map.singleton name (A.At region tipe)
580 , _headerCon =
581 CLet
582 { _rigidVars = []
583 , _flexVars = pvars
584 , _header = headers
585 , _headerCon = CAnd (reverse revCons)
586 , _bodyCon = exprCon
587 }
588 , _bodyCon = bodyCon
589 }
593-- CONSTRAIN RECURSIVE DEFS
596data Info =
597 Info
598 { _vars :: [Variable]
599 , _cons :: [Constraint]
600 , _headers :: Map.Map N.Name (A.Located Type)
601 }
604{-# NOINLINE emptyInfo #-}
605emptyInfo :: Info
606emptyInfo =
607 Info [] [] Map.empty
610constrainRecursiveDefs :: RTV -> [Can.Def] -> Constraint -> IO Constraint
611constrainRecursiveDefs rtv defs bodyCon =
612 recDefsHelp rtv defs bodyCon emptyInfo emptyInfo
615recDefsHelp :: RTV -> [Can.Def] -> Constraint -> Info -> Info -> IO Constraint
616recDefsHelp rtv defs bodyCon rigidInfo flexInfo =
617 case defs of
618 [] ->
619 do let (Info rigidVars rigidCons rigidHeaders) = rigidInfo
620 let (Info flexVars flexCons flexHeaders ) = flexInfo
621 return $
622 CLet rigidVars [] rigidHeaders CTrue $
623 CLet [] flexVars flexHeaders (CLet [] [] flexHeaders CTrue (CAnd flexCons)) $
624 CAnd [ CAnd rigidCons, bodyCon ]
626 def : otherDefs ->
627 case def of
628 Can.Def (A.At region name) args expr ->
629 do let (Info flexVars flexCons flexHeaders) = flexInfo
631 (Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) <-
632 argsHelp args (Pattern.State Map.empty flexVars [])
634 exprCon <-
635 constrain rtv expr (NoExpectation resultType)
637 let defCon =
638 CLet
639 { _rigidVars = []
640 , _flexVars = pvars
641 , _header = headers
642 , _headerCon = CAnd (reverse revCons)
643 , _bodyCon = exprCon
644 }
646 recDefsHelp rtv otherDefs bodyCon rigidInfo $
647 Info
648 { _vars = newFlexVars
649 , _cons = defCon : flexCons
650 , _headers = Map.insert name (A.At region tipe) flexHeaders
651 }
653 Can.TypedDef (A.At region name) freeVars typedArgs expr srcResultType ->
654 do let newNames = Map.difference freeVars rtv
655 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
656 let newRtv = Map.union rtv (Map.map VarN newRigids)
658 (TypedArgs tipe resultType (Pattern.State headers pvars revCons)) <-
659 constrainTypedArgs newRtv name typedArgs srcResultType
661 exprCon <-
662 constrain newRtv expr $
663 FromAnnotation name (length typedArgs) TypedBody resultType
665 let defCon =
666 CLet
667 { _rigidVars = []
668 , _flexVars = pvars
669 , _header = headers
670 , _headerCon = CAnd (reverse revCons)
671 , _bodyCon = exprCon
672 }
674 let (Info rigidVars rigidCons rigidHeaders) = rigidInfo
675 recDefsHelp rtv otherDefs bodyCon
676 ( Info
677 { _vars = Map.foldr (:) rigidVars newRigids
678 , _cons = defCon : rigidCons
679 , _headers = Map.insert name (A.At region tipe) rigidHeaders
680 }
681 )
682 flexInfo
686-- CONSTRAIN ARGS
689data Args =
690 Args
691 { _a_vars :: [Variable]
692 , _a_type :: Type
693 , _a_result :: Type
694 , _a_state :: Pattern.State
695 }
698constrainArgs :: [Can.Pattern] -> IO Args
699constrainArgs args =
700 argsHelp args Pattern.emptyState
703argsHelp :: [Can.Pattern] -> Pattern.State -> IO Args
704argsHelp args state =
705 case args of
706 [] ->
707 do resultVar <- mkFlexVar
708 let resultType = VarN resultVar
709 return $ Args [resultVar] resultType resultType state
711 pattern : otherArgs ->
712 do argVar <- mkFlexVar
713 let argType = VarN argVar
715 (Args vars tipe result newState) <-
716 argsHelp otherArgs =<<
717 Pattern.add pattern (PNoExpectation argType) state
719 return (Args (argVar:vars) (FunN argType tipe) result newState)
723-- CONSTRAIN TYPED ARGS
726data TypedArgs =
727 TypedArgs
728 { _t_type :: Type
729 , _t_result :: Type
730 , _t_state :: Pattern.State
731 }
734constrainTypedArgs :: Map.Map N.Name Type -> N.Name -> [(Can.Pattern, Can.Type)] -> Can.Type -> IO TypedArgs
735constrainTypedArgs rtv name args srcResultType =
736 do resultType <- Instantiate.fromSrcType rtv srcResultType
737 typedArgsHelp rtv name Index.first args resultType Pattern.emptyState
740typedArgsHelp :: Map.Map N.Name Type -> N.Name -> Index.ZeroBased -> [(Can.Pattern, Can.Type)] -> Type -> Pattern.State -> IO TypedArgs
741typedArgsHelp rtv name index args resultType state =
742 case args of
743 [] ->
744 return $ TypedArgs resultType resultType state
746 (pattern@(A.At region _), srcType) : otherArgs ->
747 do argType <- Instantiate.fromSrcType rtv srcType
748 let expected = PFromContext region (PTypedArg name index) argType
750 (TypedArgs tipe result newState) <-
751 typedArgsHelp rtv name (Index.next index) otherArgs resultType =<<
752 Pattern.add pattern expected state
754 return (TypedArgs (FunN argType tipe) result newState)