git.iko.soy/elk
on master help sign in
Update type constraint generators for new Reporting.Annotation
179fad8Evan Czaplicki
src/Type/Constrain/Expression.hs+11−11
compare with master
unifiedsplit
@@ -36,7 +36,7 @@ type RTV =
36
36
37
37
38constrain :: RTV -> Can.Expr -> Expectation -> IO Constraint
38constrain :: RTV -> Can.Expr -> Expectation -> IO Constraint
39−constrain rtv (A.A region expression) expectation =
39+constrain rtv (A.At region expression) expectation =
40 case expression of
40 case expression of
41 Can.VarLocal name ->
41 Can.VarLocal name ->
42 return (CLookup region name expectation)
42 return (CLookup region name expectation)
@@ -225,7 +225,7 @@ constrainCallBackup rtv region maybeFuncName func args =
225
225
226
226
227getFuncName :: Can.Expr -> Maybe FuncName
227getFuncName :: Can.Expr -> Maybe FuncName
228−getFuncName (A.A _ expr) =
228+getFuncName (A.At _ expr) =
229 case expr of
229 case expr of
230 Can.VarLocal name ->
230 Can.VarLocal name ->
231 Just (FuncName name)
231 Just (FuncName name)
@@ -532,7 +532,7 @@ constrainDestruct rtv region pattern expr bodyCon =
532constrainDef :: RTV -> Can.Def -> Constraint -> IO Constraint
532constrainDef :: RTV -> Can.Def -> Constraint -> IO Constraint
533constrainDef rtv def bodyCon =
533constrainDef rtv def bodyCon =
534 case def of
534 case def of
535− Can.Def (A.A region name) args _ expr ->
535+ Can.Def (A.At region name) args _ expr ->
536 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-
536 do (Args vars tipe resultType (Pattern.State headers pvars revCons)) <-
537 constrainArgs args
537 constrainArgs args
538
538
@@ -543,7 +543,7 @@ constrainDef rtv def bodyCon =
543 CLet
543 CLet
544 { _rigidVars = []
544 { _rigidVars = []
545 , _flexVars = vars
545 , _flexVars = vars
546− , _header = Map.singleton name (A.A region tipe)
546+ , _header = Map.singleton name (A.At region tipe)
547 , _headerCon =
547 , _headerCon =
548 CLet
548 CLet
549 { _rigidVars = []
549 { _rigidVars = []
@@ -555,7 +555,7 @@ constrainDef rtv def bodyCon =
555 , _bodyCon = bodyCon
555 , _bodyCon = bodyCon
556 }
556 }
557
557
558− Can.TypedDef (A.A region name) freeVars typedArgs _ expr srcResultType ->
558+ Can.TypedDef (A.At region name) freeVars typedArgs _ expr srcResultType ->
559 do let newNames = Map.difference freeVars rtv
559 do let newNames = Map.difference freeVars rtv
560 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
560 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
561 let newRtv = Map.union rtv (Map.map VarN newRigids)
561 let newRtv = Map.union rtv (Map.map VarN newRigids)
@@ -571,7 +571,7 @@ constrainDef rtv def bodyCon =
571 CLet
571 CLet
572 { _rigidVars = Map.elems newRigids
572 { _rigidVars = Map.elems newRigids
573 , _flexVars = []
573 , _flexVars = []
574− , _header = Map.singleton name (A.A region tipe)
574+ , _header = Map.singleton name (A.At region tipe)
575 , _headerCon =
575 , _headerCon =
576 CLet
576 CLet
577 { _rigidVars = []
577 { _rigidVars = []
@@ -620,7 +620,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =
620
620
621 def : otherDefs ->
621 def : otherDefs ->
622 case def of
622 case def of
623− Can.Def (A.A region name) args _ expr ->
623+ Can.Def (A.At region name) args _ expr ->
624 do let (Info flexVars flexCons flexHeaders) = flexInfo
624 do let (Info flexVars flexCons flexHeaders) = flexInfo
625
625
626 (Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) <-
626 (Args newFlexVars tipe resultType (Pattern.State headers pvars revCons)) <-
@@ -642,10 +642,10 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =
642 Info
642 Info
643 { _vars = newFlexVars
643 { _vars = newFlexVars
644 , _cons = defCon : flexCons
644 , _cons = defCon : flexCons
645− , _headers = Map.insert name (A.A region tipe) flexHeaders
645+ , _headers = Map.insert name (A.At region tipe) flexHeaders
646 }
646 }
647
647
648− Can.TypedDef (A.A region name) freeVars typedArgs _ expr srcResultType ->
648+ Can.TypedDef (A.At region name) freeVars typedArgs _ expr srcResultType ->
649 do let newNames = Map.difference freeVars rtv
649 do let newNames = Map.difference freeVars rtv
650 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
650 newRigids <- Map.traverseWithKey (\n _ -> nameToRigid n) newNames
651 let newRtv = Map.union rtv (Map.map VarN newRigids)
651 let newRtv = Map.union rtv (Map.map VarN newRigids)
@@ -671,7 +671,7 @@ recDefsHelp rtv defs bodyCon rigidInfo flexInfo =
671 ( Info
671 ( Info
672 { _vars = Map.foldr (:) rigidVars newRigids
672 { _vars = Map.foldr (:) rigidVars newRigids
673 , _cons = defCon : rigidCons
673 , _cons = defCon : rigidCons
674− , _headers = Map.insert name (A.A region tipe) rigidHeaders
674+ , _headers = Map.insert name (A.At region tipe) rigidHeaders
675 }
675 }
676 )
676 )
677 flexInfo
677 flexInfo
@@ -738,7 +738,7 @@ typedArgsHelp rtv name args resultType state =
738 [] ->
738 [] ->
739 return $ TypedArgs resultType resultType state
739 return $ TypedArgs resultType resultType state
740
740
741− (Can.TypedArg index srcType pattern@(A.A region _)) : otherArgs ->
741+ (Can.TypedArg index srcType pattern@(A.At region _)) : otherArgs ->
742 do argType <- Instantiate.fromSrcType rtv srcType
742 do argType <- Instantiate.fromSrcType rtv srcType
743 let expect = PatternExpectation region (PTypedArg name index) argType
743 let expect = PatternExpectation region (PTypedArg name index) argType
744
744
src/Type/Constrain/Pattern.hs+3−3
@@ -41,7 +41,7 @@ type Header = Map.Map N.Name (A.Located Type)
41
41
42
42
43add :: Can.Pattern -> PatternExpectation -> State -> IO State
43add :: Can.Pattern -> PatternExpectation -> State -> IO State
44−add (A.A region pattern) expectation state =
44+add (A.At region pattern) expectation state =
45 case pattern of
45 case pattern of
46 Can.PAnything ->
46 Can.PAnything ->
47 return state
47 return state
@@ -102,7 +102,7 @@ add (A.A region pattern) expectation state =
102 let recordCon = CPattern region PRecord recordType expectation
102 let recordCon = CPattern region PRecord recordType expectation
103 return $
103 return $
104 State
104 State
105− { _headers = Map.union headers (Map.map (A.A region) fieldTypes)
105+ { _headers = Map.union headers (Map.map (A.At region) fieldTypes)
106 , _vars = map snd fieldVars ++ extVar : vars
106 , _vars = map snd fieldVars ++ extVar : vars
107 , _revCons = recordCon : revCons
107 , _revCons = recordCon : revCons
108 }
108 }
@@ -137,7 +137,7 @@ addToHeaders :: R.Region -> N.Name -> PatternExpectation -> State -> State
137addToHeaders region name expectation (State headers vars revCons) =
137addToHeaders region name expectation (State headers vars revCons) =
138 let
138 let
139 tipe = getType expectation
139 tipe = getType expectation
140− newHeaders = Map.insert name (A.A region tipe) headers
140+ newHeaders = Map.insert name (A.At region tipe) headers
141 in
141 in
142 State newHeaders vars revCons
142 State newHeaders vars revCons
143
143