@@ -259,9 +259,10 @@ scoped elab "_qq_match" pat:term " ← " e:term " | " alt:term " in " body:term
259259 makeMatchCode q($inst2) inst oldPatVarDecls argLvlExpr argTyExpr synthed q($e') alt expectedType fun expectedType =>
260260 return Quoted.unsafeMk (← elabTerm body expectedType)
261261
262- scoped syntax "_qq_match" term " := " term " | " doSeq : term
262+ scoped syntax "_qq_match" term " := " term " | " doSeqIndent : term
263263macro_rules
264- | `(assert! (_qq_match $pat := $e | $alt); $x) => `(_qq_match $pat ← $e | (do $alt) in $x)
264+ | `(assert! (_qq_match $pat := $e | $alt); $x) =>
265+ `(_qq_match $pat ← $e | (do $alt:doSeqIndent) in $x)
265266
266267partial def isIrrefutablePattern : Term → Bool
267268 | `(($stx)) => isIrrefutablePattern stx
@@ -279,18 +280,10 @@ scoped elab "_comefrom" n:ident "do" b:doSeq " in " body:term : term <= expected
279280scoped syntax "_comefrom" ident "do" doSeq : term
280281macro_rules | `(assert! (_comefrom $n do $b); $body) => `(_comefrom $n do $b in $body)
281282
283+ -- The point of this macro as SG sees it is to get the do block result type to push it into `$b`
282284scoped macro "comefrom" n:ident "do" b:doSeq : doElem =>
283285 `(doElem| assert! (_comefrom $n do $b))
284286
285- def mkLetDoSeqItem [Monad m] [MonadQuotation m] (pat : Term) (rhs : TSyntax `term) (alt : TSyntax ``doSeq) : m (List (TSyntax ``doSeqItem)) := do
286- match pat with
287- | `(_) => return []
288- | _ =>
289- if isIrrefutablePattern pat then
290- return [← `(doSeqItem| let $pat:term := $rhs)]
291- else
292- return [← `(doSeqItem| let $pat:term := $rhs | $alt)]
293-
294287end Impl
295288
296289section
@@ -336,7 +329,7 @@ partial def Impl.hasQMatch : Syntax → Bool
336329 | `(~q($_)) => true
337330 | stx => stx.getArgs.any hasQMatch
338331
339- partial def Impl.floatQMatch (alt : TSyntax ``doSeq ) : Term → StateT (List (TSyntax ``doSeqItem)) MacroM Term
332+ partial def Impl.floatQMatch (alt : TSyntax ``doSeqIndent ) : Term → StateT (List (TSyntax ``doSeqItem)) MacroM Term
340333 | `(~q($term)) =>
341334 withFreshMacroScope do
342335 let auxDoElem ← `(doSeqItem| let ~q($term) := x | $alt)
@@ -397,25 +390,43 @@ macro_rules
397390 if !hasQMatch pat then Macro.throwUnsupported
398391 Macro.throwError "let-bindings with ~q(.) require an explicit alternative"
399392
400- | `(doElem| let $pat:term := $rhs:term | $alt:doSeq ) => do
393+ | `(doElem| let $pat:term := $rhs:term | $alt $(body?)? ) => do
401394 if !hasQMatch pat then Macro.throwUnsupported
402395 match pat with
403396 | `(~q($pat)) =>
404397 let (pat, lifts) ← floatExprAntiquot 0 pat #[]
405- let t ← `(doSeqItem| do assert! (_qq_match $pat := $rhs | $alt))
406- `(doElem| do $(lifts.push t):doSeqItem*)
398+ let t ← `(doSeqItem| assert! (_qq_match $pat := $rhs | $alt))
399+ let mut items := lifts.push t
400+ if let some body := body? then
401+ items := items.push (← `(doSeqItem| do $body:doSeqIndent))
402+ `(doElem| do $items:doSeqItem*)
407403
408404 | _ =>
409- let (pat', auxs) ← floatQMatch (← `(doSeq| __alt)) pat []
410- let items :=
411- #[← `(doSeqItem| comefrom __alt do $alt:doSeq)] ++
412- (← mkLetDoSeqItem pat' rhs alt) ++
413- auxs
414- `(doElem| do $items:doSeqItem*)
405+ let (pat', auxs) ← floatQMatch (← `(doSeqIndent| __alt)) pat []
406+ -- Build the nested body from inside out, so that every `doLetElse` always has a body.
407+ -- This is necessary because the do elaborator defaults body to `pure PUnit.unit`
408+ -- when no body is provided, causing type mismatches.
409+ let body ← match body? with
410+ | some body => `(doElem| do $body:doSeqIndent)
411+ | none => `(doElem| pure PUnit.unit)
412+ let mut body := body
413+ for aux in auxs.reverse do
414+ body ← `(doElem| do $aux:doSeqItem
415+ $body:doElem)
416+ let outerRhs ← match pat' with
417+ | `(_) => pure body
418+ | _ =>
419+ if isIrrefutablePattern pat' then
420+ `(doElem| do let $pat':term := $rhs; $body:doElem)
421+ else
422+ `(doElem| let $pat':term := $rhs | __alt -- line break to break up application
423+ $body:doElem)
424+ `(doElem| do comefrom __alt do $alt:doSeqIndent
425+ $outerRhs:doElem)
415426
416427 | `(match $[$gen:generalizingParam]? $[$discrs:term],* with $[| $[$patss],* => $rhss]*) => do
417428 if !patss.any (·.any (hasQMatch ·)) then Macro.throwUnsupported
418- `(do match $[$gen]? $[$discrs:term],* with $[| $[$patss:term],* => $rhss:term]*)
429+ `(do match $[$gen:generalizingParam ]? $[$discrs:term],* with $[| $[$patss:term],* => $rhss:term]*)
419430
420431 | `(doElem| match $[$gen:generalizingParam]? $[$discrs:term],* with $[| $[$patss],* => $rhss]*) => do
421432 if !patss.any (·.any (hasQMatch ·)) then Macro.throwUnsupported
@@ -429,11 +440,14 @@ macro_rules
429440 let mut items := #[]
430441 items := items.push (← `(doSeqItem| comefrom __alt do throwError "nonexhaustive match" ))
431442 for pats in patss.reverse, rhs in rhss.reverse do
432- let mut subItems : Array (TSyntax ``doSeqItem) := #[]
433- for discr in discrs, pat in pats do
434- subItems := subItems ++ (← mkLetDoSeqItem pat discr (← `(doSeq| __alt)))
435- subItems := subItems.push (← `(doSeqItem| do $rhs))
436- items := items.push (← `(doSeqItem| comefrom __alt do $subItems:doSeqItem*))
443+ let mut rhs ← `(doElem| do $rhs)
444+ for discr in discrs.reverse, pat in pats.reverse do
445+ if isIrrefutablePattern pat then
446+ rhs ← `(doElem| do let $pat:term := $discr; $rhs:doElem)
447+ else
448+ rhs ← `(doElem| let $pat:term := $discr | __alt -- line break to break up application
449+ $rhs:doElem)
450+ items := items.push (← `(doSeqItem| comefrom __alt do $rhs:doElem))
437451 items := items.push (← `(doSeqItem| __alt))
438452 `(doElem| (do $items:doSeqItem*))
439453
0 commit comments