parenthesize delayed types/terms in errors

src/Idris/Syntax.idr

@@ -27,19 +27,19 @@ OpStr = Name
 
 mutual
   -- The full high level source language
-  -- This gets desugared to RawImp (TTImp.TTImp), then elaborated to 
+  -- This gets desugared to RawImp (TTImp.TTImp), then elaborated to
   -- Term (Core.TT)
   public export
   data PTerm : Type where
        -- Direct (more or less) translations to RawImp
 
        PRef : FC -> Name -> PTerm
-       PPi : FC -> RigCount -> PiInfo -> Maybe Name -> 
+       PPi : FC -> RigCount -> PiInfo -> Maybe Name ->
              (argTy : PTerm) -> (retTy : PTerm) -> PTerm
        PLam : FC -> RigCount -> PiInfo -> PTerm ->
               (argTy : PTerm) -> (scope : PTerm) -> PTerm
-       PLet : FC -> RigCount -> (pat : PTerm) -> 
+       PLet : FC -> RigCount -> (pat : PTerm) ->
-              (nTy : PTerm) -> (nVal : PTerm) -> (scope : PTerm) -> 
+              (nTy : PTerm) -> (nVal : PTerm) -> (scope : PTerm) ->
               (alts : List PClause) -> PTerm
        PCase : FC -> PTerm -> List PClause -> PTerm
        PLocal : FC -> List PDecl -> (scope : PTerm) -> PTerm
@@ -73,7 +73,7 @@ mutual
        PBracketed : FC -> PTerm -> PTerm
 
        -- Syntactic sugar
-       
+
        PDoBlock : FC -> List PDo -> PTerm
        PList : FC -> List PTerm -> PTerm
        PPair : FC -> PTerm -> PTerm -> PTerm
@@ -87,7 +87,7 @@ mutual
        -- A stream range [x,y..]
        PRangeStream : FC -> PTerm -> Maybe PTerm -> PTerm
 
-       -- TODO: Ranges, idiom brackets (?), 
+       -- TODO: Ranges, idiom brackets (?),
        -- 'with' disambiguation
 
   public export
@@ -133,9 +133,9 @@ mutual
 
   public export
   data PClause : Type where
-       MkPatClause : FC -> (lhs : PTerm) -> (rhs : PTerm) -> 
+       MkPatClause : FC -> (lhs : PTerm) -> (rhs : PTerm) ->
                      (whereblock : List PDecl) -> PClause
-       MkWithClause : FC -> (lhs : PTerm) -> (wval : PTerm) -> 
+       MkWithClause : FC -> (lhs : PTerm) -> (wval : PTerm) ->
                         List PClause -> PClause
        MkImpossible : FC -> (lhs : PTerm) -> PClause
 
@@ -158,7 +158,7 @@ mutual
   public export
   data PField : Type where
        MkField : FC -> RigCount -> PiInfo -> Name -> (ty : PTerm) -> PField
-  
+
   -- For noting the pass we're in when desugaring a mutual block
   -- TODO: Decide whether we want mutual blocks!
   public export
@@ -186,8 +186,8 @@ mutual
        PData : FC -> Visibility -> PDataDecl -> PDecl
        PParameters : FC -> List (Name, PTerm) -> List PDecl -> PDecl
        PReflect : FC -> PTerm -> PDecl
-       PInterface : FC -> 
+       PInterface : FC ->
-                    Visibility -> 
+                    Visibility ->
                     (constraints : List (Maybe Name, PTerm)) ->
                     Name ->
                     (params : List (Name, PTerm)) ->
@@ -204,7 +204,7 @@ mutual
                          Maybe (List PDecl) ->
                          PDecl
        PRecord : FC ->
-                 Visibility -> 
+                 Visibility ->
                  Name ->
                  (params : List (Name, PTerm)) ->
                  (conName : Maybe Name) ->
@@ -303,7 +303,7 @@ showCount : RigCount -> String
 showCount Rig0 = "0 "
 showCount Rig1 = "1 "
 showCount RigW = ""
-      
+
 mutual
   showAlt : PClause -> String
   showAlt (MkPatClause _ lhs rhs _) = " | " ++ show lhs ++ " => " ++ show rhs ++ ";"
@@ -313,10 +313,10 @@ mutual
   showDo : PDo -> String
   showDo (DoExp _ tm) = show tm
   showDo (DoBind _ n tm) = show n ++ " <- " ++ show tm
