179fad8 · elk · git.iko.soy

git.iko.soy/elk

Update type constraint generators for new Reporting.Annotation

commit179fad88d3161522545dec940262a7334f6cd516 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 17 Nov 2017, 13:58 (9 years ago) parent2e0beda

2 files changed+14−14

compare with master

unifiedsplit

src/Type/Constrain/Expression.hs+11−11 src/Type/Constrain/Pattern.hs+3−3

src/Type/Constrain/Expression.hs+11−11

@@ -36,7 +36,7 @@ type RTV =

3636

3737

3838constrain :: RTV -> Can.Expr -> Expectation -> IO Constraint

39−constrain rtv (A.A region expression) expectation =

39+constrain rtv (A.At region expression) expectation =

4040 case expression of

4141 Can.VarLocal name ->

4242 return (CLookup region name expectation)

@@ -225,7 +225,7 @@ constrainCallBackup rtv region maybeFuncName func args =

225225

226226

227227getFuncName :: Can.Expr -> Maybe FuncName

228−getFuncName (A.A _ expr) =

228+getFuncName (A.At _ expr) =

229229 case expr of

230230 Can.VarLocal name ->

231231 Just (FuncName name)

@@ -532,7 +532,7 @@ constrainDestruct rtv region pattern expr bodyCon =

532532constrainDef :: RTV -> Can.Def -> Constraint -> IO Constraint

533533constrainDef rtv def bodyCon =

534534 case def of

535− Can.Def (A.A region name) args _ expr ->

535+ Can.Def (A.At region name) args _ expr ->

536536 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-

537537 constrainArgs args

538538

@@ -543,7 +543,7 @@ constrainDef rtv def bodyCon =

543543 CLet

544544 { _rigidVars = []

545545 , _flexVars = vars

546− , _header = Map.singleton name (A.A region tipe)

546+ , _header = Map.singleton name (A.At region tipe)

547547 , _headerCon =

548548 CLet

549549 { _rigidVars = []

@@ -555,7 +555,7 @@ constrainDef rtv def bodyCon =

555555 , _bodyCon = bodyCon

556556 }

557557

558− Can.TypedDef (A.A region name) freeVars typedArgs _ expr srcResultType ->

558+ Can.TypedDef (A.At region name) freeVars typedArgs _ expr srcResultType ->

559559 do let newNames = Map.difference freeVars rtv

560560 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames

561561 let newRtv = Map.union rtv (Map.map VarN newRigids)

@@ -571,7 +571,7 @@ constrainDef rtv def bodyCon =

571571 CLet

572572 { _rigidVars = Map.elems newRigids

573573 , _flexVars = []

574− , _header = Map.singleton name (A.A region tipe)

574+ , _header = Map.singleton name (A.At region tipe)

575575 , _headerCon =

576576 CLet

577577 { _rigidVars = []

@@ -620,7 +620,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =

620620

621621 def : otherDefs ->

622622 case def of

623− Can.Def (A.A region name) args _ expr ->

623+ Can.Def (A.At region name) args _ expr ->

624624 do let (Info flexVars flexCons flexHeaders) = flexInfo

625625

626626 (Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) <-

@@ -642,10 +642,10 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =

642642 Info

643643 { _vars = newFlexVars

644644 , _cons = defCon : flexCons

645− , _headers = Map.insert name (A.A region tipe) flexHeaders

645+ , _headers = Map.insert name (A.At region tipe) flexHeaders

646646 }

647647

648− Can.TypedDef (A.A region name) freeVars typedArgs _ expr srcResultType ->

648+ Can.TypedDef (A.At region name) freeVars typedArgs _ expr srcResultType ->

649649 do let newNames = Map.difference freeVars rtv

650650 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames

651651 let newRtv = Map.union rtv (Map.map VarN newRigids)

@@ -671,7 +671,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =

671671 ( Info

672672 { _vars = Map.foldr (:) rigidVars newRigids

673673 , _cons = defCon : rigidCons

674− , _headers = Map.insert name (A.A region tipe) rigidHeaders

674+ , _headers = Map.insert name (A.At region tipe) rigidHeaders

675675 }

676676 )

677677 flexInfo

@@ -738,7 +738,7 @@ typedArgsHelp rtv name args resultType state =

738738 [] ->

739739 return $ TypedArgs resultType resultType state

740740

741− (Can.TypedArg index srcType pattern@(A.A region _)) : otherArgs ->

741+ (Can.TypedArg index srcType pattern@(A.At region _)) : otherArgs ->

742742 do argType <- Instantiate.fromSrcType rtv srcType

743743 let expect = PatternExpectation region (PTypedArg name index) argType

744744

src/Type/Constrain/Pattern.hs+3−3

@@ -41,7 +41,7 @@ type Header = Map.Map N.Name (A.Located Type)

4141

4242

4343add :: Can.Pattern -> PatternExpectation -> State -> IO State

44−add (A.A region pattern) expectation state =

44+add (A.At region pattern) expectation state =

4545 case pattern of

4646 Can.PAnything ->

4747 return state

@@ -102,7 +102,7 @@ add (A.A region pattern) expectation state =

102102 let recordCon = CPattern region PRecord recordType expectation

103103 return $

104104 State

105− { _headers = Map.union headers (Map.map (A.A region) fieldTypes)

105+ { _headers = Map.union headers (Map.map (A.At region) fieldTypes)

106106 , _vars = map snd fieldVars ++ extVar : vars

107107 , _revCons = recordCon : revCons

108108 }

@@ -137,7 +137,7 @@ addToHeaders :: R.Region -> N.Name -> PatternExpectation -> State -> State

137137addToHeaders region name expectation (State headers vars revCons) =

138138 let

139139 tipe = getType expectation

140− newHeaders = Map.insert name (A.A region tipe) headers

140+ newHeaders = Map.insert name (A.At region tipe) headers

141141 in

142142 State newHeaders vars revCons

143143