Commit b5aac097 authored by bbr's avatar bbr
Browse files

module generic now functional again

- added state arguments for propagate and foldcurry in compiler
- added Generic to all libraries for make
- fixed instances for prelude and unsafe
- changed external definitions of gneric
parent fd389252
......@@ -473,16 +473,18 @@ curryInstance opts (Type origName vis vars consdecls)
propRule (Cons cname arity _ _) =
C.Rule [C.PVar "f",C.PComb (consName opts cname) (map toPVar [1..arity])]
C.Rule (addStatePat [C.PVar "f",C.PComb (consName opts cname) (map toPVar [1..arity])])
(noguard $ fapp (sym (consName opts cname))
(map (app (C.Var "f") . toVar) [1 .. arity])) []
(map (fapp (C.Var "f") . addStateArg . (:[]) . toVar) [1 .. arity])) []
foldCurry = C.Func (newModName,"foldCurry") (transvis vis) untyped
(Just (map foldRule consdecls))
foldRule (Cons cname arity _ _) =
C.Rule [C.PVar "f",C.PVar "c",C.PComb (consName opts cname) (map toPVar [1..arity])]
(noguard $ foldr (app2 (C.Var "f")) (C.Var "c") (map toVar [1 .. arity])) []
C.Rule (addStatePat [C.PVar "f",C.PVar "c",C.PComb (consName opts cname) (map toPVar [1..arity])])
(noguard $ foldr appFold (C.Var "c") (map toVar [1 .. arity])) []
where
appFold v e = fapp (C.Var "f") (addStateArg [v,e])
typeName = C.Func (newModName,"typeName") (transvis vis) untyped
(Just [C.Rule [_x]
......
......@@ -17,7 +17,7 @@ module All_Libraries (
--module GUI,
module Integer,
module IO,
module IOChoice,
--module IOChoice,
module IOExts,
--module KeyDB,
module List,
......@@ -70,7 +70,7 @@ module All_Libraries (
module FlatCurryTools,
--module FlatCurryXML,
module FlexRigid,
--module Generic,
module Generic,
module Meta) where
......@@ -91,7 +91,7 @@ import Float
--import GUI
import Integer
import IO
import IOChoice
--import IOChoice
import IOExts
--import KeyDB
import List(find)
......@@ -145,6 +145,6 @@ import FlatCurryShow hiding (showCurryId)
import FlatCurryTools(showCurryId)
--import FlatCurryXML
import FlexRigid
--import Generic
import Generic
import Meta hiding (isFree)
......@@ -55,9 +55,9 @@ instance Curry C_OrRef where
typeName _ = "OrRef"
propagate _ o = o
propagate _ o _ = o
foldCurry _ c _ = c
foldCurry _ c _ _ = c
......
......@@ -3,11 +3,11 @@ module ExternalFunctionsGeneric (module ExternalFunctionsGeneric) where
import Curry
import CurryPrelude
fold :: (Curry t0,Curry t1) => (Prim (t0 -> Prim (t0 -> t0))) -> t0 -> t1 -> t0
fold f = fold' (apply . apply f)
fold :: (Curry t0,Curry t1) => (Prim (t0 -> Result (Prim (t0 -> Result t0)))) -> t0 -> t1 -> Result t0
fold f = fold' (\ x y st' -> apply (apply f x st') y st')
fold' :: (Curry a,Curry b) => (a -> a -> a) -> a -> b -> a
fold' f g = ghnf0 (foldCurry (\ x y -> f (fold' f g x) y) g)
fold' :: (Curry a,Curry b) => (a -> a -> Result a) -> a -> b -> Result a
fold' f g = ghnfCTC (foldCurry (\ x y st' -> f (fold' f g x st') y st') g)
......
......@@ -24,8 +24,8 @@ class (BaseCurry a,Show a,Read a) => Curry a where
eq :: a -> a -> Result C_Bool
-- some generics
propagate :: (forall b. Curry b => b -> b) -> a -> a
foldCurry :: (forall c. Curry c => c -> b -> b) -> b -> a -> b
propagate :: (forall b. Curry b => b -> Result b) -> a -> Result a
foldCurry :: (forall c. Curry c => c -> b -> Result b) -> b -> a -> Result b
-- name of the type
typeName :: a -> String
......@@ -677,15 +677,15 @@ instance Curry C_Four where
eq C_F3 C_F3 _ = C_True
eq _ _ _ = C_False
propagate _ C_F0 = C_F0
propagate _ C_F1 = C_F1
propagate _ C_F2 = C_F2
propagate _ C_F3 = C_F3
propagate _ C_F0 _ = C_F0
propagate _ C_F1 _ = C_F1
propagate _ C_F2 _ = C_F2
propagate _ C_F3 _ = C_F3
foldCurry _ c C_F0 = c
foldCurry _ c C_F1 = c
foldCurry _ c C_F2 = c
foldCurry _ c C_F3 = c
foldCurry _ c C_F0 _ = c
foldCurry _ c C_F1 _ = c
foldCurry _ c C_F2 _ = c
foldCurry _ c C_F3 _ = c
typeName _ = "Four"
......@@ -739,11 +739,11 @@ instance Curry C_Char where
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
propagate f (SearchChar f0 f1 f2 f3) = SearchChar (f f0) (f f1) (f f2) (f f3)
propagate _ c@(C_Char _) _ = c
propagate f (SearchChar f0 f1 f2 f3) st = SearchChar (f f0 st) (f f1 st) (f f2 st) (f f3 st)
foldCurry _ c (C_Char _) = c
foldCurry f c (SearchChar f0 f1 f2 f3) = f f0 (f f1 (f f2 (f f3 c)))
foldCurry _ c (C_Char _) _ = c
foldCurry f c (SearchChar f0 f1 f2 f3) st = f f0 (f f1 (f f2 (f f3 c st)st)st)st
--toC_Term _ _ (C_Char c) = C_Data (C_Int (toInteger (ord c))) (toCurry (show c)) List
......@@ -762,9 +762,9 @@ instance (Generate a,Show a,Read a,Eq a) => Curry (Prim a) where
eq (PrimValue v1) (PrimValue v2) _ = toCurry (v1==v2)
propagate _ (PrimValue v1) = PrimValue v1
propagate _ (PrimValue v1) _ = PrimValue v1
foldCurry _ c (PrimValue _) = c
foldCurry _ c (PrimValue _) _ = c
--toC_Term _ _ (PrimValue x1) = let sx = show x1 in
-- C_Data (C_Int (string2int sx)) (toCurry sx) List
......
{-
import FiniteMap
{-
-- impure, but principally the same as "free"
newFreeRep :: () -> FreeRep
newFreeRep 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