new main

lib/Quox/Parser/FromParser.idr

@@ -335,6 +335,8 @@ export covering
 fromPDef : PDefinition -> Eff FromParserPure NDefinition
 fromPDef (MkPDef qty pname ptype pterm defLoc) = do
   name <- fromPBaseNameNS pname
+  when !(getsAt DEFS $ isJust . lookup name) $ do
+    throw $ AlreadyExists defLoc name
   gqty <- globalPQty qty.val qty.loc
   let sqty = globalToSubj gqty
   type <- traverse fromPTerm ptype

lib/Quox/Parser/FromParser/Error.idr

@@ -32,6 +32,7 @@ data Error =
   | DimNameInTerm Loc PBaseName
   | DisplacedBoundVar Loc PName
   | WrapTypeError TypeError
+  | AlreadyExists Loc Name
   | LoadError Loc FilePath FileError
   | ExpectedFail Loc
   | WrongFail String Error Loc
@@ -112,6 +113,10 @@ parameters {opts : LayoutOpts} (showContext : Bool)
   prettyError (WrapTypeError err) =
     Typing.prettyError showContext $ trimContext 2 err
 
+  prettyError (AlreadyExists loc name) = pure $
+    vsep [!(prettyLoc loc),
+          sep [!(prettyFree name), "has already been defined"]]
+
   prettyError (LoadError loc file err) = pure $
     vsep [!(prettyLoc loc),
           "couldn't load file" <++> text file,

lib/Quox/Pretty.idr

@@ -115,11 +115,14 @@ export %inline
 hangD : {opts : LayoutOpts} -> Doc opts -> Doc opts -> Eff Pretty (Doc opts)
 hangD d1 d2 = pure $ hangSep !(askAt INDENT) d1 d2
 
+export %inline
+hangSingle : {opts : LayoutOpts} -> Nat -> Doc opts -> Doc opts -> Doc opts
+hangSingle n d1 d2 = ifMultiline (d1 <++> d2) (vappend d1 (indent n d2))
+
 export %inline
 hangDSingle : {opts : LayoutOpts} -> Doc opts -> Doc opts ->
               Eff Pretty (Doc opts)
-hangDSingle d1 d2 =
-  pure $ ifMultiline (d1 <++> d2) (vappend d1 !(indentD d2))
+hangDSingle d1 d2 = pure $ hangSingle !(askAt INDENT) d1 d2
 
 
 export
@@ -193,6 +196,11 @@ parameters {opts : LayoutOpts} {auto _ : Foldable t}
   fillSeparateTight d = fillSep . exceptLast (<+> d) . toList
 
 
+export %inline
+pshow : {opts : LayoutOpts} -> Show a => a -> Doc opts
+pshow = text . show
+
+
 export %inline
 ifUnicode : (uni, asc : Lazy a) -> Eff Pretty a
 ifUnicode uni asc =

lib/Quox/Syntax/DimEq.idr

@@ -237,9 +237,20 @@ setSelf (B i _)    (C eqs) with (compareP i i) | (compare i.nat i.nat)
   _ | IsGT gt | GT = absurd gt
 
 
+private %inline
+dimEqPrec : BContext d -> Maybe (DimEq' d) -> PPrec
+dimEqPrec vars eqs =
+  if length vars <= 1 && maybe True null eqs then Arg else Outer
+
 private
-prettyDVars : {opts : _} -> BContext d -> Eff Pretty (SnocList (Doc opts))
-prettyDVars = traverse prettyDBind . toSnocList'
+prettyDVars' : {opts : _} -> BContext d -> Eff Pretty (SnocList (Doc opts))
+prettyDVars' = traverse prettyDBind . toSnocList'
+
+export
+prettyDVars : {opts : _} -> BContext d -> Eff Pretty (Doc opts)
+prettyDVars vars =
+  parensIfM (dimEqPrec vars Nothing) $
+  fillSeparateTight !commaD $ !(prettyDVars' vars)
 
 private
 prettyCst : {opts : _} -> BContext d -> Dim d -> Dim d -> Eff Pretty (Doc opts)
@@ -256,16 +267,16 @@ prettyCsts dnames (eqs :< Just q)  =
 
 export
 prettyDimEq' : {opts : _} -> BContext d -> DimEq' d -> Eff Pretty (Doc opts)
-prettyDimEq' dnames eqs = do
-  vars <- prettyDVars dnames
-  eqs  <- prettyCsts dnames eqs
-  let prec = if length vars <= 1 && null eqs then Arg else Outer
-  parensIfM prec $ fillSeparateTight !commaD $ toList vars ++ toList eqs
+prettyDimEq' vars eqs = do
+  vars' <- prettyDVars' vars
+  eqs'  <- prettyCsts vars eqs
+  parensIfM (dimEqPrec vars (Just eqs)) $
+    fillSeparateTight !commaD $ vars' ++ eqs'
 
 export
 prettyDimEq : {opts : _} -> BContext d -> DimEq d -> Eff Pretty (Doc opts)
 prettyDimEq dnames ZeroIsOne = do
-  vars <- prettyDVars dnames
+  vars <- prettyDVars' dnames
   cst  <- prettyCst [<] (K Zero noLoc) (K One noLoc)
   pure $ separateTight !commaD $ vars :< cst
 prettyDimEq dnames (C eqs) = prettyDimEq' dnames eqs

lib/Quox/Untyped/Syntax.idr

@@ -144,6 +144,15 @@ parameters {opts : LayoutOpts}
   prettyTerm _ (Erased _) =
     hl Syntax =<< ifUnicode "⌷" "[]"
 
+  export
+  prettyDef : Name -> Definition -> Eff Pretty (Maybe (Doc opts))
+  prettyDef _    ErasedDef     = [|Nothing|]
+  prettyDef name (KeptDef rhs) = map Just $ do
+    name <- prettyFree name
+    eq   <- cstD
+    rhs  <- prettyTerm [<] rhs
+    hangDSingle (name <++> eq) rhs
+
 
 public export
 USubst : Nat -> Nat -> Type