1 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 
   16 
   17 
   18 
   19 
   20 
   21 
   22   module GenVal (
   23       gen_vals, gen_id_val
   24       ) where
   25 
   26   import Utils
   27   import Config
   28   import Types
   29   import Env
   30 
   31 
   32 
   33 
   34 
   35 
   36 
   37 
   38   gen_vals :: Int -> Int -> Cont -> Cont
   39   gen_vals n dp c
   40       =  get_all_type_names
   41          (\tns -> cmap (rep n (upto (length tns - one)
   42                   . (\vc r -> gen_val (tns !! r) dp vc)))
   43          (\vs -> get_val_names n
   44          (\vns -> extend_val_env (zip vns vs) c)))
   45 
   46 
   47 
   48 
   49 
   50 
   51 
   52   gen_val :: Type_name -> Int -> Vcont -> Cont
   53   gen_val tn dp vc
   54       | dp <= one =  get_type tn (\t -> vc (Tagged_val (fst (head t)) []))
   55       | otherwise =  get_type tn tc
   56                      where
   57                      tc t  =  upto (length t - one) nc
   58                               where
   59                               nc r  =  cmap (map (gen_id_val (dp - one)) ids)
   60                                        (\vs -> vc (Tagged_val c' vs))
   61                                        where
   62                                        (c', ids)  =  t !! r
   63 
   64 
   65 
   66 
   67 
   68 
   69 
   70   gen_id_val :: Int -> Argtype -> Vcont -> Cont
   71   gen_id_val dp (Name_type tn) vc  =  gen_val tn dp vc
   72   gen_id_val dp (Basic_type bt) vc  =  gen_basic_val bt vc
   73   gen_id_val dp (List_type id) vc
   74       =  upto max_list_len
   75          (\r -> cmap (rep r (gen_id_val (dp - one) id))
   76          (\vs -> vc (List_val vs)))
   77   gen_id_val dp (Tuple_type ids) vc
   78       =  cmap (map (gen_id_val (dp - one)) ids)
   79          (\vs -> vc (Tuple_val vs))
   80   gen_id_val dp (Array_type id id') vc
   81       =  let vsc [v,v']
   82                  =  upto (max_array_len-one)
   83                     (\r -> let vsc' vs  =  vc (Array_val (v,v'')
   84                                                   (zipWith (,) vrng vs))
   85                                vrng     =  take (r+one) (vrange (v,v'))
   86                                v''      =  case vrng of
   87                                                []    -> v'
   88                                                (_:_) -> last vrng
   89                            in
   90                                cmap (rep (length vrng)
   91                                     (gen_id_val (dp-one) id')) vsc')
   92          in
   93              cmap (rep 2 (gen_id_val (dp - one) id)) vsc
   94 
   95 
   96 
   97 
   98 
   99 
  100 
  101 
  102 
  103 
  104 
  105 
  106 
  107 
  108 
  109 
  110 
  111 
  112   gen_basic_val :: Base_type -> Vcont -> Cont
  113   gen_basic_val (Num_type k) vc
  114       =  upto maxint (\r -> vc (Num_val k r))
  115          where
  116          maxint  =  256 :: Int
  117   gen_basic_val Bool_type vc
  118       =  choose [True, False] (\b -> vc (Bool_val b))
  119   gen_basic_val Char_type vc
  120       =  upto maxchar (\r -> vc (Char_val (toEnum r)))
  121 
  122 
  123 
  124 
  125 
  126 
  127 
  128