-  showDo (DoBindPat _ l tm alts) 
+  showDo (DoBindPat _ l tm alts)
       = show l ++ " <- " ++ show tm ++ concatMap showAlt alts
   showDo (DoLet _ l rig tm) = "let " ++ show l ++ " = " ++ show tm
-  showDo (DoLetPat _ l tm alts) 
+  showDo (DoLetPat _ l tm alts)
       = "let " ++ show l ++ " = " ++ show tm ++ concatMap showAlt alts
   showDo (DoLetLocal _ ds)
       -- We'll never see this when displaying a normal form...
@@ -330,95 +330,95 @@ mutual
 
   export
   Show PTerm where
-    show (PRef _ n) = show n
+    showPrec d (PRef _ n) = showPrec d n
-    show (PPi _ rig Explicit Nothing arg ret)
+    showPrec d (PPi _ rig Explicit Nothing arg ret)
-        = show arg ++ " -> " ++ show ret
+        = showPrec d arg ++ " -> " ++ showPrec d ret
-    show (PPi _ rig Explicit (Just n) arg ret)
+    showPrec d (PPi _ rig Explicit (Just n) arg ret)
-        = "(" ++ showCount rig ++ show n ++ " : " ++ show arg ++ ") -> " ++ show ret
+        = "(" ++ showCount rig ++ showPrec d n ++ " : " ++ showPrec d arg ++ ") -> " ++ showPrec d ret
-    show (PPi _ rig Implicit Nothing arg ret) -- shouldn't happen
+    showPrec d (PPi _ rig Implicit Nothing arg ret) -- shouldn't happen
-        = "{" ++ showCount rig ++ "_ : " ++ show arg ++ "} -> " ++ show ret
+        = "{" ++ showCount rig ++ "_ : " ++ showPrec d arg ++ "} -> " ++ showPrec d ret
-    show (PPi _ rig Implicit (Just n) arg ret)
+    showPrec d (PPi _ rig Implicit (Just n) arg ret)
-        = "{" ++ showCount rig ++ show n ++ " : " ++ show arg ++ "} -> " ++ show ret
+        = "{" ++ showCount rig ++ showPrec d n ++ " : " ++ showPrec d arg ++ "} -> " ++ showPrec d ret
-    show (PPi _ RigW AutoImplicit Nothing arg ret)
+    showPrec d (PPi _ RigW AutoImplicit Nothing arg ret)
-        = show arg ++ " => " ++ show ret
+        = showPrec d arg ++ " => " ++ showPrec d ret
-    show (PPi _ rig AutoImplicit Nothing arg ret) -- shouldn't happen
+    showPrec d (PPi _ rig AutoImplicit Nothing arg ret) -- shouldn't happen
-        = "{auto " ++ showCount rig ++ "_ : " ++ show arg ++ "} -> " ++ show ret
+        = "{auto " ++ showCount rig ++ "_ : " ++ showPrec d arg ++ "} -> " ++ showPrec d ret
-    show (PPi _ rig AutoImplicit (Just n) arg ret)
+    showPrec d (PPi _ rig AutoImplicit (Just n) arg ret)
-        = "{auto " ++ showCount rig ++ show n ++ " : " ++ show arg ++ "} -> " ++ show ret
+        = "{auto " ++ showCount rig ++ showPrec d n ++ " : " ++ showPrec d arg ++ "} -> " ++ showPrec d ret
-    show (PLam _ rig _ n (PImplicit _) sc)
+    showPrec d (PLam _ rig _ n (PImplicit _) sc)
-        = "\\" ++ showCount rig ++ show n ++ " => " ++ show sc
+        = "\\" ++ showCount rig ++ showPrec d n ++ " => " ++ showPrec d sc
-    show (PLam _ rig _ n ty sc)
+    showPrec d (PLam _ rig _ n ty sc)
-        = "\\" ++ showCount rig ++ show n ++ " : " ++ show ty ++ " => " ++ show sc
+        = "\\" ++ showCount rig ++ showPrec d n ++ " : " ++ showPrec d ty ++ " => " ++ showPrec d sc
-    show (PLet _ rig n (PImplicit _) val sc alts)
+    showPrec d (PLet _ rig n (PImplicit _) val sc alts)
-        = "let " ++ showCount rig ++ show n ++ " = " ++ show val ++ " in " ++ show sc
+        = "let " ++ showCount rig ++ showPrec d n ++ " = " ++ showPrec d val ++ " in " ++ showPrec d sc
-    show (PLet _ rig n ty val sc alts)
+    showPrec d (PLet _ rig n ty val sc alts)
-        = "let " ++ showCount rig ++ show n ++ " : " ++ show ty ++ " = " 
+        = "let " ++ showCount rig ++ showPrec d n ++ " : " ++ showPrec d ty ++ " = "
-                 ++ show val ++ concatMap showAlt alts ++
+                 ++ showPrec d val ++ concatMap showAlt alts ++
-                 " in " ++ show sc
+                 " in " ++ showPrec d sc
       where
         showAlt : PClause -> String
         showAlt (MkPatClause _ lhs rhs _) = " | " ++ show lhs ++ " => " ++ show rhs ++ ";"
         showAlt (MkWithClause _ lhs rhs _) = " | <<with alts not possible>>"
         showAlt (MkImpossible _ lhs) = " | " ++ show lhs ++ " impossible;"
