bac53de · elk · git.iko.soy

git.iko.soy/elk

Add info on alternate ctors to every pattern in canonicalization

commitbac53dee0c9834bfba5e98396ecba5f8d91eca8a authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 23 Nov 2017, 19:54 (9 years ago) parentea5c662

6 files changed+58−8

compare with master

unifiedsplit

src/AST/Canonical.hs+47−1 src/Canonicalize/Environment/Foreign.hs+4−1 src/Canonicalize/Environment/Internals.hs+1 src/Canonicalize/Environment/Local.hs+3−3 src/Canonicalize/Pattern.hs+2−2 src/Type/Constrain/Pattern.hs+1−1

src/AST/Canonical.hs+47−1

@@ -8,6 +8,10 @@ module AST.Canonical

88 , TypedArg(..)

99 -- patterns

1010 , Pattern, Pattern_(..)

11+ , CtorAlts(..)

12+ , CtorAlt(..)

13+ , toAlts

14+ , ctorsToAlts

1115 , PatternCtorArg(..)

1216 , Destructors

1317 , Destructor(..)

@@ -126,11 +130,47 @@ data Pattern_

126130 { _p_home :: ModuleName.Canonical

127131 , _p_type :: N.Name

128132 , _p_vars :: [N.Name]

133+ , _p_alts :: CtorAlts

129134 , _p_name :: N.Name

130135 , _p_args :: [PatternCtorArg]

131136 }

132137

133138

139+

140+-- PATTERN CTORS

141+

142+

143+data CtorAlts =

144+ CtorAlts

145+ { _num :: Int -- result of (length _alts) to amortize O(n) cost

146+ , _alts :: [CtorAlt]

147+ }

148+ deriving (Eq)

149+

150+

151+data CtorAlt =

152+ CtorAlt

153+ { _ctor :: N.Name

154+ , _arity :: Int

155+ }

156+ deriving (Eq)

157+

158+

159+toAlts :: [CtorAlt] -> CtorAlts

160+toAlts alts =

161+ CtorAlts (length alts) alts

162+

163+

164+ctorsToAlts :: [(N.Name, [Type])] -> CtorAlts

165+ctorsToAlts ctors =

166+ CtorAlts (length ctors) (map toAlt ctors)

167+

168+

169+toAlt :: (N.Name, [Type]) -> CtorAlt

170+toAlt (ctor, argTypes) =

171+ CtorAlt ctor (length argTypes)

172+

173+

134174data PatternCtorArg =

135175 PatternCtorArg

136176 { _index :: Index.ZeroBased

@@ -139,7 +179,13 @@ data PatternCtorArg =

139179 }

140180

141181

142−type Destructors = Map.Map N.Name (A.Located Destructor)

182+

183+-- DESTRUCTORS

184+

185+

186+type Destructors =

187+ Map.Map N.Name (A.Located Destructor)

188+

143189

144190data Destructor

145191 = DIndex Index.ZeroBased Destructor

src/Canonicalize/Environment/Foreign.hs+4−1

@@ -177,8 +177,11 @@ toPatternInfo _ pattern =

177177toPatterns :: ModuleName.Canonical -> (N.Name, Can.Union) -> [(N.Name, Env.Pattern)]

178178toPatterns home (tipe, Can.Union vars ctors) =

179179 let

180+ alts =

181+ Can.ctorsToAlts ctors

182+

180183 fromCtor (name, args) =

181− (name, Env.Pattern home tipe vars args)

184+ (name, Env.Pattern home tipe vars alts args)

182185 in

183186 map fromCtor ctors

184187

src/Canonicalize/Environment/Internals.hs+1

@@ -104,6 +104,7 @@ data Pattern =

104104 { _p_home :: ModuleName.Canonical

105105 , _p_type :: N.Name

106106 , _p_vars :: [N.Name]

107+ , _p_alts :: Can.CtorAlts

107108 , _p_args :: [Can.Type]

108109 }

109110

src/Canonicalize/Environment/Local.hs+3−3

@@ -86,10 +86,10 @@ addPatterns unions (Env.Env home vars types patterns binops) =

8686 Map.fromList $ concatMap toPatterns (Map.toList unions)

8787

8888 toPatterns (tipe, Can.Union tvars ctors) =

89− map (ctorToPattern tipe tvars) ctors

89+ map (ctorToPattern tipe tvars (Can.ctorsToAlts ctors)) ctors

9090

91− ctorToPattern tipe tvars (name, args) =

92− ( name, Env.Pattern home tipe tvars args )

91+ ctorToPattern tipe tvars alts (name, args) =

92+ ( name, Env.Pattern home tipe tvars alts args )

9393 in

9494 let

9595 newPatterns =

src/Canonicalize/Pattern.hs+2−2

@@ -102,11 +102,11 @@ process env destructor (A.At region pattern) =

102102 Can.PatternCtorArg index tipe

103103 <$> process env (Can.DIndex index destructor) ptrn

104104 in

105− do (Env.Pattern home tipe vars args) <- Env.findPattern nameRegion env maybePrefix name

105+ do (Env.Pattern home tipe vars alts args) <- Env.findPattern nameRegion env maybePrefix name

106106 verifiedList <- Index.indexedZipWithA toCanonicalArg patterns args

107107 case verifiedList of

108108 Index.LengthMatch cargs ->

109− Result.ok $ Can.PCtor home tipe vars name cargs

109+ Result.ok $ Can.PCtor home tipe vars alts name cargs

110110

111111 Index.LengthMismatch actualLength expectedLength ->

112112 Result.throw region (error "TODO" actualLength expectedLength)

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

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

6161 Can.PTuple a b maybeC ->

6262 addTuple region a b maybeC expectation state

6363

64− Can.PCtor home typeName typeVars ctorName args ->

64+ Can.PCtor home typeName typeVars _ ctorName args ->

6565 addCtor region home typeName typeVars ctorName args expectation state

6666

6767 Can.PList patterns ->