From 8ff537028a2955ede52506d13628c2d3faede6ed Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 17 Dec 2019 12:26:48 +0100 Subject: [PATCH] ue --- codegenbug/Data/GenC.dcl | 19 +++++ codegenbug/Data/GenC.icl | 149 +++++++++++++++++++++++++++++++++++++++ codegenbug/test.icl | 24 +++++++ expruniq/uexpr.icl | 88 +++++++++++++++++++++++ test.icl | 95 +++++++++++++------------ test2.icl | 22 +++++- test3.icl | 33 +++++++++ 7 files changed, 384 insertions(+), 46 deletions(-) create mode 100644 codegenbug/Data/GenC.dcl create mode 100644 codegenbug/Data/GenC.icl create mode 100644 codegenbug/test.icl create mode 100644 expruniq/uexpr.icl create mode 100644 test3.icl diff --git a/codegenbug/Data/GenC.dcl b/codegenbug/Data/GenC.dcl new file mode 100644 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 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 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 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 --- 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 --- 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 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{|*|} [] -- 2.20.1