diff --git a/frege/compiler/gen/java/DataCode.fr b/frege/compiler/gen/java/DataCode.fr index 82dfd7e0..25560d2c 100644 --- a/frege/compiler/gen/java/DataCode.fr +++ b/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)) diff --git a/frege/compiler/gen/java/InstanceCode.fr b/frege/compiler/gen/java/InstanceCode.fr index 04a4e399..bfb48938 100644 --- a/frege/compiler/gen/java/InstanceCode.fr +++ b/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 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 diff --git a/frege/compiler/passes/GenCode.fr b/frege/compiler/passes/GenCode.fr index f434ebb3..60f1643a 100644 --- a/frege/compiler/passes/GenCode.fr +++ b/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