add enums, which also need whnf to be fallible :(

lib/Quox/Syntax/Term/Base.idr

@@ -18,6 +18,8 @@ import Data.Nat
 import public Data.So
 import Data.String
 import Data.Vect
+import public Data.SortedMap
+import public Data.SortedSet
 
 %default total
 
@@ -30,6 +32,9 @@ public export
 0 TSubstLike : Type
 TSubstLike = Type -> Nat -> Nat -> Nat -> Type
 
+public export
+0 TagVal : Type
+TagVal = String
 
 infixl 8 :#
 infixl 9 :@, :%
@@ -57,6 +62,11 @@ mutual
     ||| pair value
     Pair : (fst, snd : Term q d n) -> Term q d n
 
+    ||| enumeration type
+    Enum : (cases : SortedSet TagVal) -> Term q d n
+    ||| enumeration value
+    Tag : (tag : TagVal) -> Term q d n
+
     ||| equality type
     Eq : (ty : DScopeTerm q d n) -> (l, r : Term q d n) -> Term q d n
     ||| equality term
@@ -92,6 +102,12 @@ mutual
                (body : ScopeTermN 2 q d n) ->
                Elim q d n
 
+    ||| enum matching
+    CaseEnum : (qty : q) -> (tag : Elim q d n) ->
+               (ret : ScopeTerm q d n) ->
+               (arms : CaseEnumArms q d n) ->
+               Elim q d n
+
     ||| dim application
     (:%) : (fun : Elim q d n) -> (arg : Dim d) -> Elim q d n
 

lib/Quox/Syntax/Term/Pretty.idr

@@ -85,6 +85,11 @@ prettyCase pi elim r ret arms =
      hsep [returnD, !(prettyM r), !darrowD, !(under T r $ prettyM ret)],
      hsep [ofD,     !(prettyArms arms)]]
 
+-- [fixme] put delimiters around tags that aren't simple names
+export
+prettyTag : TagVal -> Doc HL
+prettyTag t = hl Tag $ "`" <+> fromString t
+
 
 mutual
   export covering
@@ -101,6 +106,10 @@ mutual
     prettyM (Pair s t) =
       let GotPairs {init, last, _} = getPairs t in
       prettyTuple $ s :: init ++ [last]
+    prettyM (Enum tags) =
+      pure $ braces . aseparate comma $ map prettyTag $ Prelude.toList tags
+    prettyM (Tag t) =
+      pure $ prettyTag t
     prettyM (Eq (S _ (N ty)) l r) =
       parensIfM Eq !(withPrec InEq $ pure $
         sep [!(prettyM l) <++> !eqndD,
@@ -137,6 +146,9 @@ mutual
       pat <- (parens . separate commaD . map (hl TVar)) <$>
              traverse prettyM [x, y]
       prettyCase pi p r ret [([x, y], pat, body)]
+    prettyM (CaseEnum pi t (S [r] ret) arms) =
+      prettyCase pi t r ret
+        [([], prettyTag t, b) | (t, b) <- SortedMap.toList arms]
     prettyM (e :% d) =
       let GotDArgs {fun, args, _} = getDArgs' e [d] in
       prettyApps fun args