fix #293

fix #348

frege/compiler/gen/java/Common.fr

@@ -329,7 +329,22 @@ asKinded jt n
 
 canBeKinded Kinded{} !k  = false
 canBeKinded Constr{} !k  = false 
-canBeKinded jt       !k  = k > 0 && jt.{gargs?} && length jt.gargs >= k 
+canBeKinded jt       !k  = k > 0 && jt.{gargs?} && length jt.gargs >= k
+
+--- check if a Java type can be used as instance of a higher kinded type class.
+--- For example:
+--- > TTuple<A,?>
+--- is okay, but
+--- > TTuple<?, A> 
+--- is not
+implementsKinded ∷ Int → JType → Bool
+implementsKinded k jt
+    | jt.{gargs?}, not (null jt.gargs), length jt.gargs >= k = all isWild (drop (length jt.gargs - k) jt.gargs)  
+    | otherwise   = false   -- type is not even generic
+    where
+        isWild Wild{bounds = UNBOUNDED} = true
+        isWild _                        = false
+
 
 --- The opposite of 'asKInded', such that for any sufficiently generic 'JType'
 --- > fromKinded (asKinded jt n) == jt
@@ -808,6 +823,13 @@ isArrayClassName _                 = false
 isArrayClass SymC{name} = isArrayClassName name
 isArrayClass _          = false
 
+--- check if a type class is higher kinded
+isHigherKindedClass ∷ Symbols.SymbolT α → Bool
+isHigherKindedClass SymC{tau} = case tau.kind of 
+                                     KApp{} → true
+                                     other  → false
+isHigherKindedClass other     = false
+
 {-- 
     The (abstract) instance functions for some class members need a  
 

frege/compiler/gen/java/InstanceCode.fr

@@ -3,7 +3,7 @@ module frege.compiler.gen.java.InstanceCode where
 
 import frege.Prelude hiding (<+>)
 
-import Lib.PP (text, <+>, </>)
+import Lib.PP (text, <+>, </>, <+/>)
 import Data.TreeMap as Map(values, lookup, delete, insert, TreeMap)
 import Data.List(zip4)
 
@@ -28,7 +28,7 @@ import Compiler.common.Binders(allBinders)
 import Compiler.common.SymbolTable(changeSym)
 import Compiler.common.JavaName(symJavaName, javaName)
 
-import Compiler.classes.Nice (nice, nicer)
+import Compiler.classes.Nice (nice, nicer, nicest)
 
 import Compiler.tc.Util(sameCtx)
 
@@ -243,8 +243,6 @@ instanceCode (sym@SymI {sid}) = do             -- instance definition
 
      let vals = values sym.env
 
-     instFuns  <- mapM (instFun csym sym) methods
-     instImpls <- mapM (varCode empty) vals
      let constraints = zipWith (constraintDef g)  sym.typ.rho.context (getCtxs g)
          constrargs  = zipWith (constraintArg g)  sym.typ.rho.context (getArgs g)
 
@@ -300,7 +298,31 @@ instanceCode (sym@SymI {sid}) = do             -- instance definition
             where
                 gargs = take (length gvars) wilds
 
-         result = JClass {attr, 
+     -- check for implementation restriction
+     let k = kArity csym.tau.kind
+         jt = head etype.gargs
+         implementationRestriction = not special && isHigherKindedClass csym && not (implementsKinded k jt)
+     when (implementationRestriction) do
+        E.error sym.pos (
+            text "implementation restriction: the type" 
+            <+> nicest g sym.typ.rho.{context=[]}
+            <+> text "cannot be an instance of" <+> text (csym.name.nicer g)
+            <+/> text "because attempting to represent"
+            <+/> text "it as a higher kinded type" 
+            <+/> text "results in the invalid java type" <+> text jt.show <+> text ". "
+            <+/> text "To be valid," <+> text (show k) 
+                <+> text "wild card type argument(s)"
+                <+> text "should appear from the right,"
+                <+> text "but this is not the case here. "
+            <+/> text "Maybe this can be corrected by"
+                <+> text "re-arranging type arguments."
+            </> text "Also, if this was a newtype, it'll probably help to change it to data."   
+          )
+     when (isHigherKindedClass csym) do
+        E.logmsg TRACEG sym.pos (text "instanceCode" <+> text (csym.name.nicer g) <+> text jt.show)
+     instFuns  <- mapM (instFun csym sym) (if implementationRestriction then [] else methods)
+     instImpls <- mapM (varCode empty)    (if implementationRestriction then [] else vals)
+     let result = JClass {attr, 
                           name = instName.base,
                           gvars,
                           extend = Nothing,
@@ -309,7 +331,7 @@ instanceCode (sym@SymI {sid}) = do             -- instance definition
                              ++ singleton
                              ++ make
                              ++ instFuns
-                             ++ concat instImpls}
+                             ++ 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