-    show (PCase _ tm cs) 
+    showPrec _ (PCase _ tm cs)
-        = "case " ++ show tm ++ " of { " ++ 
+        = "case " ++ show tm ++ " of { " ++
             showSep " ; " (map showCase cs) ++ " }"
       where
         showCase : PClause -> String
         showCase (MkPatClause _ lhs rhs _) = show lhs ++ " => " ++ show rhs
         showCase (MkWithClause _ lhs rhs _) = " | <<with alts not possible>>"
         showCase (MkImpossible _ lhs) = show lhs ++ " impossible"
-    show (PLocal _ ds sc) -- We'll never see this when displaying a normal form...
+    showPrec d (PLocal _ ds sc) -- We'll never see this when displaying a normal form...
-        = "let { << definitions >>  } in " ++ show sc
+        = "let { << definitions >>  } in " ++ showPrec d sc
-    show (PUpdate _ fs)
+    showPrec d (PUpdate _ fs)
         = "record { " ++ showSep ", " (map showUpdate fs) ++ " }"
-    show (PApp _ f a) = show f ++ " " ++ show a
+    showPrec d (PApp _ f a) = showPrec App f ++ " " ++ showPrec App a
-    show (PWithApp _ f a) = show f ++ " | " ++ show a
+    showPrec d (PWithApp _ f a) = showPrec d f ++ " | " ++ showPrec d a
-    show (PImplicitApp _ f Nothing a) 
+    showPrec d (PImplicitApp _ f Nothing a)
-        = show f ++ " @{" ++ show a ++ "}"
+        = showPrec d f ++ " @{" ++ showPrec d a ++ "}"
-    show (PDelayed _ LInf ty)
+    showPrec d (PDelayed _ LInf ty)
-        = "Inf " ++ show ty
+        = showCon d "Inf" $ showArg ty
-    show (PDelayed _ _ ty)
+    showPrec d (PDelayed _ _ ty)
-        = "Lazy " ++ show ty
+        = showCon d "Lazy" $ showArg ty
-    show (PDelay _ tm)
+    showPrec d (PDelay _ tm)
-        = "Delay " ++ show tm
+        = showCon d "Delay" $ showArg tm
-    show (PForce _ tm)
+    showPrec d (PForce _ tm)
-        = "Force " ++ show tm
+        = showCon d "Force" $ showArg tm
-    show (PImplicitApp _ f (Just n) (PRef _ a)) 
+    showPrec d (PImplicitApp _ f (Just n) (PRef _ a))
         = if n == a
