proposed fix for issue#50

examples/HigherOrder.fr

@@ -9,9 +9,9 @@ both :: (forall arg res.arg -> res) -> pb -> cu -> (au, ag)
 both f xs ys = (f xs, f ys)
 
 try1 = both (head [])
-try2 = both (noterm 42 42)
+try2 = both (noterm 42)
 
-noterm a b = noterm b a
+noterm a  = noterm a
 
 
 with :: (Num a, Num b) => (forall e.Num e => [e]->[e]) -> [a] -> [b] -> ([a], [b])
@@ -33,9 +33,16 @@ useh :: (Functor α, Num β) => α β -> α β
 useh = higher (fmap (+1)) 
 
 main args
-    | null args = print "no args: " >> println (wrong)
+    | null args = print "no args: " 
+                    >> println (issue50  [7,6 .. 1]) 
+                    >> println (issue50a [7,6 .. 2])
     | otherwise = print "some args: " >> println wrong     
 
--- issue50 :: Ord o => [o] -> o
-issue50 xs = ST.run (return (minimum xs))
-    -- where !go = return minimum xs 
+issue50 :: Ord o => [o] -> o
+issue50 xs = (ST.run go) 
+    where go = return $ minimum xs 
+
+--- without type signature it should compile as well, as it used to be
+issue50a xs = (ST.run go) 
+    where go = return $ minimum xs 
+

frege/compiler/GenJava7.fr

@@ -2479,7 +2479,7 @@ genExpr rflag rjtype expr binds | Just sigma <- expr.typ = do
             U.logmsg TRACEG (getpos expr) (text("genExpr: wrapping " 
                 ++ nice expr g
                 ++ " :: " ++ nice sigma g
-                ++ " :: " ++ nice faketype g))
+                ++ " @@ " ++ nice faketype g))
             U.logmsg TRACEG (getpos expr) (text("genExpr: in environment " 
                 ++ nice faketype.rho.{context = ectxs} g))
             body <- compiling fakesym (genStmts (strict rjtype) expr binds)

frege/compiler/Typecheck.fr

@@ -626,20 +626,16 @@ checkSigma1 annotated x s = do
                 rho  <- simplify pos sigma.rho.{context=ectx}
                 rhometas <- rhoTvs rho.{context=[]}
                 ctxmetas <- mapM ctxTvs rho.context
-                let fctx = [ ctx | (metas, ctx) <- zip ctxmetas rho.context,
-                                  if not annotated && (all MetaTv.isFlexi metas)
-                                    then false      -- will occur in type higher up
-                                    else true,      -- pass flexible meta constraints
-                                  -- don't pass constraints that mention rigid
-                                  -- tyvars that are not in the checked type
-                                  all (`elem` rhometas)  (filter (not . MetaTv.isFlexi) metas)]
-                -- let ectx = rho.context
+
+                let fctx    = map snd . filter relevantCtx $ zip ctxmetas rho.context
+                    onlyrho = filter (`notElem` tvs) rhometas -- only in rho, but not in skolTvs
+                    relevantCtx
+                        | annotated     = any (`elem`   rhometas) . fst
+                        | otherwise     = any (`notElem` onlyrho) . fst
+
                     frho = rho.{context=fctx}
-                x    <- return (x.{typ = Just sigma.{rho=frho}}) 
-
+                x    <- return (x.{typ = Just sigma.{rho=frho}})                  
                 ety <- canonicContext ety
-                -- etvss <- mapSt ctxTvs ectx
-
 
                 U.logmsg TRACET pos (text ("expr context:     "   ++ U.nicectx fctx g))
                 U.logmsg TRACET pos (text ("expected context: "   ++ U.nicectx ety.context g))