shithub: MicroHs

Download patch

ref: 98c21bcaacdea83a273b248d32f0ccd16970eeb1
parent: 8ee8533bdbf2cb19c7a30fe7c42937fdaafccd52
author: Lennart Augustsson <lennart@augustsson.net>
date: Sun Nov 5 11:41:57 EST 2023 

More Show instances


--- a/src/MicroHs/Expr.hs
+++ b/src/MicroHs/Expr.hs
@@ -48,7 +48,7 @@
 ----------------------
 
 data EModule = EModule IdentModule [ExportItem] [EDef]
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data ExportItem
   = ExpModule IdentModule
@@ -55,7 +55,7 @@
   | ExpTypeCon Ident
   | ExpType Ident
   | ExpValue Ident
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data EDef
   = Data LHS [Constr]
@@ -68,16 +68,16 @@
   | Infix Fixity [Ident]
   | Class [EConstraint] LHS [FunDep] [EBind]  -- XXX will probable need initial forall with FD
   | Instance [IdKind] [EConstraint] EConstraint [EBind]  -- no deriving yet
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data ImportSpec = ImportSpec Bool Ident (Maybe Ident) (Maybe (Bool, [ImportItem]))  -- first Bool indicates 'qualified', second 'hiding'
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data ImportItem
   = ImpTypeCon Ident
   | ImpType Ident
   | ImpValue Ident
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data Expr
   = EVar Ident
@@ -100,7 +100,7 @@
   -- Constructors after type checking
   | ECon Con
   | EForall [IdKind] Expr -- only in types
-  --Xderiving (Show, Eq)
+  --deriving (Show, Eq)
 
 type FunDep = ([Ident], [Ident])
 
@@ -123,7 +123,7 @@
   | LFromTo Expr Expr
   | LFromThen Expr Expr
   | LFromThenTo Expr Expr Expr
-  --Xderiving(Show, Eq)
+  --deriving(Show, Eq)
 
 conIdent :: --XHasCallStack =>
             Con -> Ident
@@ -168,17 +168,17 @@
 type ECaseArm = (EPat, EAlts)
 
 data EStmt = SBind EPat Expr | SThen Expr | SLet [EBind]
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data EBind = BFcn Ident [Eqn] | BPat EPat Expr | BSign Ident EType
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 -- A single equation for a function
 data Eqn = Eqn [EPat] EAlts
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 data EAlts = EAlts [EAlt] [EBind]
-  --Xderiving (Show, Eq)
+  --Xderiving (Show)
 
 type EAlt = ([EStmt], Expr)
 
@@ -202,7 +202,7 @@
 type LHS = (Ident, [IdKind])
 
 data Constr = Constr Ident (Either [EType] [ConstrField])
-  --Xderiving(Show, Eq)
+  --Xderiving(Show)
 
 type ConstrField = (Ident, EType)              -- record label and type
 
@@ -214,8 +214,11 @@
 type EConstraint = EType
 
 data IdKind = IdKind Ident EKind
-  --Xderiving (Show, Eq)
+  --deriving (Show, Eq)
 
+instance Show IdKind where
+  show (IdKind i k) = "(" ++ show i ++ "::" ++ show k ++ ")"
+
 idKindIdent :: IdKind -> Ident
 idKindIdent (IdKind i _) = i
 
@@ -445,6 +448,9 @@
 errorMessage loc msg = error $ showSLoc loc ++ ": " ++ msg
 
 ----------------
+
+instance Show Expr where
+  show = showExpr
 
 showExpr :: Expr -> String
 showExpr = render . ppExpr
--- a/src/MicroHs/Ident.hs
+++ b/src/MicroHs/Ident.hs
@@ -32,7 +32,7 @@
   --Xderiving (Show, Eq)
 
 data Ident = Ident SLoc String
-  --Xderiving (Show)
+  --deriving (Show)
 --Winstance NFData Ident where rnf (Ident _ s) = rnf s
 
 instance Eq Ident where
@@ -44,6 +44,9 @@
   Ident _ i <= Ident _ j  =  i <= j
   Ident _ i >  Ident _ j  =  i >  j
   Ident _ i >= Ident _ j  =  i >= j
+
+instance Show Ident where
+  show = showIdent
 
 noSLoc :: SLoc
 noSLoc = SLoc "" 0 0
-- 
⑨