make quantities optional and default to 1

lib/Quox/Parser/Parser.idr

@@ -198,18 +198,21 @@ export
 enumType : Grammar True (List TagVal)
 enumType = delimSep "{" "}" "," bareTag
 
-||| e.g. `case` or `case 1.`
+||| e.g. `case1` or `case 1.`
 export
 caseIntro : FileName -> Grammar True PQty
 caseIntro fname =
       withLoc fname (PQ Zero <$ res "case0")
   <|> withLoc fname (PQ One  <$ res "case1")
   <|> withLoc fname (PQ Any  <$ res "caseω")
-  <|> delim "case" "." (qty fname)
+  <|> do resC "case"
+         qty fname <* needRes "." <|> defLoc fname (PQ One)
 
 export
 qtyPatVar : FileName -> Grammar True (PQty, PatVar)
-qtyPatVar fname = [|(,) (qty fname) (needRes "." *> patVar fname)|]
+qtyPatVar fname =
+      [|(,) (qty fname) (needRes "." *> patVar fname)|]
+  <|> [|(,) (defLoc fname $ PQ One) (patVar fname)|]
 
 
 export
@@ -438,18 +441,6 @@ properBinders fname = assert_total $ do
   t  <- term fname;          needRes ")"
   pure (xs, t)
 
-export
-piTerm : FileName -> Grammar True PTerm
-piTerm fname = withLoc fname $ do
-  q   <- qty fname;               resC "."
-  dom <- piBinder;                needRes "→"
-  cod <- assert_total term fname; commit
-  pure $ \loc => foldr (\x, t => Pi q x (snd dom) t loc) cod (fst dom)
-where
-  piBinder : Grammar True (List1 PatVar, PTerm)
-  piBinder = properBinders fname
-         <|> [|(,) [|singleton $ unused fname|] (termArg fname)|]
-
 export
 sigmaTerm : FileName -> Grammar True PTerm
 sigmaTerm fname =
@@ -470,6 +461,42 @@ where
     rest <- optional $ resC "×" *> sepBy1 (res "×") (annTerm fname)
     pure $ foldr1 cross $ fst ::: maybe [] toList rest
 
+export
+piTerm : FileName -> Grammar True PTerm
+piTerm fname = withLoc fname $ do
+  q   <- [|GivenQ $ qty fname <* resC "."|] <|> defLoc fname DefaultQ
+  dom <- [|Dep $ properBinders fname|] <|> [|Nondep $ ndDom q fname|]
+  cod <- optional $ do resC "→"; assert_total term fname <* commit
+  when (needCod q dom && isNothing cod) $ fail "missing function type result"
+  pure $ maybe (const $ toTerm dom) (makePi q dom) cod
+where
+  data PiQty = GivenQ PQty | DefaultQ Loc
+  data PiDom = Dep (List1 PatVar, PTerm) | Nondep PTerm
+
+  ndDom : PiQty -> FileName -> Grammar True PTerm
+  ndDom (GivenQ   _) = termArg   -- ｢1.(List A)｣, not ｢1.List A｣
+  ndDom (DefaultQ _) = sigmaTerm
+
+  needCod : PiQty -> PiDom -> Bool
+  needCod (DefaultQ _) (Nondep _) = False
+  needCod _            _          = True
+
+  toTerm : PiDom -> PTerm
+  toTerm (Dep (_, s)) = s
+  toTerm (Nondep s)   = s
+
+  toQty : PiQty -> PQty
+  toQty (GivenQ   qty) = qty
+  toQty (DefaultQ loc) = PQ One loc
+
+  toDoms : PQty -> PiDom -> List1 (PQty, PatVar, PTerm)
+  toDoms qty (Dep (xs, s)) = [(qty, x, s) | x <- xs]
+  toDoms qty (Nondep s)    = singleton (qty, Unused s.loc, s)
+
+  makePi : PiQty -> PiDom -> PTerm -> Loc -> PTerm
+  makePi q doms cod loc =
+    foldr (\(q, x, s), t => Pi q x s t loc) cod $ toDoms (toQty q) doms
+
 public export
 PCaseArm : Type
 PCaseArm = (PCasePat, PTerm)