Skip to content

Commit

Permalink
inline native constants
Browse files Browse the repository at this point in the history
  • Loading branch information
Ingo60 committed Mar 8, 2014
1 parent a574149 commit d7ba043
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 4 deletions.
10 changes: 9 additions & 1 deletion frege/compiler/GenJava7.fr
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
15 changes: 12 additions & 3 deletions frege/compiler/tc/Methods.fr
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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, "
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit d7ba043

Please sign in to comment.