From d7ba043e7a4af31f884dbac669d75e143437c6ec Mon Sep 17 00:00:00 2001
From: Ingo Wechsung <ingo.wechsung@gmail.com>
Date: Sat, 8 Mar 2014 17:10:23 +0100
Subject: [PATCH] inline native constants

---
 frege/compiler/GenJava7.fr   | 10 +++++++++-
 frege/compiler/tc/Methods.fr | 15 ++++++++++++---
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/frege/compiler/GenJava7.fr b/frege/compiler/GenJava7.fr
index 988eb82f..8153598b 100644
--- a/frege/compiler/GenJava7.fr
+++ b/frege/compiler/GenJava7.fr
@@ -1743,7 +1743,10 @@ methCode g (sym@SymV {nativ = Just item}) si = [
         JComment ((nice sym g) ++ "  " ++ show sym.strsig ++ "  " ++ show sym.rkind),
         JComment (nicer sym.typ g),
         JComment item] ++
-                (if arity > 0 then defs else [member])
+                (if arity > 0 then defs 
+                 else if wrapped g sym || niKind item != NIStatic 
+                    then [member]
+                    else [])
     where
         rjt         = tauJT g rty
         rArgs       = evalArgDef attrFinal si.argSigs argNames
@@ -2421,6 +2424,11 @@ instSym pos sym sigma = do
                  U.logmsg TRACEG pos (text ("instSym: " ++ show bind))                        
                  stio bind
          SymV {name = Local {}, expr = Just _} = U.fatal sym.pos (text ("instSym: " ++ nicer sym g))
+         SymV {depth = 0, nativ = Just item} 
+            | not (wrapped g sym),
+              niKind item == NIStatic = do
+                    let bind = nativeCall g sym []
+                    return model.{jex = bind.jex, jtype = wjt} 
          SymV {name, depth = 0, rkind} -> do
                  let
                      -- mode = jtRmode wjt
diff --git a/frege/compiler/tc/Methods.fr b/frege/compiler/tc/Methods.fr
index 863b4d5c..cf72b3d6 100644
--- a/frege/compiler/tc/Methods.fr
+++ b/frege/compiler/tc/Methods.fr
@@ -236,7 +236,13 @@ sanity SymV{pos, name, typ, nativ = Just item, pur, throwing, over}
             | otherwise = do
                 g <- getST
                 case  isMutable g tau of
-                    Just (p, r) -> goodMutable g phantom p r tau >> return ()
+                    Just (p, r) -> do 
+                                goodMutable g phantom p r tau
+                                case phantom of
+                                    -- warn if we have a mutable result of a non-function
+                                    Nothing | null args = U.warn  pos (msgdoc("note that the java expression  "
+                                                        ++ item ++ "  is supposed to be constant."))
+                                    other = return ()
                     Nothing -> case U.instTauSym tau g of
                         Just SymT{nativ = Just nt, pur = pureType}
                             | !pureType = case phantom of
@@ -390,7 +396,8 @@ sanity SymV{pos, name, typ, nativ = Just item, pur, throwing, over}
                         ++ nicer tau g ++ "  is illegal, "
                         ++ "a pure native type must not be wrapped in Mutable."))
                     return Nothing 
-                else return (Just r)
+                else do 
+                    return (Just r)
             | otherwise = do
                 U.error (getpos r) (msgdoc ("The type  "
                         ++ nicer tau g ++ "  is illegal, "
@@ -440,7 +447,9 @@ isEither t = case Tau.flat t of
     [TCon{name}, a, b] | name == eitherName = Just (a, b)
     _ -> Nothing
 
---- check if _tau_ is (Mutable a b) and return Just (a,b) if this is so.
+--- > isMutable g tau
+--- Checks if _tau_ is @(Mutable a b)@ and return @Just (a,b)@ if this is so.
+--- If _tau_ is a native mutable only type, it returns @Just (RealWorld, tau)@ 
 isMutable g t = case Tau.flat t of
     [TCon{name}, a, b] | name == mutableName = Just (a, b)
     _ -> case U.instTauSym t g of