module Code ( genCode ) where import Data.List import Data.Maybe import Text.Printf import Model genCode :: String -> [String] -> [Class] -> IO () genCode name includes classes = do writeFile (name ++ ".h") $ "// Generated by statechart.\n\n" ++ "// Updates the statechart millisecond clock. Used for tm(...) events.\n" ++ "void elapseTime(int ms);\n" ++ concat [ "\nvoid " ++ n ++ "(void);\n" | Class n _ _ <- classes ] writeFile (name ++ ".c") $ "// Generated by statechart.\n" ++ "#include \n" ++ "#include \n\n" ++ concat [ "#include \"" ++ inc ++ "\"\n" | inc <- (name ++ ".h") : includes ] ++ "\n" ++ "// The reference clock used for tm(...) events.\n" ++ "static uint64_t __clock = 0;\n\n" ++ "// Updates the statechart millisecond clock. Used for tm(...) events.\n" ++ "void elapseTime(int ms) { __clock += (uint64_t) ms; }\n" ++ concatMap codeClass classes indent :: String -> String indent = unlines . map (" " ++) . lines block :: String -> String block a = "{\n" ++ indent a ++ "}\n" codeClass :: Class -> String codeClass (Class name attrs statecharts) = "\n// Class " ++ name ++ ".\n" ++ "void " ++ name ++ "() " ++ block (concatMap codeAttr attrs ++ concatMap codeStateChart statecharts) codeAttr :: Attribute -> String codeAttr a = printf "static %s %s%s;\n" (attrType a) (attrName a) (case attrInit a of { Nothing -> ""; Just i -> " = " ++ i}) codeStateChart :: StateChart -> String codeStateChart (StateChart name idsNames init transitions) = "\n// Statechart " ++ name ++ ".\n" ++ block ( "static bool __init = false;\n" ++ "static int __trans = 0;\n" ++ concat [ printf "static bool %s = false;\n" name | (_, name) <- idsNames ] ++ concat [ printf "static uint64_t %s_entryTime = 0;\n" name | (_, name) <- idsNames ] ++ codeInit stateName init ++ codeTransitions stateName transitions ) where stateName :: Id -> Name stateName id = fromJust $ lookup id idsNames codeInit :: (Id -> Name) -> Init -> String codeInit stateName (Init actions targets) = "\n// Initialize\n" ++ "if (! __init) " ++ block ("__init = true;\n" ++ transitionStates stateName [] targets ++ concat [ block a | a <- actions ]) transitionStates :: (Id -> Name) -> [Id] -> [Id] -> String transitionStates stateName a b = concat [ printf "%s = false;\n" (stateName s) | s <- a \\ b ] ++ concat [ printf "%s = true;\n%s_entryTime = __clock;\n" (stateName s) (stateName s) | s <- b \\ a ] codeTransition :: (Id -> Name) -> Transition -> String codeTransition stateName t = printf "if (%s) " predicate ++ block (transition ++ action) where predicate = intercalate " && " $ [ stateName a | a <- transitionSource t ] ++ [ printf "__clock >= %s_entryTime + (%s)" (stateName id) time | (id, time) <- transitionTimeout t ] ++ [ printf "(%s)" a | a <- transitionGuard t ] transition = transitionStates stateName (transitionSource t) (transitionTarget t) action = concat [ block a | a <- transitionAction t ] codeTransitions :: (Id -> Name) -> [Transition] -> String codeTransitions stateName transitions = printf "switch (__trans) " ++ block (concat [ printf "// %s -> %s\ncase %d:\n" (fst $ transitionName t) (snd $ transitionName t) n ++ (indent $ codeTransition stateName t ++ printf "__trans = %d;\nbreak;\n" (if n == length transitions - 1 then 0 else n + 1)) | (n, t) <- zip [0..] transitions ])