diff -r 572571ea945e -r daaf0834c4d2 tools/pas2c.hs --- a/tools/pas2c.hs Sat Mar 24 21:19:50 2012 +0400 +++ b/tools/pas2c.hs Sun Mar 25 23:10:29 2012 +0400 @@ -27,6 +27,7 @@ data RenderState = RenderState { currentScope :: [Record], + lastIdentifier :: String, lastType :: BaseType, namespaces :: Map.Map String [Record] } @@ -74,12 +75,19 @@ where toNamespace :: Map.Map String [Record] -> PascalUnit -> [Record] toNamespace nss (System tvs) = - currentScope $ execState (mapM_ (tvar2C True) tvs) (RenderState [] BTUnknown nss) + currentScope $ execState (mapM_ (tvar2C True) tvs) (RenderState [] "" BTUnknown nss) toNamespace _ (Program {}) = [] toNamespace nss (Unit _ interface _ _ _) = - currentScope $ execState (interface2C interface) (RenderState [] BTUnknown nss) + currentScope $ execState (interface2C interface) (RenderState [] "" BTUnknown nss) +withLastIdNamespace :: State RenderState Doc -> State RenderState Doc +withLastIdNamespace f = do + li <- gets lastIdentifier + nss <- gets namespaces + st <- gets id + return $ evalState f st{currentScope = fromMaybe [] $ Map.lookup li (namespaces st)} + toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO () toCFiles _ (_, System _) = return () toCFiles ns p@(fn, pu) = do @@ -91,7 +99,7 @@ let (a, s) = runState (interface2C interface) initialState writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render a) writeFile (fn ++ ".c") $ (render2C s . implementation2C) implementation - initialState = RenderState [] BTUnknown ns + initialState = RenderState [] "" BTUnknown ns render2C :: RenderState -> State RenderState Doc -> String render2C a = render . flip evalState a @@ -153,7 +161,7 @@ if isNothing v then error $ "Not defined: '" ++ i' ++ "'\n" -- ++ show ns else - let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv}) >> (return . text . fst $ vv) + let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv) id2C IODeferred (Identifier i t) = do let i' = map toLower i v <- gets $ find (\(a, _) -> a == i') . currentScope @@ -385,12 +393,10 @@ ref2C rf@(RecordField ref1 ref2) = do r1 <- ref2C ref1 t <- gets lastType - ns <- gets currentScope - case t of + r2 <- case t of r@(BTRecord _) -> error $ show r - r@(BTUnit) -> error $ show r + r@(BTUnit) -> withLastIdNamespace $ ref2C ref2 a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf - r2 <- ref2C ref2 return $ r1 <> text "." <> r2 ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref