@@ -71,7 +71,7 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
7171 Where we have as many arms as constructors but the last arm is a default.
7272 -/
7373
74- if let some kind ← trySimpleEnum defnInfo inductiveInfo xs numCtors motive then
74+ if let some kind ← trySimpleEnum inductiveInfo xs numCtors motive then
7575 return kind
7676
7777 if xs.size > 2 then
@@ -97,12 +97,11 @@ def isSupportedMatch (declName : Name) : MetaM (Option MatchKind) := do
9797
9898 if !defaultOk then return none
9999
100- if !(← verifyEnumWithDefault defnInfo inductiveInfo handledCtors) then return none
101100 return some <| .enumWithDefault inductiveInfo handledCtors
102101 else
103102 return none
104103where
105- trySimpleEnum (defnInfo : DefinitionVal) ( inductiveInfo : InductiveVal) (xs : Array Expr)
104+ trySimpleEnum (inductiveInfo : InductiveVal) (xs : Array Expr)
106105 (numCtors : Nat) (motive : Expr) : MetaM (Option MatchKind) := do
107106 -- Check that all parameters are `h_n EnumInductive.ctor`
108107 let mut handledCtors := Array.mkEmpty numCtors
@@ -113,66 +112,8 @@ where
113112 let .ctorInfo ctorInfo ← getConstInfo c | return none
114113 handledCtors := handledCtors.push ctorInfo
115114
116- if !(← verifySimpleEnum defnInfo inductiveInfo handledCtors) then return none
117-
118115 return some <| .simpleEnum inductiveInfo handledCtors
119116
120- verifySimpleCasesOnApp (inductiveInfo : InductiveVal) (fn : Expr) (args : Array Expr)
121- (params : Array Expr) : MetaM Bool := do
122- -- Body is an application of `EnumInductive.casesOn`
123- if !fn.isConstOf (mkCasesOnName inductiveInfo.name) then return false
124- if args.size != inductiveInfo.numCtors + 2 then return false
125- -- first argument is `(fun x => motive x)`
126- let firstArgOk ← lambdaTelescope args[0 ]! fun args body => do
127- if args.size != 1 then return false
128- let arg := args[0 ]!
129- let .app fn arg' := body | return false
130- return fn == params[0 ]! && arg == arg'
131-
132- if !firstArgOk then return false
133-
134- -- second argument is discr
135- return args[1 ]! == params[1 ]!
136-
137- verifySimpleEnum (defnInfo : DefinitionVal) (inductiveInfo : InductiveVal)
138- (ctors : Array ConstructorVal) : MetaM Bool := do
139- lambdaTelescope defnInfo.value fun params body =>
140- body.withApp fun fn args => do
141- if !(← verifySimpleCasesOnApp inductiveInfo fn args params) then return false
142-
143- -- remaining arguments are of the form `(h_n Unit.unit)`
144- for i in *...inductiveInfo.numCtors do
145- let .app fn (.const ``Unit.unit []) := args[i + 2 ]! | return false
146- let some (_, .app _ (.const relevantCtor ..)) := (← inferType fn).arrow? | unreachable!
147- let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
148- if fn != params[ctorIdx + 2 ]! then return false
149-
150- return true
151-
152- verifyEnumWithDefault (defnInfo : DefinitionVal) (inductiveInfo : InductiveVal)
153- (ctors : Array ConstructorVal) : MetaM Bool := do
154- lambdaTelescope defnInfo.value fun params body =>
155- body.withApp fun fn args => do
156- if !(← verifySimpleCasesOnApp inductiveInfo fn args params) then return false
157-
158- /-
159- Remaining arguments are of the form:
160- - `(h_n Unit.unit)` if the constructor is handled explicitly
161- - `(h_n InductiveEnum.ctor)` if the constructor is handled as part of the default case
162- -/
163- for i in *...inductiveInfo.numCtors do
164- let .app fn (.const argName ..) := args[i + 2 ]! | return false
165- if argName == ``Unit.unit then
166- let some (_, .app _ (.const relevantCtor ..)) := (← inferType fn).arrow? | unreachable!
167- let some ctorIdx := ctors.findIdx? (·.name == relevantCtor) | unreachable!
168- if fn != params[ctorIdx + 2 ]! then return false
169- else
170- let .ctorInfo ctorInfo ← getConstInfo argName | return false
171- if ctorInfo.cidx != i then return false
172- if fn != params[params.size - 1 ]! then return false
173-
174- return true
175-
176117def builtinTypes : Array Name :=
177118 #[``BitVec, ``Bool,
178119 ``UInt8, ``UInt16, ``UInt32, ``UInt64, ``USize,
0 commit comments