a3/code/Gast/gen.icl

   1 implementation module gen
   2
   3 /*
   4         GAST: A Generic Automatic Software Test-system
   5
   6         gen: generic generation of values of a type
   7
   8         Pieter Koopman, 2004
   9         Radboud Universty, Nijmegen
  10         The Netherlands
  11         pieter@cs.ru.nl
  12 */
  13
  14 import StdEnv, StdGeneric, MersenneTwister
  15
  16 // -------
  17 :: RandomStream :== [Int]
  18
  19 aStream :: RandomStream
  20 aStream = genRandInt 42
  21
  22 split :: RandomStream -> (RandomStream,RandomStream)
  23 split [r,s:rnd]
  24         # seed = r*s
  25         | seed==0
  26                 = split rnd
  27                 = (genRandInt seed, rnd)
  28 split _ = abort "gen.icl: the increadable has been done, you have used all random values!"
  29 // -------
  30
  31 randomize :: [a] [Int] Int ([Int] -> [a]) -> [a]
  32 randomize list rnd n c = rand list rnd n []
  33 where
  34         rand [] rnd m [] = c rnd
  35         rand [] rnd m [x] = [x:c rnd]
  36         rand [] rnd m l = rand l rnd n []
  37         rand [a:x] [i:rnd] m l
  38                 | m==0 || (i rem m) == 0
  39                         = [a:rand x rnd (m-1) l]
  40                         = rand x rnd m [a:l]
  41 // -------
  42
  43 generic ggen a :: Int [Int] -> [a]
  44
  45 maxint :: Int
  46 maxint = 2147483647
  47
  48 minint :: Int
  49 minint = -2147483648
  50
  51 ggen{|Int|}  n rnd = randomize [0,1,-1,maxint,minint] rnd 5 id
  52 ggen{|Bool|} n rnd = randomize [False,True] rnd 2 \_.[]
  53 ggen{|Char|} n rnd = randomize (map toChar [32..126] ++ ['\t\n\r']) rnd 98 (\_.[])
  54 ggen{|Real|}  n rnd = randomize [0.0,1.0,-1.0] rnd 3 (\[s:x] -> f x (genRandReal s))
  55 where f [i,j:x] [r:s]
  56                 | r==0.0
  57                         = [r:f x s]
  58                         # r = if (isOdd i) r (~r)
  59                           r = if (isOdd j) r (1.0/r)
  60                         = [r:f x s]
  61
  62 bias :== 1024
  63
  64 ggen{|UNIT|} n rnd = [UNIT]
  65 ggen{|PAIR|} f g n rnd
  66         # (rn2,rnd) = split rnd
  67         = map (\(a,b)=PAIR a b) (diag2 (f n rnd) (g n rn2)) // inlinen !?
  68 ggen{|EITHER|} f g n rnd
  69                 # (r1,rnd) = split rnd
  70                   (r2,rnd) = split rnd
  71                 = Merge n rnd (f n r1) (g (n+1) r2)
  72 where
  73         Merge :: Int RandomStream [a] [b] -> [EITHER a b] // Correct, strict in none of the lists!
  74         Merge n [i:r] as bs
  75          | (i rem n) <> 0
  76 //       | (i rem bias) > n+(bias/2)
  77                 = case as of
  78                         [] = map RIGHT bs
  79                         [a:as] = [LEFT a: Merge n r as bs]
  80                 = case bs of
  81                         [] = map LEFT as
  82                         [b:bs] = [RIGHT b: Merge n r as bs]
  83 /*      Merge :: RandomStream [a] [b] -> [EITHER a b] // Wrong, strict in both lists
  84         Merge r [] bs = map RIGHT bs
  85         Merge r as [] = map LEFT as
  86         Merge [i:r] [a:as] [b:bs]
  87                 | isOdd i
  88                         = [LEFT a, RIGHT b:Merge r as bs]
  89                         = [RIGHT b, LEFT a:Merge r as bs]
  90 *//*            = Merge (isOdd (hd rnd)) (f r1) (g r2)
  91 where
  92         Merge :: Bool [a] [b] -> [EITHER a b]
  93         Merge r as bs
  94          | r
  95                 = case as of
  96                         [] = map RIGHT bs
  97                         [a:as] = [LEFT a: Merge (not r) as bs]
  98                 = case bs of
  99                         [] = map LEFT as
 100                         [b:bs] = [RIGHT b: Merge (not r) as bs]
 101 */
 102 ggen{|CONS|}   f n rnd = map CONS (f n rnd)
 103 ggen{|OBJECT|} f n rnd = map OBJECT (f n rnd)
 104 ggen{|FIELD|}  f n rnd = map FIELD (f n rnd)
 105 ggen{|String|} n rnd = ["hello world!","Tested with GAST!": rndStrings 0 rnd]
 106 where
 107         rndStrings 0 rnd = ["": rndStrings 1 rnd]
 108         rndStrings len [r,s:rnd]
 109                 # (chars,rnd)   = seqList (repeatn ((abs r) rem len) genElem) rnd
 110                   string                = {c \\ c<-chars}
 111                 = [string:rndStrings ((len rem StrLen)+1) rnd]
 112
 113 class genElem a where genElem :: RandomStream -> .(a,RandomStream)
 114
 115 instance genElem Int where genElem [r:rnd] = (r,rnd)
 116 instance genElem Char where genElem [r:rnd] = (toChar (32+((abs r) rem 94)),rnd)
 117 instance genElem Bool where genElem [r:rnd] = (isOdd r,rnd)
 118 instance genElem Real where genElem [r,s,t:rnd] = ((toReal r/toReal s)*toReal t,rnd)
 119
 120 derive ggen (,), (,,), (,,,), []
 121 derive bimap []