Commit f3d2b536 authored by bbr's avatar bbr
Browse files

external instances compiles now

- the autogenerated files were removed from repository (test if this still compiles upon check out!)
- the external interfaces of prelude have been modified (phew) such that they compile now
parent 88bee93a
module AutoGenerated1 (module AutoGenerated1) where
import Curry
data Prim t0 = PrimValue t0
| PrimFreeVar (FreeVarRef (Prim t0))
| PrimFail C_Exceptions
| PrimOr OrRef (Branches (Prim t0))
| PrimSusp SuspRef (SuspCont (Prim t0))
data C_Four = C_F0
| C_F1
| C_F2
| C_F3
| C_FourFreeVar (FreeVarRef C_Four)
| C_FourFail C_Exceptions
| C_FourOr OrRef (Branches C_Four)
| C_FourSusp SuspRef (SuspCont C_Four)
deriving (Eq)
module AutoGenerated2 (module AutoGenerated2) where
import Curry
import DataPrelude
instance BaseCurry C_Success where
nf f state x = f(state)(x)
gnf f state x = f(state)(x)
free _ = orsCTC([C_Success])
pattern _ = orsCTC([C_Success])
failed = C_SuccessFail
freeVar = C_SuccessFreeVar
branching = C_SuccessOr
suspend = C_SuccessSusp
consKind (C_SuccessFreeVar _) = Free
consKind (C_SuccessOr _ _) = Branching
consKind (C_SuccessFail _) = Failed
consKind (C_SuccessSusp _ _) = Suspended
consKind _ = Val
exceptions (C_SuccessFail x) = x
freeVarRef (C_SuccessFreeVar x) = x
orRef (C_SuccessOr x _) = x
branches (C_SuccessOr _ x) = x
suspRef (C_SuccessSusp x _) = x
suspCont (C_SuccessSusp _ x) = x
instance BaseCurry C_Bool where
nf f state x = f(state)(x)
gnf f state x = f(state)(x)
free _ = orsCTC([C_True,C_False])
pattern _ = orsCTC([C_True,C_False])
failed = C_BoolFail
freeVar = C_BoolFreeVar
branching = C_BoolOr
suspend = C_BoolSusp
consKind (C_BoolFreeVar _) = Free
consKind (C_BoolOr _ _) = Branching
consKind (C_BoolFail _) = Failed
consKind (C_BoolSusp _ _) = Suspended
consKind _ = Val
exceptions (C_BoolFail x) = x
freeVarRef (C_BoolFreeVar x) = x
orRef (C_BoolOr x _) = x
branches (C_BoolOr _ x) = x
suspRef (C_BoolSusp x _) = x
suspCont (C_BoolSusp _ x) = x
instance BaseCurry C_Four where
nf f state x = f(state)(x)
gnf f state x = f(state)(x)
free _ = orsCTC([C_F0,C_F1,C_F2,C_F3])
pattern _ = orsCTC([C_F0,C_F1,C_F2,C_F3])
failed = C_FourFail
freeVar = C_FourFreeVar
branching = C_FourOr
suspend = C_FourSusp
consKind (C_FourFreeVar _) = Free
consKind (C_FourOr _ _) = Branching
consKind (C_FourFail _) = Failed
consKind (C_FourSusp _ _) = Suspended
consKind _ = Val
exceptions (C_FourFail x) = x
freeVarRef (C_FourFreeVar x) = x
orRef (C_FourOr x _) = x
branches (C_FourOr _ x) = x
suspRef (C_FourSusp x _) = x
suspCont (C_FourSusp _ x) = x
op_38_38 :: State -> C_Bool -> C_Bool -> C_Bool
op_38_38 st x1@C_True x2 = x2
op_38_38 st x1@C_False x2 = C_False
op_38_38 st x@(C_BoolFreeVar ref) x2 = narrowCTC(st)(x)(\ st x -> op_38_38(st)(x)(x2))
op_38_38 st (C_BoolOr i xs) x2 = mapOr(st)(\ st x -> op_38_38(st)(x)(x2))(i)(xs)
op_38_38 st (C_BoolSusp ref susp) x2 = treatSusp(st)(\ st x -> op_38_38(st)(x)(x2))(ref)(susp)
op_38_38 st x x2 = patternFail("Generate.&&")(x)
......@@ -25,6 +25,7 @@ gnfCTC cont = ctcStore True (gnf cont)
ghnfCTC :: (BaseCurry a,BaseCurry b) => (b -> Result a) -> b -> Result a
ghnfCTC = ctcStore True
{-
nf0 :: (BaseCurry a, BaseCurry b) => (a -> b) -> a -> b
nf0 cont x = nfCTC (\ x st -> cont x) x Nothing
......@@ -36,6 +37,7 @@ gnf0 cont x = gnfCTC (\ x st -> cont x) x Nothing
ghnf0 :: (BaseCurry a, BaseCurry b) => (a->b) -> a -> b
ghnf0 cont x = ctcStore True (\ x st -> cont x) x Nothing
-}
-----------------------------------------------------------------
-- treatment for the basic cases of flexible pattern matching
......
......@@ -20,8 +20,8 @@ type StrEqResult = C_Bool
class (BaseCurry a,Show a,Read a) => Curry a where
-- basic equalities
strEq :: State -> a -> a -> StrEqResult
eq :: State -> a -> a -> C_Bool
strEq :: a -> a -> Result StrEqResult
eq :: a -> a -> Result C_Bool
-- some generics
propagate :: (forall b. Curry b => b -> b) -> a -> a
......@@ -240,11 +240,11 @@ instance Read DataPrelude.C_Int where
-----------------------------------------------------------------
instance (BaseCurry t0) => BaseCurry (IOVal t0) where
nf f state0 (IOVal x1) = nfCTC(\ state1 v1 -> f(state1)(IOVal(v1)))(state0)(x1)
nf f state x = f(state)(x)
nf f (IOVal x1) state0 = nfCTC(\ v1 state1 -> f(IOVal(v1)) (state1))(x1) (state0)
nf f x state = f(x) (state)
gnf f state0 (IOVal x1) = gnfCTC(\ state1 v1 -> f(state1)(IOVal(v1)))(state0)(x1)
gnf f state x = f(state)(x)
gnf f (IOVal x1) state0 = gnfCTC(\ v1 state1 -> f(IOVal(v1)) (state1))(x1) (state0)
gnf f x state = f(x) (state)
free _ = IOVal (free ())
pattern x = IOVal (freeIORef ())
......@@ -276,8 +276,8 @@ instance (BaseCurry t0) => BaseCurry (IOVal t0) where
suspCont (IOValSusp _ cont) = error "IOValSusp2" -- \store -> unsafePerformIO (cont (Just store))
instance BaseCurry (IO (IOVal t0)) where
nf f state x = f(state)(x)
gnf f state x = f(state)(x)
nf f x state = f(x) (state)
gnf f x state = f(x)(state)
failed x = return (IOValFail x)
......@@ -304,8 +304,8 @@ instance BaseCurry (IO (IOVal t0)) where
instance (BaseCurry t0) => BaseCurry (C_IO t0) where
nf f state x = f(state)(x)
gnf f state x = f(state)(x)
nf f x state = f(x)(state)
gnf f x state = f(x)(state)
free _ = C_IO (\ _ -> free ())
pattern _ = C_IO (\ _ -> freeIORef ())
......@@ -338,11 +338,11 @@ instance (BaseCurry t0) => BaseCurry (C_IO t0) where
instance BaseCurry C_Char where
nf f state0 (SearchChar x1 x2 x3 x4) = Curry.nfCTC(\ state1 v1 -> Curry.nfCTC(\ state2 v2 -> Curry.nfCTC(\ state3 v3 -> Curry.nfCTC(\ state4 v4 -> f(state4)(SearchChar(v1)(v2)(v3)(v4)))(state3)(x4))(state2)(x3))(state1)(x2))(state0)(x1)
nf f store x = f(store)(x)
nf f (SearchChar x1 x2 x3 x4) state0 = Curry.nfCTC(\ v1 state1 -> Curry.nfCTC(\ v2 state2 -> Curry.nfCTC(\ v3 state3 -> Curry.nfCTC(\ v4 state4 -> f(SearchChar(v1)(v2)(v3)(v4))(state4))(x4)(state3))(x3)(state2))(x2)(state1))(x1)(state0)
nf f x store = f(x)(store)
gnf f state0 (SearchChar x1 x2 x3 x4) = Curry.gnfCTC(\ state1 v1 -> Curry.gnfCTC(\ state2 v2 -> Curry.gnfCTC(\ state3 v3 -> Curry.gnfCTC(\ state4 v4 -> f(state4)(SearchChar(v1)(v2)(v3)(v4)))(state3)(x4))(state2)(x3))(state1)(x2))(state0)(x1)
gnf f store x = f(store)(x)
gnf f (SearchChar x1 x2 x3 x4) state0 = Curry.gnfCTC(\ v1 state1 -> Curry.gnfCTC(\ v2 state2 -> Curry.gnfCTC(\ v3 state3 -> Curry.gnfCTC(\ v4 state4 -> f(SearchChar(v1)(v2)(v3)(v4))(state4))(x4)(state3))(x3)(state2))(x2)(state1))(x1)(state0)
gnf f x store = f(x)(store)
consKind (C_CharFreeVar _) = Free
......@@ -371,9 +371,9 @@ instance BaseCurry C_Char where
suspend = C_CharSusp
instance Generate a => BaseCurry (Prim a) where
nf f store x = f(store)(x)
nf f x store = f(x)(store)
gnf f store x = f(store)(x)
gnf f x store = f(x)(store)
free _ = orsCTC (map PrimValue (genFree ()))
pattern _ = orsCTC (map PrimValue (genPattern ()))
......@@ -502,29 +502,29 @@ narrowSuccess v@(FreeVarRef _ ref) res = case unsafePerformIO (readIORef ref) of
-- no other implementation
-- basic concept: if one value suspends evaluate the other
-- TODO: include state information!
concAnd :: State -> StrEqResult -> StrEqResult -> StrEqResult
concAnd _ C_True y = y
concAnd st x@(C_BoolOr _ _) y = maySwitch st y x
concAnd :: StrEqResult -> StrEqResult -> Result StrEqResult
concAnd C_True y _ = y
concAnd x@(C_BoolOr _ _) y st = maySwitch y x st
--concAnd (C_BoolOr r xs) y = C_BoolOr r (map (flip concAnd y) xs)
concAnd _ x@(C_BoolFail _) _ = x
concAnd _ x@C_False _ = x
concAnd st (C_BoolFreeVar v) x = narrowSuccess v x
concAnd st s@(C_BoolSusp _ wake) x =
concAnd x@(C_BoolFail _) _ _ = x
concAnd x@C_False _ _ = x
concAnd (C_BoolFreeVar v) x st = narrowSuccess v x
concAnd s@(C_BoolSusp _ wake) x st =
case unsafePerformIO (readIORef wake) () of
Nothing -> susp x s
Just v -> concAnd st v x
maySwitch :: State -> StrEqResult -> StrEqResult -> StrEqResult
maySwitch _ C_True x = x
maySwitch st y@(C_BoolOr _ _) (C_BoolOr r xs) =
C_BoolOr r (map (flip (concAnd st) y) xs)
maySwitch _ x@(C_BoolFail _) _ = x
maySwitch _ x@C_False _ = x
maySwitch st (C_BoolFreeVar v) x = narrowSuccess v x
maySwitch st s@(C_BoolSusp _ wake) x =
Just v -> concAnd v x st
maySwitch :: StrEqResult -> StrEqResult -> Result StrEqResult
maySwitch C_True x _ = x
maySwitch y@(C_BoolOr _ _) (C_BoolOr r xs) st =
C_BoolOr r (map (\ x -> concAnd x y st) xs)
maySwitch x@(C_BoolFail _) _ _ = x
maySwitch x@C_False _ _ = x
maySwitch (C_BoolFreeVar v) x st = narrowSuccess v x
maySwitch s@(C_BoolSusp _ wake) x st =
case unsafePerformIO (readIORef wake) () of
Nothing -> susp x s
Just v -> maySwitch st v x
Just v -> maySwitch v x st
startBreadth :: State -> [StrEqResult] -> StrEqResult
startBreadth st cs = onLists (maybe emptyStore id st) [] cs
......@@ -574,7 +574,7 @@ susp C_True x = x
susp x@C_False _ = x
susp (C_BoolOr ref xs) x = C_BoolOr ref (map (flip susp x) xs)
susp (C_BoolSusp ref wake) s = -- @(C_SuccessSusp ref' cont')
treatSusp Nothing (const (flip susp s)) ref wake
treatSusp (\ x _ -> susp x s) ref wake Nothing
{-
case wake () of
Just v -> susp v s'
......@@ -585,17 +585,17 @@ susp (C_BoolFreeVar v) x = narrowSuccess v x
--- implementation of (==)
--- no other implementation
genEq :: Curry t0 => State -> t0 -> t0 -> C_Bool
genEq st x y = ghnf0 (\x'-> ghnf0 (eq st x') y) x
genEq :: Curry t0 => t0 -> t0 -> Result C_Bool
genEq x y = ghnfCTC (\x'-> ghnfCTC (eq x') y) x
--- implementation of (=:=)
--- no other implementation
--- TODO: use state information
genStrEq :: Curry t0 => State -> t0 -> t0 -> StrEqResult
genStrEq st a b = (\ a' -> (onceMore a') `hnf0` b) `hnf0` a
genStrEq :: Curry t0 => t0 -> t0 -> Result StrEqResult
genStrEq a b = (\ a' -> (onceMore a') `hnfCTC` b) `hnfCTC` a
where
onceMore a' b' = (\ a'' -> (unify a'') b') `hnf0` a'
unify x y = checkFree (consKind x) (consKind y)
onceMore a' b' = (\ a'' -> (unify a'') b') `hnfCTC` a'
unify x y st = checkFree (consKind x) (consKind y)
where
checkFree Free Free
| freeVarRef x Prelude.== freeVarRef y
......@@ -603,10 +603,10 @@ genStrEq st a b = (\ a' -> (onceMore a') `hnf0` b) `hnf0` a
| otherwise = bind (freeVarRef x) y C_True --C_Success
-- maybe create new var to be symmetric?
checkFree Free _ = let p=pattern () in
bind (freeVarRef x) p (hnf0 (\ x' -> unify x' y) p)
bind (freeVarRef x) p (hnfCTC (\ x' -> unify x' y) p st)
checkFree _ Free = let p=pattern () in
bind (freeVarRef y) p (hnf0 (unify x) p)
checkFree Val Val = strEq st x y
bind (freeVarRef y) p (hnfCTC (unify x) p st)
checkFree Val Val = strEq x y st
strEqFail :: String -> StrEqResult
strEqFail s = C_False --C_SuccessFail (ErrorCall ("(=:=) for type "++s))
......@@ -665,17 +665,17 @@ instance (Curry a) => Curry (IOVal a) where
-}
instance Curry C_Four where
strEq _ C_F0 C_F0 = strEqSuccess
strEq _ C_F1 C_F1 = strEqSuccess
strEq _ C_F2 C_F2 = strEqSuccess
strEq _ C_F3 C_F3 = strEqSuccess
strEq _ x0 _ = strEqFail(typeName(x0))
eq _ C_F0 C_F0 = C_True
eq _ C_F1 C_F1 = C_True
eq _ C_F2 C_F2 = C_True
eq _ C_F3 C_F3 = C_True
eq _ _ _ = C_False
strEq C_F0 C_F0 _ = strEqSuccess
strEq C_F1 C_F1 _ = strEqSuccess
strEq C_F2 C_F2 _ = strEqSuccess
strEq C_F3 C_F3 _ = strEqSuccess
strEq x0 _ _ = strEqFail(typeName(x0))
eq C_F0 C_F0 _ = C_True
eq C_F1 C_F1 _ = C_True
eq C_F2 C_F2 _ = C_True
eq C_F3 C_F3 _ = C_True
eq _ _ _ = C_False
propagate _ C_F0 = C_F0
propagate _ C_F1 = C_F1
......@@ -725,18 +725,18 @@ instance BaseCurry a => Curry (C_IO a) where
--fromC_Term _ = error "no converting IO"
instance Curry C_Char where
strEq _ x@(C_Char c1) (C_Char c2)
strEq x@(C_Char c1) (C_Char c2) _
| c1 Prelude.== c2 = C_True
strEq st c1@(SearchChar _ _ _ _) (C_Char c2) = strEq st c1 (charToSc c2)
strEq st (C_Char c1) c2@(SearchChar _ _ _ _) = strEq st (charToSc c1) c2
strEq st (SearchChar x1 x2 x3 x4) (SearchChar y1 y2 y3 y4) = concAnd st (genEq st (x1)(y1))(concAnd st (genStrEq st (x2)(y2))(concAnd st (genStrEq st (x3)(y3))(genStrEq st (x4)(y4))))
strEq c1@(SearchChar _ _ _ _) (C_Char c2) st = strEq c1 (charToSc c2) st
strEq (C_Char c1) c2@(SearchChar _ _ _ _) st = strEq (charToSc c1) c2 st
strEq (SearchChar x1 x2 x3 x4) (SearchChar y1 y2 y3 y4) st = concAnd (genEq(x1)(y1)st)(concAnd(genStrEq(x2)(y2)st)(concAnd(genStrEq(x3)(y3)st)(genStrEq(x4)(y4)st)st)st)st
strEq _ x _ = strEqFail (typeName x)
eq _ (C_Char x1) (C_Char y1) = toCurry (x1 Prelude.== y1)
eq st c1@(SearchChar _ _ _ _) (C_Char c2) = eq st c1 (charToSc c2)
eq st (C_Char c1) c2@(SearchChar _ _ _ _) = eq st (charToSc c1) c2
eq st (SearchChar x1 x2 x3 x4) (SearchChar y1 y2 y3 y4) = op_38_38 st (genEq st (x1)(y1))(op_38_38 st(genEq st (x2)(y2))(op_38_38 st (genEq st (x3)(y3))(genEq st (x4)(y4))))
eq (C_Char x1) (C_Char y1) _ = toCurry (x1 Prelude.== y1)
eq c1@(SearchChar _ _ _ _) (C_Char c2) st = eq c1 (charToSc c2) st
eq (C_Char c1) c2@(SearchChar _ _ _ _) st = eq (charToSc c1) c2 st
eq (SearchChar x1 x2 x3 x4) (SearchChar y1 y2 y3 y4) st = op_38_38 (genEq (x1)(y1)st) (op_38_38 (genEq(x2)(y2)st) (op_38_38(genEq(x3)(y3)st)(genEq(x4)(y4)st)st)st)st
eq _ _ _ = C_False
propagate _ c@(C_Char _) = c
......@@ -756,11 +756,11 @@ instance Curry C_Char where
typeName _ = "Char"
instance (Generate a,Show a,Read a,Eq a) => Curry (Prim a) where
strEq _ x@(PrimValue v1) (PrimValue v2)
strEq x@(PrimValue v1) (PrimValue v2) _
| v1==v2 = C_True --C_Success
| otherwise = strEqFail (typeName x)
eq _ (PrimValue v1) (PrimValue v2) = toCurry (v1==v2)
eq (PrimValue v1) (PrimValue v2) _ = toCurry (v1==v2)
propagate _ (PrimValue v1) = PrimValue v1
......
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