struct/struct.icl

   1 module struct
   2
   3 import StdEnv
   4 import StdGeneric
   5 import StdDebug
   6
   7 import Text
   8
   9 import Data.Functor
  10 import Control.Applicative
  11
  12 :: Structmaker a = SM (Int [String] -> [String]) | Onzin a
  13
  14 runSM :: (Structmaker a) -> (Int [String] -> [String])
  15 runSM (SM a) = a
  16
  17 generic gToStruct a :: Structmaker a
  18 gToStruct{|Int|}  = SM \_ c->["int":c]
  19 gToStruct{|Real|} = SM \_ c->["double":c]
  20 gToStruct{|Bool|} = SM \_ c->["bool":c]
  21
  22 gToStruct{|UNIT|} = SM \_->id
  23 gToStruct{|EITHER|} fl fr = SM \i->runSM fl i o runSM fr i
  24 gToStruct{|PAIR|} fl fr
  25          = SM \i c->runSM fl i [" f", toString i, "; ":runSM fr (i+1) c]
  26
  27 gToStruct{|OBJECT of gtd|} f
  28         | gtd.gtd_num_conses == 0 = SM (runSM f)
  29         = SM \i c->
  30                 ["struct clean_", gtd.gtd_name, " {\n"
  31                 ,"uint8_t cons;\n"
  32                 ,"union {\n"
  33                 :runSM f i
  34                 ["} data;\n"
  35                 ,"}":c]]
  36 gToStruct{|CONS of gcd|} f = SM \i c->["struct { ":runSM f i ["} ", gcd.gcd_name, ";\n":c]]
  37 gToStruct{|RECORD of grd|} f
  38         = SM \i c->
  39                 ["struct clean_", grd.grd_name, " {\n"
  40                 :runSM f i
  41                 ["}":c]]
  42 gToStruct{|FIELD of gfd|} f = SM \i c->runSM f i [gfd.gfd_name,";\n":c]
  43
  44 :: DHTDetails
  45         = DHT Int Bool
  46         | SHT Addr
  47         | XXX Int Int Int
  48         | XXY Int Int Int
  49
  50 :: Addr =: Addr Int
  51
  52 :: DHTType = DHT11 | DHT12 | DHT22
  53
  54 derive gToStruct DHTDetails
  55 derive gToStruct DHTType
  56 derive gToStruct Addr
  57 derive gToStruct Record
  58
  59 Start =
  60         (concat (runSM s 0 [])
  61         ,concat (runSM s` 0 [])
  62         )
  63
  64 :: Record =
  65         { field1 :: Int
  66         , field2 :: Bool
  67         , field3 :: DHTType
  68         }
  69
  70 s :: (Structmaker DHTDetails)
  71 s = gToStruct{|*|}
  72
  73 s` :: (Structmaker Record)
  74 s` = gToStruct{|*|}
  75