-             then show f ++ " {" ++ show n ++ "}"
+             then showPrec d f ++ " {" ++ showPrec d n ++ "}"
-             else show f ++ " {" ++ show n ++ " = " ++ show a ++ "}"
+             else showPrec d f ++ " {" ++ showPrec d n ++ " = " ++ showPrec d a ++ "}"
-    show (PImplicitApp _ f (Just n) a) 
+    showPrec d (PImplicitApp _ f (Just n) a)
-        = show f ++ " {" ++ show n ++ " = " ++ show a ++ "}"
+        = showPrec d f ++ " {" ++ showPrec d n ++ " = " ++ showPrec d a ++ "}"
-    show (PSearch _ d) = "%search"
+    showPrec _ (PSearch _ _) = "%search"
-    show (PQuote _ tm) = "`(" ++ show tm ++ ")"
+    showPrec d (PQuote _ tm) = "`(" ++ showPrec d tm ++ ")"
-    show (PUnquote _ tm) = "~(" ++ show tm ++ ")"
+    showPrec d (PUnquote _ tm) = "~(" ++ showPrec d tm ++ ")"
-    show (PPrimVal _ c) = show c
+    showPrec d (PPrimVal _ c) = showPrec d c
-    show (PHole _ _ n) = "?" ++ n
+    showPrec _ (PHole _ _ n) = "?" ++ n
-    show (PType _) = "Type"
+    showPrec _ (PType _) = "Type"
-    show (PAs _ n p) = show n ++ "@" ++ show p
+    showPrec d (PAs _ n p) = showPrec d n ++ "@" ++ showPrec d p
-    show (PDotted _ p) = "." ++ show p
+    showPrec d (PDotted _ p) = "." ++ showPrec d p
-    show (PImplicit _) = "_"
+    showPrec _ (PImplicit _) = "_"
-    show (PInfer _) = "?"
+    showPrec _ (PInfer _) = "?"
-    show (POp _ op x y) = show x ++ " " ++ show op ++ " " ++ show y
+    showPrec d (POp _ op x y) = showPrec d x ++ " " ++ showPrec d op ++ " " ++ showPrec d y
-    show (PPrefixOp _ op x) = show op ++ show x
+    showPrec d (PPrefixOp _ op x) = showPrec d op ++ showPrec d x
-    show (PSectionL _ op x) = "(" ++ show op ++ " " ++ show x ++ ")"
+    showPrec d (PSectionL _ op x) = "(" ++ showPrec d op ++ " " ++ showPrec d x ++ ")"
-    show (PSectionR _ x op) = "(" ++ show x ++ " " ++ show op ++ ")"
+    showPrec d (PSectionR _ x op) = "(" ++ showPrec d x ++ " " ++ showPrec d op ++ ")"
-    show (PEq fc l r) = show l ++ " = " ++ show r
+    showPrec d (PEq fc l r) = showPrec d l ++ " = " ++ showPrec d r
-    show (PBracketed _ tm) = "(" ++ show tm ++ ")"
+    showPrec d (PBracketed _ tm) = "(" ++ showPrec d tm ++ ")"
-    show (PDoBlock _ ds) 
+    showPrec d (PDoBlock _ ds)
         = "do " ++ showSep " ; " (map showDo ds)
-    show (PList _ xs)
+    showPrec d (PList _ xs)
-        = "[" ++ showSep ", " (map show xs) ++ "]"
+        = "[" ++ showSep ", " (map (showPrec d) xs) ++ "]"
-    show (PPair _ l r) = "(" ++ show l ++ ", " ++ show r ++ ")"
+    showPrec d (PPair _ l r) = "(" ++ showPrec d l ++ ", " ++ showPrec d r ++ ")"
-    show (PDPair _ l (PImplicit _) r) = "(" ++ show l ++ " ** " ++ show r ++ ")"
+    showPrec d (PDPair _ l (PImplicit _) r) = "(" ++ showPrec d l ++ " ** " ++ showPrec d r ++ ")"
-    show (PDPair _ l ty r) = "(" ++ show l ++ " : " ++ show ty ++ 
+    showPrec d (PDPair _ l ty r) = "(" ++ showPrec d l ++ " : " ++ showPrec d ty ++
-                                 " ** " ++ show r ++ ")"
+                                 " ** " ++ showPrec d r ++ ")"
-    show (PUnit _) = "()"
+    showPrec _ (PUnit _) = "()"
-    show (PIfThenElse _ x t e) = "if " ++ show x ++ " then " ++ show t ++
+    showPrec d (PIfThenElse _ x t e) = "if " ++ showPrec d x ++ " then " ++ showPrec d t ++
-                                 " else " ++ show e
+                                 " else " ++ showPrec d e
-    show (PComprehension _ ret es)
+    showPrec d (PComprehension _ ret es)
-        = "[" ++ show (dePure ret) ++ " | " ++
+        = "[" ++ showPrec d (dePure ret) ++ " | " ++
                  showSep ", " (map (showDo . deGuard) es) ++ "]"
       where
         dePure : PTerm -> PTerm
