add ValueType

anoma · May 30, 2023 · 0126124 · 0126124
1 parent 121063c
commit 0126124
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 3 deletions.
diff --git a/src/Juvix/Compiler/Core/Extra/Value.hs b/src/Juvix/Compiler/Core/Extra/Value.hs
@@ -14,7 +14,20 @@ toValue tab = \case
   NCtr c -> goConstr c
   NLam lam -> goLambda lam
   Closure {..} -> toValue tab (substEnv _closureEnv _closureNode)
-  _ -> impossible
+  NPi {} -> goType
+  NUniv {} -> goType
+  NTyp {} -> goType
+  NPrim {} -> goType
+  NVar {} -> impossible
+  NIdt {} -> impossible
+  NApp {} -> impossible
+  NBlt {} -> impossible
+  NLet {} -> impossible
+  NRec {} -> impossible
+  NCase {} -> impossible
+  NMatch {} -> impossible
+  NDyn {} -> impossible
+  NBot {} -> impossible
   where
     goConstr :: Constr -> Value
     goConstr Constr {..} =
@@ -29,6 +42,9 @@ toValue tab = \case
         ii = lookupInductiveInfo tab (ci ^. constructorInductive)
         paramsNum = length (ii ^. inductiveParams)
 
+    goType :: Value
+    goType = ValueType
+
     goLambda :: Lambda -> Value
     goLambda lam =
       let (lams, body) = unfoldLambdas (NLam lam)
@@ -40,5 +56,4 @@ toValue tab = \case
                   case body of
                     NCtr c ->
                       toValue tab (NCtr (over constrArgs (dropEnd n) c))
-                    _ ->
-                      ValueFun
+                    _ -> ValueFun
diff --git a/src/Juvix/Compiler/Core/Language/Value.hs b/src/Juvix/Compiler/Core/Language/Value.hs
@@ -15,6 +15,7 @@ data Value
   | ValueConstant ConstantValue
   | ValueWildcard
   | ValueFun
+  | ValueType
 
 makeLenses ''ConstrApp
 
@@ -29,3 +30,4 @@ instance HasAtomicity Value where
     ValueConstant {} -> Atom
     ValueWildcard -> Atom
     ValueFun -> Atom
+    ValueType -> Atom
diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs
@@ -598,6 +598,7 @@ instance PrettyCode Value where
     ValueConstant c -> ppCode c
     ValueWildcard -> return "_"
     ValueFun -> return "<fun>"
+    ValueType -> return "<type>"
 
 ppValueSequence :: Member (Reader Options) r => [Value] -> Sem r (Doc Ann)
 ppValueSequence vs = hsep <$> mapM (ppRightExpression appFixity) vs