Commit b3d2bd54 authored by Bernd Brassel's avatar Bernd Brassel
Browse files

before getting changes from hsi

parent 2a3a04af
{-# LANGUAGE DeriveDataTypeable #-}
module Store
(Store,
......@@ -16,6 +18,7 @@ module Store
narrowOrRef
) where
import Data.Generics (Data,Typeable)
import Data.IntMap
import Prelude hiding (lookup)
import System.IO.Unsafe
......@@ -28,7 +31,7 @@ trace' x = trace (show x) x
----------------------------
data OrRefKind = Generator Int Int | Narrowed Int Int | NoGenerator
deriving (Eq,Ord,Show,Read)
deriving (Data,Typeable,Eq,Ord,Show,Read)
minMax :: OrRefKind -> (Int->Entry,Maybe (Int,Int))
minMax NoGenerator = (Choice,Nothing)
......@@ -37,7 +40,7 @@ minMax (Narrowed a b) = (Binding a b,Just (a,b))
data OrRef = OrRef OrRefKind Int
| Layer OrRef
| Equality Int Int Int Int Int Int deriving (Eq,Ord,Show,Read)
| Equality Int Int Int Int Int Int deriving (Data,Typeable,Eq,Ord,Show,Read)
uncover :: OrRef -> OrRef
uncover (Layer x) = x
......@@ -211,7 +214,7 @@ storeSize :: Store -> Int
storeSize (Store st) = size st
-- this the way to access store from outside
-- this is the way to access store from outside
manipulateStore :: a -> (b -> Store -> a)
-> (OrRef -> (Int -> Store) -> a)
-> (OrRef -> b -> Store -> a)
......
......@@ -3,7 +3,7 @@ module ExternalFunctionsOptimizeST where
import Data.Tree
import CurryPrelude
import Curry
{-
optChStore err det br ref bs st = case changeStore ref st of
Inconsistent -> err
Found i -> det i (bs!!i) st
......@@ -11,7 +11,7 @@ optChStore err det br ref bs st = case changeStore ref st of
NewInfo ref st -> det 0 (head bs) st
FoundAndNewInfo i ref st -> det i (bs!!i) st
-}
showSearchTree :: Curry a => a -> Result C_String
showSearchTree x st = toCurry (drawTree (mkSearchTree x emptyStore))
......
{-# OPTIONS -cpp #-}
{-# LANGUAGE RankNTypes,
ScopedTypeVariables,
MultiParamTypeClasses,
FlexibleInstances #-}
module ExternalFunctionsPrelude where
......@@ -406,9 +410,6 @@ cond (C_SuccessOr r bs) x st = mapOr (\ c -> cond c x) r bs st
cond x _ _ = patternFail "Prelude.cond" x
commit :: Curry a => a -> Result a
commit _ st = prim_error (toCurry "committed choice not implemented") st
ifVar :: (Curry a,Curry b) => b -> a -> a -> a
ifVar = error "ifVar not implemented"
......
{-# LANGUAGE RankNTypes,
ScopedTypeVariables,
MultiParamTypeClasses,
FlexibleInstances #-}
module ExternalInstancesPrelude (
module AutoGenerated2,
module ExternalInstancesPrelude) where
......
import qualified Char
instance DI.GenTerm Float where
underscore = FloatUnderscore
genTerm FloatUnderscore = DI.TermUnderscore (DI.SrcID "Prelude" 2)
genTerm (Float f) = DI.TermFloat f
instance DI.GenTerm Char where
underscore = CharUnderscore
genTerm CharUnderscore = DI.TermUnderscore (DI.SrcID "Prelude" 0)
genTerm (Char c) = DI.TermChar c
instance DI.GenTerm (IO dm a) where
underscore = IOUnderscore
genTerm IOUnderscore = DI.TermUnderscore (DI.SrcID "Prelude" Prelude.undefined)
genTerm x0 = Prelude.error "not implemented"
......@@ -109,7 +106,7 @@ strict_prim_error x0
(DM.errorHook (Prelude.map charToHChar (listToHList x0)))
strict_failed :: (DM.DM dm, DI.GenTerm a) => dm a
strict_failed = hook_strict_failed (return DM.failed)
strict_failed = hook_strict_failed DM.failedHook
op_EqEq ::
......@@ -145,7 +142,6 @@ op_GtGtEq ::
(DM.DM dm, DI.GenTerm a, DI.GenTerm b) =>
IO dm a -> DM.Func dm a (IO dm b) -> dm (IO dm b)
op_GtGtEq a1@(IO a) k
-- = hook_op_GtGtEq x0 x1 (Prelude.error "not implemented")
= hook_op_GtGtEq a1 k (return (IO (\w -> do
(r, w') <- a w
IO f <- curryApply k r
......@@ -207,11 +203,6 @@ strict_cond ::
strict_cond x0 x1
= hook_strict_cond x0 x1 (Prelude.error "not implemented")
strict_commit ::
(DM.DM dm, DI.GenTerm a) => a -> dm a
strict_commit x0
= hook_strict_commit x0 (Prelude.error "not implemented")
op_EqColonLtEq ::
(DM.DM dm, DI.GenTerm a) =>
a -> a -> dm Success
......
......@@ -977,11 +977,6 @@ apply external
cond :: Success -> a -> a
cond external
-- Only for internal use:
-- Representation of committed choice in FlatCurry.
commit :: a -> a
commit external
unknown :: a
unknown = let x free in x
......
......@@ -6,4 +6,4 @@ main = do
[m] <- getArgs
make True m (\ _ m' -> putStr "ensure existence of acy file for " >> putStrLn m'
>> readCurry m' >> return Nothing)
(\ _ _ _ -> return ())
\ No newline at end of file
(\ _ _ _ -> return ())
\ No newline at end of file
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