diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) Tom Hawkins 2010
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,8 @@
+#! /usr/bin/env runhaskell
+
+> module Main (main) where
+>
+> import Distribution.Simple (defaultMain)
+>
+> main :: IO ()
+> main = defaultMain
diff --git a/src/Code.hs b/src/Code.hs
new file mode 100644
--- /dev/null
+++ b/src/Code.hs
@@ -0,0 +1,163 @@
+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 <stdbool.h>\n"
+    ++ "#include <stdint.h>\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
+
+formatId :: String -> String -> String
+formatId prefix id = prefix ++ map f id
+  where
+  f '-' = '_'
+  f a = a
+
+sId = formatId "s_"
+
+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 states transitions) = seq defaultState $ "\n// Statechart " ++ name ++ ".\n"
+  ++ block (
+        concat [ printf "static bool %s = false;\n"           (sId $ stateId state) | state <- states ]
+     ++ concat [ printf "static uint64_t %s_entryTime = 0;\n" (sId $ stateId state) | state <- states ]
+     ++ intercalate "\nelse\n" (codeInit states defaultTransition rootState : mapMaybe (codeState states transitions) states)
+     )
+  where
+  rootState = head [ state | state <- states, stateParent state == Nothing ]
+  defaultTransition = case [ t | t <- transitions, transitionSource t == Nothing ] of
+    [t] -> t
+    []  -> error "default state not specified (1)"
+    _   -> error "lower level default transitions not supported"
+  defaultState = if Just (transitionId defaultTransition) /= stateDefaultTrans rootState
+    then error "default state not specified (2)"
+    else head [ state | state <- states, stateId state == transitionTarget defaultTransition ]
+
+codeInit :: [State] -> Transition -> State -> String
+codeInit states transition state = "\n// Initialize\n"
+  ++ "if (! " ++ sId (stateId state) ++ ") " ++ block (codeTransition states transition)
+
+codeState :: [State] -> [Transition] -> State -> Maybe String
+codeState states transitions state = if null t then Nothing else Just $ "\n// In state " ++ stateName state ++ "\n"
+  ++ "if (" ++ sId (stateId state) ++ ") " ++ block (intercalate "\nelse\n" t)
+  where
+  t = [ codeTransition states t | t <- transitions, transitionSource t == Just (stateId state) ]
+
+codeTransition :: [State] -> Transition -> String
+codeTransition states t = case transitionSource t of
+  Nothing     -> "\n// -> " ++ stateName (idState states target) ++ "\n"
+              ++ transAction (transitionAction t) ++ concatMap (stateEntry . idState states) b
+    where
+    b = hierarchy states target
+    
+  Just source -> "\n// " ++ stateName (idState states source) ++ " -> " ++ stateName (idState states target) ++ "\n"
+              ++ "if (" ++ predicate ++ ") " ++ block (concatMap (stateExit . idState states) a ++ transAction (transitionAction t) ++ concatMap (stateEntry . idState states) b)
+    where
+    (a, b) = changedStates states source target
+    predicate = case (predicateTimeout, predicateGuard) of
+      ("", "") -> "true"
+      ("", a)  -> a
+      (a, "")  -> a
+      (a, b)   -> "(" ++ a ++ ") && (" ++ b ++ ")"
+    predicateTimeout = case transitionTimeout t of
+      Nothing -> ""
+      Just i  -> "__clock >= " ++ sId source ++ "_entryTime + (" ++ i ++ ")"
+    predicateGuard = case transitionGuard t of
+      Nothing -> ""
+      Just g  -> g
+  where
+  target = transitionTarget t
+
+stateExit :: State -> String
+stateExit s = case stateExitAction s of
+  Nothing ->              stateUpdate
+  Just a  -> a ++ "\n" ++ stateUpdate
+  where
+  stateUpdate = sId (stateId s) ++ " = false;\n"
+
+stateEntry :: State -> String
+stateEntry s = case stateEntryAction s of
+  Nothing ->              stateUpdate
+  Just a  -> a ++ "\n" ++ stateUpdate
+  where
+  stateUpdate = sId (stateId s) ++ " = true;\n" ++ sId (stateId s) ++ "_entryTime = __clock;\n"
+
+transAction :: Maybe String -> String
+transAction Nothing = ""
+transAction (Just a) = a ++ "\n"
+
+idState :: [State] -> Id -> State
+idState states id = head [ s | s <- states, stateId s == id ]
+
+-- (statesExiting, statesEntering)  with proper order.
+changedStates :: [State] -> Id -> Id -> ([Id], [Id])
+changedStates states a b = (reverse a', b')
+  where
+  (a', b') = stripCommonPrefix (hierarchy states a) (hierarchy states b)
+
+hierarchy :: [State] -> Id -> [Id]
+hierarchy states id = case stateParent $ idState states id of
+  Nothing -> [id]
+  Just a  -> hierarchy states a ++ [id]
+
+stripCommonPrefix :: Eq a => [a] -> [a] -> ([a], [a])
+stripCommonPrefix (a : as) (b : bs)
+  | a == b    = stripCommonPrefix as bs
+  | otherwise = (a : as, b : bs)
+stripCommonPrefix a b = (a, b)
+
+{-
+data Class = Class Name [StateChart] deriving Show
+
+data StateChart = StateChart Name [State] [Connector] [Transition] deriving Show
+
+data State = State
+  { stateName         :: Name
+  , stateId           :: Id
+  , stateParent       :: Maybe Id
+  , stateDefaultTrans :: Maybe Id
+  , stateEntryAction  :: Maybe Code
+  , stateExitAction   :: Maybe Code
+  } deriving Show
+
+data Transition = Transition
+  { transitionName    :: Name
+  , transitionTimeout :: Maybe Int
+  , transitionGuard   :: Maybe Code
+  , transitionAction  :: Maybe Code
+  , transitionSource  :: Maybe Id
+  , transitionTarget  :: Id
+  } deriving Show
+
+-}
diff --git a/src/Model.hs b/src/Model.hs
new file mode 100644
--- /dev/null
+++ b/src/Model.hs
@@ -0,0 +1,131 @@
+module Model
+  ( Class         (..)
+  , Attribute     (..)
+  , StateChart    (..)
+  , State         (..)
+  , Transition    (..)
+  -- , Connector     (..)
+  -- , ConnectorType (..)
+  , Name
+  , Id
+  , Code
+  , parseModel
+  ) where
+
+import Data.List
+
+import Rhapsody
+
+type Name = String
+type Id   = String
+type Code = String
+
+data Class = Class Name [Attribute] [StateChart] deriving Show
+
+data StateChart = StateChart Name [State] [Transition] deriving Show
+
+data Attribute = Attribute
+  { attrName :: Name
+  , attrType :: String
+  , attrInit :: Maybe String
+  } deriving Show
+
+data State = State
+  { stateName         :: Name
+  , stateId           :: Id
+  , stateParent       :: Maybe Id
+  , stateDefaultTrans :: Maybe Id
+  , stateEntryAction  :: Maybe Code
+  , stateExitAction   :: Maybe Code
+  } deriving Show
+
+{-
+data Connector = Connector
+  { connectorName   :: Name
+  , connectorId     :: Id
+  , connectorParent :: Id
+  , connectorType   :: ConnectorType
+  } deriving Show
+
+data ConnectorType = Junction | Condition deriving Show
+-}
+
+data Transition = Transition
+  { transitionName    :: Name
+  , transitionId      :: Id
+  , transitionTimeout :: Maybe Code
+  , transitionGuard   :: Maybe Code
+  , transitionAction  :: Maybe Code
+  , transitionSource  :: Maybe Id
+  , transitionTarget  :: Id
+  } deriving Show
+
+parseModel :: Record -> [Class]
+parseModel file = map parseClass $ containerRecords "Classes" file
+
+parseClass :: Record -> Class
+parseClass a = Class (head $ values "_name" a) (map parseAttribute $ containerRecords "Attrs" a)  (map parseStateChart $ containerRecords "StateCharts" a)
+
+parseAttribute :: Record -> Attribute
+parseAttribute a = Attribute
+  { attrName = value "_name" a
+  , attrType = value "_name" $ head $ records "_typeOf" a
+  , attrInit = case containerRecords "ValueSpecifications" a of
+      []  -> Nothing
+      [a] -> Just $ value "_value" a
+      _   -> error "too many value specifications"
+  }
+
+parseStateChart :: Record -> StateChart
+parseStateChart a = if not $ null $ containerRecords "Connectors" a then error "connectors not supported" else StateChart
+  (value "_name" a)
+  (map parseState      $ containerRecords "States"      a)
+  (map parseTransition $ containerRecords "Transitions" a)
+
+parseState :: Record -> State
+parseState a = if values "_stateType" a == ["And"] then error $ "and state not supported: " ++ value "_name" a else State
+  { stateName         = value "_name"         a
+  , stateId           = ident "_id"           a
+  , stateParent       = maybeList $ ident "_parent"       a
+  , stateDefaultTrans = maybeList $ ident "_defaultTrans" a
+  , stateEntryAction  = maybeList $ body  "_entryAction"  a
+  , stateExitAction   = maybeList $ body  "_exitAction"   a
+  } 
+
+{-
+parseConnector :: Record -> Connector
+parseConnector a = Connector
+  { connectorName   = value "_name"   a
+  , connectorId     = ident "_id"     a
+  , connectorParent = ident "_parent" a
+  , connectorType   = case value "_connectorType" a of
+      "Junction"  -> Junction
+      "Condition" -> Condition
+      --"Fork"      -> Fork
+      --"Join"      -> Join
+      a           -> error $ "unknown connector type: " ++ a
+  }
+-}
+
+parseTransition :: Record -> Transition
+parseTransition a = Transition
+  { transitionName    = value "_name" a
+  , transitionId      = ident "_id"   a
+  , transitionTimeout = timeout
+  , transitionGuard   = maybeList $ if guard == "else" then error "else guards not supported" else guard
+  , transitionAction  = maybeList $ body "_itsAction"  label
+  , transitionSource  = maybeList $ ident "_itsSource" a
+  , transitionTarget  = ident "_itsTarget" a
+  }
+  where
+  label = head $ records "_itsLabel" a
+  timeout = case body "_itsTrigger" label of
+    a | isPrefixOf "tm(" a -> Just $ drop 3 $ init a
+      | null a             -> Nothing
+      | otherwise          -> error $ "not supported non tm() events: " ++ a
+  guard = body "_itsGuard" label
+
+
+maybeList :: [a] -> Maybe [a]
+maybeList a = if null a then Nothing else Just a
+
diff --git a/src/Rhapsody.hs b/src/Rhapsody.hs
new file mode 100644
--- /dev/null
+++ b/src/Rhapsody.hs
@@ -0,0 +1,133 @@
+module Rhapsody
+  ( Record (..)
+  , Field  (..)
+  , parseRhapsody
+  , records
+  , values
+  , value
+  , containerRecords
+  , ident
+  , body
+  ) where
+
+import Text.ParserCombinators.Poly.Plain
+
+data Record = Record String [Field]  deriving (Show, Eq)
+data Field
+  = Value       String [String]
+  | RecordNamed String [Record]
+  | RecordAnon          Record
+  deriving (Show, Eq)
+
+-- | Given a record and a field name, returns a subfield of records.  Null if not found.
+records :: String -> Record -> [Record]
+records name (Record _ fields) = concat [ recs | RecordNamed n recs <- fields, n == name ]
+
+-- | Given a record and a field name, returns a subfield of values.  Null if not found.
+values :: String -> Record -> [String]
+values name (Record _ fields) = concat [ vals | Value n vals <- fields, n == name ]
+
+-- | Returns a field with a single value, or an empty string if the field does not exist.
+value :: String -> Record -> String
+value name r = case values name r of
+  [] -> ""
+  a : _ -> a
+
+-- | Returns a list of records packaged in an IRPYRawContainer.
+containerRecords :: String -> Record -> [Record]
+containerRecords name rec = case records name rec of
+  [] -> []
+  a : _ -> records "value" a
+ 
+-- | A unique identifier field.
+ident :: String -> Record -> String
+ident name a = case values name a of
+  [_, a] -> a
+  _ -> ""
+
+-- | Extract the _body string from triggers, guards, and actions.
+body :: String -> Record -> String
+body name rec = case records name rec of
+  [] -> ""
+  a : _ -> value "_body" a
+
+
+
+-- Lexing.
+
+data Token
+  = Eq
+  | Dash
+  | SemiColon
+  | BraceLeft
+  | BraceRight
+  | String String
+  deriving (Show, Eq)
+
+lexer :: String -> [Token]
+lexer = tokens . unlines . tail . lines . decomment
+  where
+
+  tokens :: String -> [Token]
+  tokens "" = []
+  tokens a = case a of
+    a : b | elem a " \r\n\t" -> tokens b
+    '{' : b -> BraceLeft  : tokens b
+    '}' : b -> BraceRight : tokens b
+    '=' : b -> Eq         : tokens b
+    '-' : ' ' : b -> Dash       : tokens b
+    ';' : b -> SemiColon  : tokens b
+    '"' : b -> String str : tokens rest where (str, rest) = string b
+    '#' : b -> tokens $ dropWhile (/= '\n') b
+    a -> String (takeWhile (flip notElem " \r\n\t;") a) : tokens (dropWhile (flip notElem " \r\n\t;") a)
+
+  string :: String -> (String, String)
+  string a = case a of
+    [] -> error "Ending string quote not found."
+    '"'  : b     -> ("", b)
+    '\\' : a : b -> (a : a', b') where (a', b') = string b
+    a : b        -> (a : a', b') where (a', b') = string b
+
+decomment :: String -> String
+decomment = decomment' 0
+  where
+  decomment' :: Int -> String -> String
+  decomment' n "" | n == 0    = ""
+                  | otherwise = error "reached end of file without closing comment"
+  decomment' n ('(':'*':a) = "  " ++ decomment' (n + 1) a
+  decomment' n ('*':')':a) | n > 0  = "  " ++ decomment' (n - 1) a
+                           | otherwise = error "unexpected closing comment"
+  decomment' n (a:b) = (if n > 0 && a /= '\n' then ' ' else a) : decomment' n b
+
+
+
+-- Parsing.
+
+parseRhapsody :: String -> Record
+parseRhapsody a = case runParser (record `discard` eof) $ lexer a of
+  (Left msg, remaining) -> error $ msg ++ "\nremaining tokens: " ++ show (take 30 $ remaining) ++ " ..."
+  (Right a, []) -> a
+  (Right _, remaining) -> error $ "parsed, but with remaining tokens: " ++ show remaining
+
+type Rhap a = Parser Token a
+
+tok :: Token -> Rhap ()
+tok a = satisfy (== a) >> return ()
+
+string :: Rhap String
+string = do
+  a <- satisfy (\ a -> case a of { String _ -> True; _ -> False })
+  case a of
+    String s -> return s
+    _ -> undefined
+
+record :: Rhap Record
+record = do { tok BraceLeft; name <- string; fields <- many field; tok BraceRight; return $ Record name fields }
+
+field :: Rhap Field
+field = oneOf
+  [ do { tok Dash; name <- string; tok Eq; v <- many string; tok SemiColon; return $ Value name v }
+  , do { tok Dash; name <- string; tok Eq; r <- many record; return $ RecordNamed name r }
+  , do { r <- record; return $ RecordAnon r }
+  ]
+
diff --git a/src/Statechart.hs b/src/Statechart.hs
new file mode 100644
--- /dev/null
+++ b/src/Statechart.hs
@@ -0,0 +1,51 @@
+module Main (main) where
+
+import System.Environment
+
+import Code
+import Model
+import Rhapsody
+
+main :: IO ()
+main = do
+  args <- getArgs
+  case parseArgs args of
+    Nothing -> help
+    Just (o, inc, sbs) -> readFile sbs >>= genCode o inc . parseModel . parseRhapsody
+
+parseArgs :: [String] -> Maybe (String, [String], String)
+parseArgs a = case a of
+  [a] | head a /= '-' -> Just (takeWhile (/= '.') a ++ ".c", [], a)
+  "-o" : file : rest -> do
+    (_, inc, sbs) <- parseArgs rest
+    Just (file, inc, sbs)
+  "-i" : file : rest -> do
+    (o, inc, sbs) <- parseArgs rest
+    Just (o, file : inc, sbs)
+  _ -> Nothing
+
+help :: IO ()
+help = putStrLn $ unlines
+  [ ""
+  , "NAME"
+  , "  statechart - statechart code generation"
+  , ""
+  , "SYNOPSIS"
+  , "  statechart [ -o <output-name> | { -i <header-file> } ] <rhapsody-package-file>"
+  , ""
+  , "DESCRIPTION"
+  , "  Compiles Rhapsody statecharts to C.  Each Rhapsody class will generate a function"
+  , "  that computes the next transition for each of its associated statecharts."
+  , ""
+  , "OPTIONS"
+  , "  -o <name>"
+  , "    Output name.  Creates both <name>.c and <name>.h."
+  , ""
+  , "  -i <file>"
+  , "    Header file to include in the generated code."
+  , ""
+  , "LIMITATIONS"
+  , "  TODO, enough to say, a bunch."
+  , ""
+  ]
+
diff --git a/statechart.cabal b/statechart.cabal
new file mode 100644
--- /dev/null
+++ b/statechart.cabal
@@ -0,0 +1,44 @@
+name:    statechart
+version: 0.0.0
+
+category: Compiler
+
+synopsis: Compiles Rhapsody statecharts to C.
+
+description:
+  TODO
+
+author:     Tom Hawkins <tomahawkins@gmail.com>
+maintainer: Tom Hawkins <tomahawkins@gmail.com>
+
+license:      BSD3
+license-file: LICENSE
+
+homepage: http://tomahawkins.org
+
+build-type:    Simple
+cabal-version: >= 1.6
+
+extra-source-files:
+
+executable statechart
+  hs-source-dirs: src
+
+  main-is: Statechart.hs
+
+  other-modules:
+    Code,
+    Model,
+    Rhapsody
+
+  build-depends:
+    base       >= 4.0 && < 5.0,
+    polyparse  >= 1.4
+
+  ghc-options:  -W
+  extensions:
+
+source-repository head
+  type:     git
+  location: git://github.com/tomahawkins/statechart.git
+