box type

lib/Quox/Syntax/Term/Base.idr

@@ -81,6 +81,10 @@ mutual
     Zero : Term q d n
     Succ : (p : Term q d n) -> Term q d n
 
+    ||| "box" (package a value up with a certain quantity)
+    BOX : (qty : q) -> (ty : Term q d n) -> Term q d n
+    Box : (val : Term q d n) -> Term q d n
+
     ||| elimination
     E : (e : Elim q d n) -> Term q d n
 
@@ -124,6 +128,12 @@ mutual
               (succ : ScopeTermN 2 q d n) ->
               Elim q d n
 
+    ||| unboxing
+    CaseBox : (qty : q) -> (box : Elim q d n) ->
+              (ret : ScopeTerm q d n) ->
+              (body : ScopeTerm 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

@@ -162,6 +162,10 @@ export
 prettyTagBare : TagVal -> Doc HL
 prettyTagBare t = hl Tag $ quoteTag t
 
+export
+prettyBoxVal : PrettyHL a => Pretty.HasEnv m => a -> m (Doc HL)
+prettyBoxVal val = bracks <$> pretty0M val
+
 export
 toNatLit : Term q d n -> Maybe Nat
 toNatLit Zero     = Just 0
@@ -224,6 +228,11 @@ parameters (showSubsts : Bool)
         Nothing => do
           n <- withPrec Arg $ prettyM n
           parensIfM App $ succD <++> n
+    prettyM (BOX pi ty) = do
+      pi <- pretty0M pi
+      ty <- pretty0M ty
+      pure $ bracks $ hcat [pi, dotD, align ty]
+    prettyM (Box val) = prettyBoxVal val
     prettyM (E e) = prettyM e
     prettyM (CloT s th) =
       if showSubsts then
@@ -260,8 +269,13 @@ parameters (showSubsts : Bool)
          ([< s, ih], !succPat, eterm suc.term)]
       where
         succPat : m (Doc HL)
-        succPat = pure $
-          hsep [succD, !(pretty0M s), bracks !(pretty0M $ MkWithQty pi' ih)]
+        succPat = case ih of
+          Unused => pure $ hsep [succD, !(pretty0M s)]
+          _      => pure $ sep [hsep [succD, !(pretty0M s)] <+> comma,
+                                !(pretty0M $ MkWithQty pi' ih)]
+    prettyM (CaseBox pi box (S [< r] ret) (S [< u] body)) =
+      prettyCase pi box r ret.term
+        [([< u], !(prettyBoxVal $ TV u), body.term)]
     prettyM (e :% d) =
       let GotDArgs {fun, args, _} = getDArgs' e [d] in
       prettyApps (Just "@") fun args

lib/Quox/Syntax/Term/Subst.idr

@@ -271,6 +271,8 @@ mutual
     pushSubstsWith _ _ Nat = nclo Nat
     pushSubstsWith _ _ Zero = nclo Zero
     pushSubstsWith th ph (Succ n) = nclo $ Succ $ n // th // ph
+    pushSubstsWith th ph (BOX pi ty) = nclo $ BOX pi $ ty // th // ph
+    pushSubstsWith th ph (Box val) = nclo $ Box $ val // th // ph
     pushSubstsWith th ph (E e) =
       let Element e nc = pushSubstsWith th ph e in nclo $ E e
     pushSubstsWith th ph (CloT s ps) =
@@ -297,6 +299,8 @@ mutual
     pushSubstsWith th ph (CaseNat pi pi' n r z s) =
       nclo $ CaseNat pi pi' (n // th // ph) (r // th // ph)
                (z // th // ph) (s // th // ph)
+    pushSubstsWith th ph (CaseBox pi x r b) =
+      nclo $ CaseBox pi (x // th // ph) (r // th // ph) (b // th // ph)
     pushSubstsWith th ph (f :% d) =
       nclo $ (f // th // ph) :% (d // th)
     pushSubstsWith th ph (s :# a) =