Restrict parameter type of dataCode, classCode and instanceCode

frege/compiler/gen/java/DataCode.fr

@@ -20,7 +20,7 @@ import Compiler.gen.java.Bindings(assign)
 import Compiler.enums.Flags(TRACEG)
 
 --- Generate code for @data@ definitions
-dataCode :: Symbol → StG [JDecl]
+dataCode :: SymT Global -> StG [JDecl]
 {--
     Enumerations 
     (that is, data types where no constructor has any fields) 
@@ -29,7 +29,7 @@ dataCode :: Symbol → StG [JDecl]
     names of the constructors and the function definitions found in the
     where clause of the @data@.
 -}
-dataCode (SymbolT.T (sym@SymT{enum = true})) = do
+dataCode (sym@SymT{enum = true}) = do
     g ← getST
     E.logmsg TRACEG sym.pos (text ("dataCode for enum " ++ nicer sym g))
 
@@ -54,7 +54,7 @@ dataCode (SymbolT.T (sym@SymT{enum = true})) = do
     We generate an @abstract static class@ as a namespace for the 
     definitions in the where clause, if any. Otherwise, nothing is generated.
 -}
-dataCode (SymbolT.T (sym@SymT{product = true, newt = true})) = do
+dataCode (sym@SymT{product = true, newt = true}) = do
     g ← getST
     E.logmsg TRACEG sym.pos (text ("dataCode for newtype " ++ nicer sym g))
 
@@ -75,7 +75,7 @@ dataCode (SymbolT.T (sym@SymT{product = true, newt = true})) = do
     In this case, also the appropriate Kinded instances will be generated.
 
 -}
-dataCode (SymbolT.T (sym@SymT{ product = true })) = do
+dataCode (sym@SymT{ product = true }) = do
     g ← getST 
     E.logmsg TRACEG sym.pos (text ("dataCode for product " ++ nicer sym g))
 
@@ -128,7 +128,7 @@ dataCode (SymbolT.T (sym@SymT{ product = true })) = do
     >   // sub definitions
     > }
 -}
-dataCode (SymbolT.T (sym@SymT{ nativ = Nothing, product = false, newt = false })) = do
+dataCode (sym@SymT{ nativ = Nothing, product = false, newt = false }) = do
     g   ←   getST
     E.logmsg TRACEG sym.pos (text ("dataCode for native " ++ nicer sym g))
 
@@ -177,7 +177,7 @@ dataCode (SymbolT.T (sym@SymT{ nativ = Nothing, product = false, newt = false })
     Native data types are mapped to a class that acts as namespace
     for the subdefinitions, if any.
 -}
-dataCode (SymbolT.T (sym@SymT{ nativ = Just _ })) = do                               -- nativ
+dataCode (sym@SymT{ nativ = Just _ }) = do                               -- nativ
      g  ←   getST
      E.logmsg TRACEG sym.pos (text ("dataCode for native " ++ nicer sym g))
 

frege/compiler/gen/java/InstanceCode.fr

@@ -76,8 +76,8 @@ import Compiler.gen.java.VarCode(varCode, compiling, genExpression, genExpr)
     the class operations, like (++) and 'length'. 
 -}
 
-classCode :: Symbol -> StG [JDecl]
-classCode (SymbolT.C (sym@SymC{tau = TVar{var,kind}})) = do           -- type class
+classCode :: SymC Global -> StG [JDecl]
+classCode (sym@SymC{tau = TVar{var,kind}}) = do           -- type class
      g <- getST
      let vals = map symMethAsSymV $ values sym.meth
          special = isSpecialClass sym
@@ -204,7 +204,8 @@ abstractFun symc sym = do
     >     public Eq_Maybe(CEq<A> ctx) { ... }
     > }  
 -}
-instanceCode (SymbolT.I sym) = do             -- instance definition
+instanceCode :: SymI Global -> StG [JDecl]
+instanceCode sym = do             -- instance definition
      g <- getST
      csym <- findC sym.clas
 
@@ -342,14 +343,6 @@ instanceCode (SymbolT.I sym) = do             -- instance definition
                              ++ concat instImpls}     
      pure [JComment (nice sym g ++ " :: " ++ nice sym.typ g), result]
 
---- If given something else than a type class this is a fatal compiler error
-instanceCode sym = do
-    g ← getST
-    E.fatal sym.pos (
-            text "instanceCode: argument is "
-            <+> text (nice sym g) 
-        ) 
-
 instFun :: SymC Global -> SymI Global -> QName -> StG JDecl
 instFun symc symi mname = do
         g   <- getST

frege/compiler/passes/GenCode.fr

@@ -153,17 +153,17 @@ pass = do
     g ← getSTT
 
     -- classes 
-    let classes = [ s | s@(SymbolT.C _) <- values g.thisTab ]
+    let classes = [ s | SymbolT.C s <- values g.thisTab ]
     liftStG (concat <$> mapM classCode classes)
         >>= liftIO . ppDecls g
 
     -- instances
-    let instances = [ s | s@(SymbolT.I _) <- values g.thisTab ]
+    let instances = [ s | SymbolT.I s <- values g.thisTab ]
     liftStG (concat <$> mapM instanceCode instances)
         >>= liftIO . ppDecls g
 
     -- data definitions
-    let datas = [ s | s@(SymbolT.T _) <- values g.thisTab ]
+    let datas = [ s | SymbolT.T s <- values g.thisTab ]
     liftStG (concat <$> mapM dataCode datas)
         >>= liftIO . ppDecls g