ue

diff --git a/codegenbug/Data/GenC.dcl b/codegenbug/Data/GenC.dcl
new file mode 100644 (file)
index 0000000..87791d2
--- /dev/null
+++ b/codegenbug/Data/GenC.dcl
@@ -0,0 +1,19 @@
+definition module Data.GenC
+
+import StdGeneric
+
+derive bimap Structmaker
+
+:: Structmaker a
+runStructMaker :: (Structmaker a) -> String
+generic gToCType a | gPotentialInf a :: Structmaker a
+derive gToCType Int,Real,Bool,Char,{},{#},{!},[],[! ],[ !],[!!]
+derive gToCType UNIT,EITHER,PAIR,OBJECT of gtd,CONS of gcd,RECORD of grd,FIELD of gfd
+derive gToCType (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+
+:: Box b a = Box b | BoxOnzin b a
+derive bimap Box
+generic gPotentialInf a :: [String] -> Box Bool a
+derive gPotentialInf UNIT,EITHER,PAIR,CONS,FIELD,RECORD of {grd_name},OBJECT of {gtd_name}
+derive gPotentialInf Int,Bool,Char,Real,File,World,Dynamic,(->),{},{#},{!},[],[! ],[ !],[!!]
+derive gPotentialInf (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)

diff --git a/codegenbug/Data/GenC.icl b/codegenbug/Data/GenC.icl
new file mode 100644 (file)
index 0000000..378b8f8
--- /dev/null
+++ b/codegenbug/Data/GenC.icl
@@ -0,0 +1,149 @@
+implementation module Data.GenC 
+
+import StdEnv
+import StdGeneric
+import StdDebug
+
+import Data.Map => qualified updateAt
+import Data.Func
+
+import Text
+import Debug.Trace
+
+//derive class gGenerateC (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+
+derive bimap Structmaker, Box
+
+toEnumValue :: GenericConsDescriptor -> String
+toEnumValue gcd = gcd.gcd_type_def.gtd_name +++ "_" +++ gcd.gcd_name
+
+toEnumType :: GenericTypeDefDescriptor -> String
+toEnumType gtd = "enum cleanc_" +++ gtd.gtd_name
+
+class toStructType a :: a -> String
+instance toStructType GenericTypeDefDescriptor where
+       toStructType gtd = "struct clean_" +++ gtd.gtd_name
+instance toStructType GenericRecordDescriptor where
+       toStructType grd = "struct clean_" +++ grd.grd_name
+
+:: CInfo a = {header :: String , toValue :: a -> String}
+
+runStructMaker :: (Structmaker a) -> String
+runStructMaker (SM t)
+# {defs,imps} = snd $ t {dict=newMap,fresh=0,inRecord=False} []
+= end (elems defs) +++ end imps
+where
+       end d = concat [d +++ ";\n"\\d<-d]
+
+generic gToCType a | gPotentialInf a :: Structmaker a
+derive gToCType [], [! ], [ !], [!!]
+derive gToCType (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+:: Structmaker a = SM (SMInput [String] -> ([String], SMOutput)) | Onzinconstructor a
+runSM (SM a) = a
+:: SMInput =
+       { fresh :: Int
+       , inRecord :: Bool
+       , dict :: Map String String
+       }
+:: SMOutput =
+       { defs :: Map String String
+       , imps :: [String]
+       }
+
+instance + SMOutput where + a b = {defs=union a.defs b.defs, imps=a.imps++b.imps}
+instance zero SMOutput where zero = {defs=newMap, imps=[]}
+
+show :: String -> Structmaker a
+show str = SM \st c->([str:c], zero)
+
+gToCType{|Char|} = show "char"
+gToCType{|Int|} = show "uint64_t"
+gToCType{|Real|} = show "double"
+gToCType{|Bool|} = show "bool"
+gToCType{|UNIT|} = SM \st c->(c, zero)
+gToCType{|EITHER|} fl il fr ir = SM \st c
+       # (c, oa) = runSM fl st c
+       # (c, ob) = runSM fr {st & dict=union st.dict oa.defs} c
+       = (c, oa + ob)
+gToCType{|PAIR|} fl il fr ir
+        = SM \st c
+               # (c, oa) = runSM fr st c
+               # st & dict = union st.dict oa.defs
+               # (c, ob) = if st.inRecord
+                       (runSM fl st c)
+                       (runSM fl {st & fresh=st.fresh+1} [" f", toString st.fresh, ";\n":c])
+               = (c, oa + ob)
+gToCType{|OBJECT of gtd|} f i
+       //Newtype
+       | gtd.gtd_num_conses == 0
+               = SM $ runSM f
+       = SM \st c->case get gtd.gtd_name st.dict of
+               Just n = ([n:c], zero)
+               Nothing
+                       //Generate the enumeration if necessary
+                       # box = gtd.gtd_num_conses == 1
+                       # enums = \c->if box c
+                               [concat [toEnumType gtd, " {", join ", " (map toEnumValue gtd.gtd_conses), "}"]:c]
+                       //If it is just an enumeration, Just an enumeration
+                       | and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses]
+                               = ( [toEnumType gtd:c]
+                                 , {defs=singleton gtd.gtd_name $ toEnumType gtd,imps=enums []}
+                               )
+                       //Only one constructor
+                       # defs = singleton gtd.gtd_name (toStructType gtd +++ " *")
+                       # (c`, o) = runSM f {st & dict=union defs st.dict} (if box [] ["} data;\n}"])
+                       # obj = concat [toStructType gtd, "{\n":if box c` [toEnumType gtd, " cons;\nunion {\n":c`]]
+                       = ([toStructType gtd:if (isInfinite i) c [" *":c]], {defs=union o.defs defs, imps=enums [obj:o.imps]})
+gToCType{|CONS of gcd|} f i
+       //No data field
+       | gcd.gcd_arity == 0 = SM \st c->(c, zero)
+       //Only one data field
+       | gcd.gcd_arity == 1 = SM \st c->runSM f st [" ", gcd.gcd_name, ";\n":c]
+       //Multiple data fields
+       = SM \st c
+               # (c, o) = runSM f st [" f", toString (gcd.gcd_arity - 1), ";\n} ", gcd.gcd_name, ";\n":c]
+               = (["struct {\n":c], o)
+gToCType{|RECORD of grd|} f i
+       = SM \st c
+               # grd = trace_stdout grd
+               # defs = singleton grd.grd_name (toStructType grd)
+               # (c`, o) = runSM f {st & inRecord=True,dict=union defs st.dict} ["}"]
+               # obj = concat [toStructType grd, " {\n":c`]
+               = ([toStructType grd:c], {defs=union defs o.defs, imps=[obj:o.imps]})
+gToCType{|FIELD of gfd|} f i
+       = SM \s c->runSM f s [" ", gfd.gfd_name,";\n":c]
+gToCType{|{}|} f i = SM \s c->runSM f s ["*":c]
+gToCType{|{!}|} f i = SM \s c->runSM f s ["*":c]
+gToCType{|{#}|} f i  = SM \s c->runSM f s ["*":c]
+
+unBox (Box b) :== b
+box b :== Box b
+
+isInfinite :: ([String] -> Box Bool a) -> Bool
+isInfinite f = unBox (f [])
+
+generic gPotentialInf a :: [String] -> Box Bool a
+derive gPotentialInf [], [! ], [ !], [!!]
+derive gPotentialInf (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+gPotentialInf{|World|} _ = box False
+gPotentialInf{|File|} _ = box False
+gPotentialInf{|Bool|} _ = box False
+gPotentialInf{|Char|} _ = box False
+gPotentialInf{|Real|} _ = box False
+gPotentialInf{|Int|} _ = box False
+gPotentialInf{|Dynamic|} _ = box False
+gPotentialInf{|(->)|} _ _ _ = box False
+gPotentialInf{|{}|} a m = box (unBox (a m))
+gPotentialInf{|{!}|} a m = box (unBox (a m))
+gPotentialInf{|{#}|} a m = box (unBox (a m))
+gPotentialInf{|UNIT|} _ = box False
+gPotentialInf{|EITHER|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|PAIR|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|CONS|} x m = box (unBox (x m))
+gPotentialInf{|FIELD|} x m = box (unBox (x m))
+gPotentialInf{|RECORD of {grd_name}|} x m
+       | isMember grd_name m = box True
+       = box (unBox (x [grd_name:m]))
+gPotentialInf{|OBJECT of {gtd_name}|} x m
+       | isMember gtd_name m = box True
+       = box (unBox (x [gtd_name:m]))

diff --git a/codegenbug/test.icl b/codegenbug/test.icl
new file mode 100644 (file)
index 0000000..440e811
--- /dev/null
+++ b/codegenbug/test.icl
@@ -0,0 +1,24 @@
+module test
+
+import Data.GenC
+
+derive gToCType T, E, G, List, G2
+////derive gToCValue BCPeripheral, Pin, DHTtype, APin, DPin, T, E, G, List, G2, UInt8
+derive gPotentialInf T, E, G, List, G2
+
+:: E = E1 | E2 | E3
+:: T
+       = A Int Bool
+       | E T
+:: G = {field1 :: Real, test :: Bool, bork :: Int, g2 :: G2}
+:: G2 = {f1 :: Int, f2 :: Bool}
+
+:: List a = Nil | Cons a (List a)
+
+//CPeripherals :: Structmaker BCPeripheral
+//CPeripherals = generateCInfo
+//CPeripherals :: Structmaker (List Int)
+CPeripherals :: Structmaker [Int]
+CPeripherals = gToCType{|*|}
+
+Start = runStructMaker CPeripherals

diff --git a/expruniq/uexpr.icl b/expruniq/uexpr.icl
new file mode 100644 (file)
index 0000000..72e3440
--- /dev/null
+++ b/expruniq/uexpr.icl
@@ -0,0 +1,88 @@
+module uexpr
+
+import StdEnv
+
+import Data.Functor
+import Data.Functor.Identity
+import Control.Applicative
+import Control.Monad => qualified join
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.Writer
+import Data.Array
+import Data.Func
+import Data.List
+import Text
+
+:: In a b = In infix 0 a b
+
+class uexpr v where
+       lit :: a -> v a | toString a
+       (+.) infixl 6 :: (v a) (v a) -> v a | + a
+
+class uvar v where
+       var :: (u:(v .a) -> v:(In u:(v .a) u:(v b))) -> u:(v b), [v <= u]
+
+class uarr v where
+       arr :: *(arr a) -> v *(arr a) | Array arr a & toString a
+       (++.) infixr 5 :: (v .(arr a)) (v .(arr a)) -> v .(arr a) | Array arr a
+       (!.) infixl 9 :: (v .(arr a)) (v Int) -> v a | Array arr a
+
+:: Printer a = P (WriterT [String] (StateT Int Identity) ())
+runPrinter (P a) = concat $ snd $ evalState (runWriterT a) 0
+instance uexpr Printer where
+       lit a = P $ tell [toString a]
+       +. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+"] >>| r >>| tell [")"]
+
+instance uvar Printer where
+       var def = P (
+                       liftT (getState)
+               >>= \s->liftT (put (s+1))
+               >>| let (P i In P b) = def $ P $ tell $ varName s []
+                   in  tell ["let ":varName s [" = "]] >>| i >>| tell [" in\n"] >>| b
+               )
+       where
+               varName i c = ["v",toString i:c]
+
+instance uarr Printer where
+       arr a = P $ tell ["{",join "," [toString a\\a<-:a],"}"]
+       ++. (P l) (P r) = P $ tell ["("] >>| l >>| tell ["+++"] >>| r >>| tell [")"]
+       !. (P l) (P r) = P $ l >>| tell [".["] >>| r >>| tell ["]"]
+
+:: Eval a = E a
+runEval (E a) = a
+instance uexpr Eval where
+       lit a = E $ pure a
+       +. (E l) (E r) = E $ l + r
+
+//instance uvar Eval where
+//     var def = let (i In b) = def i in b
+
+instance uarr Eval where
+       arr a = E a
+       ++. (E l) (E r) = E (appendArr l r)
+       !. (E l) (E r) = E (select l r)
+
+appendArr :: .(arr a) .(arr a) -> .arr a | Array arr a
+appendArr l r = {if (i < size l) l.[i] r.[i rem size l]\\i<-[0..size l + size r - 1]}
+
+//Start = both (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
+Start = runPrinter (var \v=arr {!1,2,3} In v ++. arr {!4,5,6})
+
+//both :: (A.v: v a | uexpr, uarr, uvar v) -> (String, a)
+//both f = (runPrinter f, runEval f)
+
+//i :: v Int | uexpr v
+//i = lit 41 +. lit 1
+//
+//ai :: v {Int} | uexpr, uarr v
+//ai = arr {1,2,3}
+//
+//aip :: v {Int} | uexpr, uarr v
+//aip = arr {1,2,3} ++. arr {4,5,6}
+//
+//aii :: v Int | uexpr, uarr v
+//aii = ai !. lit 41
+//
+//somearray :: *{Int}
+//somearray = {1,2,3}

diff --git a/test.icl b/test.icl
index 2076421..2350a9a 100644 (file)
--- a/test.icl
+++ b/test.icl
@@ -1,45 +1,52 @@
 module test
-<<<<<<< HEAD
-
-import StdEnv
-from Data.Func import $
-import System.Directory
-import System.Time
-
-:: S s a = S .(s -> *(a, s))
-runS (S s) = s
-
-(>>=) infixl 1 :: u:(S .a .b) v:(.b -> .(S .a .c)) -> w:(S .a .c), [w <= u,w <= v]
-(>>=) ma a2mb = S \s
-       # (a, s) = runS ma s
-       = runS (a2mb a) s
-
-Start world = flip runS world
-       $   (S time)
-       >>= \_->S (readDirectory "/home/mrl")
-=======
-import qualified Data.Map as DM
-import iTasks
-import Data.Func
-import Data.Tuple
-import StdEnv
-
-Start w = doTasksWithOptions (\a o->Ok $ flip tuple {o & autoLayout=True} $
-       (parallel
-               [(Embedded, tab "tab1")
-               ,(Embedded, tab "tab2")
-               ]
-               [ OnAction (Action "New") (always (Embedded, tab "New tab"))
-               , OnAction (Action " ") (always (Embedded, tab "New tab"))
-               , OnAction (Action "Close") (never (Embedded, \_->treturn ()))
-               , OnAction (Action "Dis no icon") (never (Embedded, \_->treturn ()))
-               , OnAction (Action "+") (always (Embedded, tab "New tab"))
-               ]
-       <<@ ArrangeWithTabs True
-       <<@ ApplyLayout (setActionIcon ('DM'.put " " "new" 'DM'.newMap))
-       )) w
-
-tab title _ = tune (Title title)
-       $   viewInformation [] ()
-       >>* [OnAction (Action "Close") (always (treturn ()))]
->>>>>>> 49f7dcc4c088dc816398a0c7854d75d7c2628f15
+
+import StdEnv, StdGeneric
+import Data.Array
+
+Start :: [{!Int}]
+Start =
+       [ appendArr {!1,2,3} {!4,5,6,7}
+       , appendArr {!} {!}
+       , appendArr {!} {!1,2,3}
+       , appendArr {!1,2,3} {!}
+       ]
+/*
+derive bimap Box
+
+:: Box b a =: Box b
+
+unBox (Box b) :== b
+box b :== Box b
+
+generic gPotentialInf a :: [String] -> Box Bool a
+
+gPotentialInf{|World|} _ = box False
+gPotentialInf{|File|} _ = box False
+gPotentialInf{|Bool|} _ = box False
+gPotentialInf{|Char|} _ = box False
+gPotentialInf{|Real|} _ = box False
+gPotentialInf{|Int|} _ = box False
+gPotentialInf{|Dynamic|} _ = box False
+gPotentialInf{|(->)|} _ _ _ = box False
+gPotentialInf{|{}|} a m = box (unBox (a m))
+gPotentialInf{|{!}|} a m = box (unBox (a m))
+gPotentialInf{|{#}|} a m = box (unBox (a m))
+gPotentialInf{|UNIT|} _ = box False
+gPotentialInf{|EITHER|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|PAIR|} l r m = box (unBox (l m) || unBox (r m))
+gPotentialInf{|CONS|} x m = box (unBox (x m))
+gPotentialInf{|FIELD|} x m = box (unBox (x m))
+gPotentialInf{|RECORD of {grd_name}|} x m
+       | isMember grd_name m = box True
+       = box (unBox (x [grd_name:m]))
+gPotentialInf{|OBJECT of {gtd_name}|} x m
+       | isMember gtd_name m = box True
+       = box (unBox (x [gtd_name:m]))
+
+//derive gPotentialInf Int,Bool,Char,Real,String,File,World,Dynamic
+derive gPotentialInf (),(,),(,,),(,,,),(,,,,),(,,,,,),(,,,,,,),(,,,,,,,),(,,,,,,,,),(,,,,,,,,,),(,,,,,,,,,,),(,,,,,,,,,,,),(,,,,,,,,,,,,),(,,,,,,,,,,,,,),(,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,),(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,)
+derive gPotentialInf {},{#},{!},[],[! ],[ !],[!!],[#],[#!]
+
+Start :: Box Bool *File
+Start = gPotentialInf{|*|} []
+*/

diff --git a/test2.icl b/test2.icl
index a1876a8..d349f1b 100644 (file)
--- a/test2.icl
+++ b/test2.icl
@@ -1,3 +1,21 @@
-module test2
+module test
 
-Start = 42
+import Data.Func
+import StdEnv, StdGeneric
+
+:: IsR a = IsR Bool | IsROnzin a
+unIsR (IsR b) = b
+generic gIsRecursive a :: [String] -> IsR a
+gIsRecursive{|Int|} _ = IsR False
+gIsRecursive{|UNIT|} _ = IsR False
+gIsRecursive{|EITHER|} l r m = IsR $ unIsR (l m) || unIsR (r m)
+gIsRecursive{|PAIR|} l r m = IsR $ unIsR (l m) || unIsR (r m)
+gIsRecursive{|CONS|} x m = IsR $ unIsR (x m)
+gIsRecursive{|OBJECT of gtd|} x m
+       | isMember gtd.gtd_name m = IsR True
+       = IsR $ unIsR (x m)
+
+derive gIsRecursive []
+
+Start :: IsR [Int]
+Start = gIsRecursive{|*|} []

diff --git a/test3.icl b/test3.icl
new file mode 100644 (file)
index 0000000..0b6455a
--- /dev/null
+++ b/test3.icl
@@ -0,0 +1,33 @@
+module test
+
+import Data.Func
+import StdEnv, StdGeneric
+
+:: IsR a = IsR Bool | IsROnzin a
+unIsR (IsR b) = b
+generic gIsRecursive a :: [String] -> IsR a
+gIsRecursive{|Bool|} _ = IsR False
+gIsRecursive{|Char|} _ = IsR False
+gIsRecursive{|Real|} _ = IsR False
+gIsRecursive{|Int|} _ = IsR False
+gIsRecursive{|{}|} a m = IsR $ unIsR (a m)
+gIsRecursive{|{!}|} a m = IsR $ unIsR (a m)
+gIsRecursive{|{!!}|} a m = IsR $ unIsR (a m)
+gIsRecursive{|UNIT|} _ = IsR False
+gIsRecursive{|EITHER|} l r m = IsR $ unIsR (l m) || unIsR (r m)
+gIsRecursive{|PAIR|} l r m = IsR $ unIsR (l m) || unIsR (r m)
+gIsRecursive{|CONS|} x m = IsR $ unIsR (x m)
+gIsRecursive{|FIELD|} x m = IsR $ unIsR (x m)
+gIsRecursive{|RECORD of grd|} x m
+       | isMember grd.grd_name m = IsR True
+       = IsR $ unIsR (x [grd.grd_name:m])
+gIsRecursive{|OBJECT of gtd|} x m
+       | isMember gtd.gtd_name m = IsR True
+       = IsR $ unIsR (x [gtd.gtd_name:m])
+
+:: R = {f1 :: Int, f2 :: Bool, f3 :: [R]}
+derive gIsRecursive [], R
+
+//Start :: IsR [Int]
+Start :: IsR R
+Start = gIsRecursive{|*|} []