@@ -430,16 +430,16 @@ mutual
         deGuard tm@(DoExp fc (PApp _ (PRef _ n) arg))
             = if dropNS n == UN "guard" then DoExp fc arg else tm
         deGuard tm = tm
-    show (PRewrite _ rule tm)
+    showPrec d (PRewrite _ rule tm)
-        = "rewrite " ++ show rule ++ " in " ++ show tm
+        = "rewrite " ++ showPrec d rule ++ " in " ++ showPrec d tm
-    show (PRange _ start Nothing end)
+    showPrec d (PRange _ start Nothing end)
-        = "[" ++ show start ++ " .. " ++ show end ++ "]"
+        = "[" ++ showPrec d start ++ " .. " ++ showPrec d end ++ "]"
-    show (PRange _ start (Just next) end)
+    showPrec d (PRange _ start (Just next) end)
-        = "[" ++ show start ++ ", " ++ show next ++ " .. " ++ show end ++ "]"
+        = "[" ++ showPrec d start ++ ", " ++ showPrec d next ++ " .. " ++ showPrec d end ++ "]"
-    show (PRangeStream _ start Nothing)
+    showPrec d (PRangeStream _ start Nothing)
-        = "[" ++ show start ++ " .. ]"
+        = "[" ++ showPrec d start ++ " .. ]"
-    show (PRangeStream _ start (Just next))
+    showPrec d (PRangeStream _ start (Just next))
-        = "[" ++ show start ++ ", " ++ show next ++ " .. ]"
+        = "[" ++ showPrec d start ++ ", " ++ showPrec d next ++ " .. ]"
 
 public export
 record IFaceInfo where
@@ -447,7 +447,7 @@ record IFaceInfo where
   iconstructor : Name
   params : List Name
   parents : List RawImp
-  methods : List (Name, RigCount, Bool, RawImp) 
+  methods : List (Name, RigCount, Bool, RawImp)
      -- ^ name, whether a data method, and desugared type (without constraint)
   defaults : List (Name, List ImpClause)
 
@@ -489,7 +489,7 @@ TTC Fixity where
   toBuf b Infix = tag 2
   toBuf b Prefix = tag 3
 
-  fromBuf b 
+  fromBuf b
       = case !getTag of
              0 => pure InfixL
              1 => pure InfixR
@@ -499,20 +499,20 @@ TTC Fixity where
 
 export
 TTC SyntaxInfo where
-  toBuf b syn 
+  toBuf b syn
       = do toBuf b (toList (infixes syn))
            toBuf b (toList (prefixes syn))
            toBuf b (toList (ifaces syn))
            toBuf b (bracketholes syn)
            toBuf b (startExpr syn)
 
-  fromBuf b 
+  fromBuf b
       = do inf <- fromBuf b
            pre <- fromBuf b
            ifs <- fromBuf b
            bhs <- fromBuf b
            start <- fromBuf b
-           pure (MkSyntax (fromList inf) (fromList pre) (fromList ifs) 
+           pure (MkSyntax (fromList inf) (fromList pre) (fromList ifs)
                           bhs start)
 
 HasNames IFaceInfo where
@@ -530,7 +530,7 @@ HasNames a => HasNames (ANameMap a) where
       insertAll : ANameMap a -> List (Name, a) -> Core (ANameMap a)
       insertAll ms [] = pure ms
       insertAll ms ((k, v) :: ns)
-          = insertAll (addName !(full gam k) !(full gam v) ms) ns 
+          = insertAll (addName !(full gam k) !(full gam v) ms) ns
 
   resolved gam nmap
       = insertAll empty (toList nmap)
@@ -538,7 +538,7 @@ HasNames a => HasNames (ANameMap a) where
       insertAll : ANameMap a -> List (Name, a) -> Core (ANameMap a)
       insertAll ms [] = pure ms
       insertAll ms ((k, v) :: ns)
-          = insertAll (addName !(resolved gam k) !(resolved gam v) ms) ns 
+          = insertAll (addName !(resolved gam k) !(resolved gam v) ms) ns
 
 export
 HasNames SyntaxInfo where
@@ -554,7 +554,7 @@ HasNames SyntaxInfo where
 export
 initSyntax : SyntaxInfo
 initSyntax
-    = MkSyntax (insert "=" (Infix, 0) empty) 
+    = MkSyntax (insert "=" (Infix, 0) empty)
                (insert "-" 10 empty)
                empty
                []