Commit d47cec9b authored by bbr's avatar bbr
Browse files

Revert "global states now working"

This reverts commit 01bc5929.
I only intended to get the Makefile, not the whole global branch.
parent 01bc5929
......@@ -12,7 +12,7 @@ all: $(SRC)InstallDir.hs $(BIN)generate $(BIN)kicslib $(BIN)kics $(BIN)kicsi lib
.PHONY: tools
tools: $(SRC)InstallDir.hs $(BIN)makeExternalInterface
$(BIN)generate: $(SRC)InstallDir.hs $(SRC)Generate.hs $(SRC)CurryToHaskell.hs $(SRC)PreTrans.hs
$(BIN)generate: $(SRC)InstallDir.hs $(SRC)Generate.hs $(SRC)CurryToHaskell.hs
$(GHC) $(SRC)Generate.hs -o $(BIN)generate
cd $(SRC)
$(BIN)generate $(SRC)
......@@ -29,7 +29,7 @@ $(BIN)kicslib: $(SRC)InstallDir.hs $(SRC)kicslib.hs $(SRC)Config.hs
$(BIN)makeExternalInterface: $(SRC)InstallDir.hs $(BIN)kicslib
$(KGHC) $(SRC)MakeExternalInterface -o $(BIN)makeExternalInterface
$(BIN)kicsi: $(BIN)kicslib $(SRC)CurryToHaskell.hs $(SRC)kicsi.hs $(SRC)PreTrans.hs
$(BIN)kicsi: $(BIN)kicslib $(SRC)CurryToHaskell.hs $(SRC)kicsi.hs
ifeq (,$(filter readline%,$(shell ghc-pkg list readline)))
@echo no readline package found
cp $(SRC)NoReadline.make $(SRC)MyReadline.hs
......@@ -39,7 +39,7 @@ else
endif
$(KGHC) $(SRC)kicsi -o $(BIN)kicsi
$(BIN)kics: $(BIN)kicslib $(SRC)CurryToHaskell.hs $(SRC)PreTrans.hs
$(BIN)kics: $(BIN)kicslib $(SRC)CurryToHaskell.hs
$(KGHC) $(SRC)kics -o $(BIN)kics
.PHONY: runtime
......
......@@ -126,21 +126,18 @@ notUptodate opts@(Opts{filename=foundBasename}) = do
--let interfaceOld = force opts || tInterface > tDestination
return (tSource > tDestination)
applyFlatTransformations :: Options -> Prog -> Safe IO (Prog, [Prog], ([Char], [Char]))
applyFlatTransformations opts prog = do
let auxNames = generateAuxNames (progFuncs prog)
mexprog = if executable opts then addExec auxNames opts prog
else Left prog
exprog <- either return fail mexprog
interfaces <- mapM (safeReadFlat opts . (++".fint")) (progImports exprog)
let glob = splitGlobals exprog
case glob of
Left err -> fail err
Right (globals,locProg) -> do
let liftedProg = noCharCase (liftCases True locProg)
resProg = addGlobalDefs globals liftedProg
--disAmb <- disambiguate interfaces ceprog
return (resProg,interfaces,auxNames)
let (globals,locProg) = splitGlobals exprog
liftedProg = noCharCase (liftCases True locProg)
resProg = addGlobalDefs globals liftedProg
--disAmb <- disambiguate interfaces ceprog
return (resProg,interfaces,auxNames)
generateHaskellFiles opts (prog,interfaces,auxNames) = do
let typeMapping = makeTypeMap (prog:interfaces)
......@@ -626,12 +623,6 @@ baseCurryInstance opts (Type origName vis vars consdecls)
------------------------------------------------------
transFunc :: Options -> (QName -> QName) -> FuncDecl -> C.FuncDecl
transFunc opts typeMapping (Func fname 0 vis t (Rule [] rhs@(Comb FuncCall _ args)))
| isGlobalType t && isGlobalDef rhs
= C.Func (funName fname) (transvis vis) Nothing
(Just [C.Rule [] (C.SimpleExpr (fapp callGlobal targs)) []])
where
targs = map (transExpr opts) args
transFunc opts typeMapping (Func fname arity vis t (Rule lhs rhs))
= C.Func newFName (transvis vis)
(transFType opts arity t) crules
......@@ -1023,8 +1014,6 @@ flatBind x y = Comb FuncCall (flatPre ">>=") [x,y]
flatEq x y = Comb FuncCall (flatPre "===") [x,y]
callGlobal = C.Symbol (modName "Global","global")
flatPre s = ("Prelude",s)
flatGst x = Comb FuncCall (flatPre "getSearchTree") [x]
......
......@@ -237,33 +237,20 @@ typeDecls (Prog _ _ ts _ _) = ts
-- global states
------------------------------------------------------------
isGlobalType :: TypeExpr -> Bool
isGlobalType (TCons ("Global","Global") _) = True
isGlobalType _ = False
isGroundVal :: Expr -> Bool
isGroundVal = trExpr (\_->False) (\_->True) comb (\_ _->False) (\_ _->False)
(\_ _->False) (\_ _ _->False) (\_ _->False)
where
comb ConsCall _ bs = and bs
comb (FuncPartCall _) _ bs = and bs
comb (ConsPartCall _) _ bs = and bs
comb _ _ _ = False
isGlobalDef :: Expr -> Bool
isGlobalDef (Comb FuncCall ("Global","global") [e1,e2]) = isGroundVal e1 && isGroundVal e2
isGlobalDef _ = False
splitGlobals :: Prog -> Either String ([FuncDecl],Prog)
splitGlobals :: Prog -> ([FuncDecl],Prog)
splitGlobals prog
| progName prog == "Global" = Right ([],prog)
| all okDef gs = Right (gs,updProgFuncs (const fs) prog)
| otherwise = Left $ "incorrect global definition(s) "
| progName prog == "Global" = ([],prog)
| all okDef gs = (gs,updProgFuncs (const fs) prog)
| otherwise = error $ "incorrect global definition(s) "
++ show (map funcName (filter (not . okDef) gs))
where
(gs,fs) = partition (isGlobalType . resultType . funcType) (progFuncs prog)
okDef f = isGlobalType (funcType f) && isGlobalDef (funcBody f)
&& isMonomorph (funcType f)
(gs,fs) = partition (isGlobal . resultType . funcType) (progFuncs prog)
isGlobal (TCons ("Global","Global") _) = True
isGlobal _ = False
isGlobalDef (Comb FuncCall ("Global","global") _) = True
isGlobalDef _ = False
okDef f = isGlobal (funcType f) && isGlobalDef (funcBody f)
&& isMonomorph (funcType f)
isMonomorph :: TypeExpr -> Bool
isMonomorph (TVar _) = False
......
......@@ -9,9 +9,9 @@ import Data.IORef
import System.IO.Unsafe
global :: (Curry t0) => t0 -> C_GlobalSpec -> Result (C_Global t0)
global x _ = ref `seq` (\ _ -> PrimValue ref)
where ref = unsafePerformIO (Data.IORef.newIORef x)
global :: (Curry t0) => t0 -> C_GlobalSpec -> Result (C_Global t0)
global x s = ref `seq` (\ _ -> PrimValue ref)
where ref = unsafePerformIO (Data.IORef.newIORef x)
......
......@@ -22,6 +22,7 @@
--- @author Michael Hanus
--- @version June 2007
------------------------------------------------------------------------------
module Global(Global,GlobalSpec(..),global,readGlobal,writeGlobal) where
----------------------------------------------------------------------
......@@ -58,5 +59,5 @@ writeGlobal g v = (prim_writeGlobal $# g) $## v
prim_writeGlobal :: Global a -> a -> IO ()
prim_writeGlobal external
------------------------------------------------------------------------
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment