From 1e045c594292d096dac9064412e8641e8e02bda7 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 15 Nov 2019 13:37:59 +0100 Subject: [PATCH] structs --- .gitignore | 2 + struct/struct.icl | 154 +++++++++++++++++++++++++++++++++------------- 2 files changed, 113 insertions(+), 43 deletions(-) diff --git a/.gitignore b/.gitignore index c17b393..df867ba 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,5 @@ test gopt afp/a[0-9]/a[0-9] afp/a1[0-9]/a1[0-9] + +struct diff --git a/struct/struct.icl b/struct/struct.icl index c1d2bdd..97303ae 100644 --- a/struct/struct.icl +++ b/struct/struct.icl @@ -9,57 +9,126 @@ import Text import Data.Functor import Control.Applicative -:: Structmaker a = SM (Int [String] -> [String]) | Onzin a - -runSM :: (Structmaker a) -> (Int [String] -> [String]) -runSM (SM a) = a - -generic gToStruct a :: Structmaker a -gToStruct{|Int|} = SM \_ c->["int":c] -gToStruct{|Real|} = SM \_ c->["double":c] -gToStruct{|Bool|} = SM \_ c->["bool":c] - -gToStruct{|UNIT|} = SM \_->id -gToStruct{|EITHER|} fl fr = SM \i->runSM fl i o runSM fr i -gToStruct{|PAIR|} fl fr - = SM \i c->runSM fl i [" f", toString i, "; ":runSM fr (i+1) c] - -gToStruct{|OBJECT of gtd|} f - | gtd.gtd_num_conses == 0 = SM (runSM f) - = SM \i c-> - ["struct clean_", gtd.gtd_name, " {\n" - ,"uint8_t cons;\n" - ,"union {\n" - :runSM f i - ["} data;\n" - ,"}":c]] -gToStruct{|CONS of gcd|} f = SM \i c->["struct { ":runSM f i ["} ", gcd.gcd_name, ";\n":c]] -gToStruct{|RECORD of grd|} f - = SM \i c-> - ["struct clean_", grd.grd_name, " {\n" - :runSM f i - ["}":c]] -gToStruct{|FIELD of gfd|} f = SM \i c->runSM f i [gfd.gfd_name,";\n":c] +:: Structmaker a = SM (SData [String] -> [String]) | Onzin a +:: SData = {indent :: Int, fresh :: Int, inRecord :: Bool} + +indent :: SData [String] -> [String] +indent s c = [createArray s.indent '\t':c] + +show :: String SData [String] -> [String] +show str s c = indent s [str:c] + +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 gGenerateC a | gToCType{|*|}, gToCValue{|*|}, gToCEnums{|*|} a + +:: CInfo a = + { header :: String + , toValue :: a -> String + } + +generateCInfo :: CInfo a | gGenerateC a +generateCInfo = + let (CEnums enums) = cast res gToCEnums{|*|} + (SM types) = cast res gToCType{|*|} + res = { header = join "\n" (removeDup (sort enums)) +++ "\n\n" +++ concat (types {fresh=0,inRecord=False,indent=0} []) + , toValue = \a->concat (gToCValue{|*|} a []) + } + in res +where + cast :: (v a) -> ((w a) -> w a) + cast _ = id + + +generic gToCType a :: Structmaker a +gToCType{|Int|} = SM (show "uint64_t") +gToCType{|Real|} = SM (show "double") +gToCType{|Bool|} = SM (show "bool") +gToCType{|UNIT|} = SM \_->id +gToCType{|EITHER|} (SM fl) (SM fr) = SM \s->fl s o fr s +gToCType{|PAIR|} (SM fl) (SM fr) + = SM \s c + | s.inRecord = fl s (fr s c) + = fl s [" f", toString s.fresh, ";\n":fr {s & fresh=s.fresh+1} c] +gToCType{|OBJECT of gtd|} (SM f) + //Newtype + | gtd.gtd_num_conses == 0 = SM f + = SM \s c + //Enumeration (no data) + | and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] + = indent s [toEnumType gtd:c] + //Regular ADTs + # s` = {s & indent = s.indent + 1} + = indent s ["struct clean_", gtd.gtd_name, " {\n": + indent s` [toEnumType gtd, " cons;\n": + indent s` ["union {\n": + f {s` & indent=s`.indent+1, inRecord=False} (indent s` ["} data;\n": + indent s ["}":c]])]]] +gToCType{|CONS of gcd|} (SM f) + //No data field + | gcd.gcd_arity == 0 = SM \_->id + //Only one data field + | gcd.gcd_arity == 1 = SM \s c->f s [" ", gcd.gcd_name, ";\n":c] + = SM \s c->indent s ["struct {\n":f {s & indent=s.indent+1} [" f", toString (gcd.gcd_arity - 1), ";\n":indent s ["} ", gcd.gcd_name, ";\n":c]]] +gToCType{|RECORD of grd|} (SM f) + = SM \s c->indent s ["struct clean_", grd.grd_name, " {\n": f {s & indent=s.indent+1, inRecord=True} (indent s ["}":c])] +gToCType{|FIELD of gfd|} (SM f) = SM \s c->f s [" ", gfd.gfd_name,";\n":c] + +:: CEnums a = CEnums [String] | Onzin2 a +generic gToCEnums a :: CEnums a +gToCEnums{|a|} = CEnums [] +gToCEnums{|UNIT|} = CEnums [] +gToCEnums{|EITHER|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr) +gToCEnums{|PAIR|} (CEnums fl) (CEnums fr) = CEnums (fl ++ fr) +gToCEnums{|OBJECT of gtd|} (CEnums f) + = CEnums [concat [toEnumType gtd, " {", join ", " (map toEnumValue gtd.gtd_conses), "};"]:f] +gToCEnums{|CONS|} (CEnums f) = CEnums f +gToCEnums{|RECORD|} (CEnums f) = CEnums f +gToCEnums{|FIELD|} (CEnums f) = CEnums f + +generic gToCValue a :: a [String] -> [String] +gToCValue{|Int|} i c = [toString i:c] +gToCValue{|Real|} r c = [toString r:c] +gToCValue{|Bool|} b c = [if b "true" "false":c] +gToCValue{|UNIT|} _ _ = [] +gToCValue{|EITHER|} fl _ (LEFT l) c = fl l c +gToCValue{|EITHER|} _ fr (RIGHT l) c = fr l c +gToCValue{|PAIR|} fl fr (PAIR l r) c = fl l [", ":fr r c] +gToCValue{|OBJECT of gtd|} f (OBJECT a) c + //Newtype + | gtd.gtd_num_conses == 0 = f a c + | and [gcd.gcd_arity == 0\\gcd<-gtd.gtd_conses] + = f a c + = ["{":f a ["}":c]] +gToCValue{|CONS of gcd|} f (CONS a) c + //No data field + | gcd.gcd_arity == 0 = [toEnumValue gcd:c] + | gcd.gcd_arity == 1 + = [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"=":f a c] + = [" .cons=",toEnumValue gcd,", .data.",gcd.gcd_name,"={":f a ["} ":c]] +gToCValue{|RECORD|} f (RECORD a) c + = ["{":f a ["}":c]] +gToCValue{|FIELD of gfd|} f (FIELD a) c + = [" .", gfd.gfd_name, "=": f a c] :: DHTDetails = DHT Int Bool | SHT Addr | XXX Int Int Int - | XXY Int Int Int + | XXY Int Int DHTType :: Addr =: Addr Int :: DHTType = DHT11 | DHT12 | DHT22 -derive gToStruct DHTDetails -derive gToStruct DHTType -derive gToStruct Addr -derive gToStruct Record +derive class gGenerateC DHTDetails, DHTType, Addr, Record -Start = - (concat (runSM s 0 []) - ,concat (runSM s` 0 []) - ) +Start :: CInfo DHTDetails +Start = generateCInfo :: Record = { field1 :: Int @@ -68,8 +137,7 @@ Start = } s :: (Structmaker DHTDetails) -s = gToStruct{|*|} +s = gToCType{|*|} s` :: (Structmaker Record) -s` = gToStruct{|*|} - +s` = gToCType{|*|} -- 2.20.1