equal
deleted
inserted
replaced
122 |
122 |
123 |
123 |
124 typesAndVars2C :: Bool -> TypesAndVars -> State RenderState Doc |
124 typesAndVars2C :: Bool -> TypesAndVars -> State RenderState Doc |
125 typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts |
125 typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts |
126 |
126 |
|
127 setBaseType :: BaseType -> Identifier -> Identifier |
|
128 setBaseType bt (Identifier i _) = Identifier i bt |
|
129 |
127 uses2C :: Uses -> State RenderState Doc |
130 uses2C :: Uses -> State RenderState Doc |
128 uses2C uses@(Uses unitIds) = do |
131 uses2C uses@(Uses unitIds) = do |
129 mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds) |
132 mapM_ injectNamespace (Identifier "pas2cSystem" undefined : unitIds) |
130 mapM_ (id2C IOInsert) unitIds |
133 mapM_ (id2C IOInsert . setBaseType BTUnit) unitIds |
131 return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses |
134 return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses |
132 where |
135 where |
133 injectNamespace (Identifier i _) = do |
136 injectNamespace (Identifier i _) = do |
134 getNS <- gets (flip Map.lookup . namespaces) |
137 getNS <- gets (flip Map.lookup . namespaces) |
135 let f = flip (foldl (\a b -> b:a)) (fromMaybe [] (getNS i)) |
138 let f = flip (foldl (\a b -> b:a)) (fromMaybe [] (getNS i)) |
145 return $ text i |
148 return $ text i |
146 id2C IOLookup (Identifier i t) = do |
149 id2C IOLookup (Identifier i t) = do |
147 let i' = map toLower i |
150 let i' = map toLower i |
148 v <- gets $ find (\(a, _) -> a == i') . currentScope |
151 v <- gets $ find (\(a, _) -> a == i') . currentScope |
149 ns <- gets currentScope |
152 ns <- gets currentScope |
150 modify (\s -> s{lastType = t}) |
|
151 if isNothing v then |
153 if isNothing v then |
152 error $ "Not defined: '" ++ i' ++ "'\n" -- ++ show ns |
154 error $ "Not defined: '" ++ i' ++ "'\n" -- ++ show ns |
153 else |
155 else |
154 return . text . fst . snd . fromJust $ v |
156 let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv}) >> (return . text . fst $ vv) |
155 id2C IODeferred (Identifier i t) = do |
157 id2C IODeferred (Identifier i t) = do |
156 let i' = map toLower i |
158 let i' = map toLower i |
157 v <- gets $ find (\(a, _) -> a == i') . currentScope |
159 v <- gets $ find (\(a, _) -> a == i') . currentScope |
158 if (isNothing v) then |
160 if (isNothing v) then |
159 do |
161 do |
381 return $ |
383 return $ |
382 r1 <> text "->" <> r2 |
384 r1 <> text "->" <> r2 |
383 ref2C rf@(RecordField ref1 ref2) = do |
385 ref2C rf@(RecordField ref1 ref2) = do |
384 r1 <- ref2C ref1 |
386 r1 <- ref2C ref1 |
385 t <- gets lastType |
387 t <- gets lastType |
|
388 ns <- gets currentScope |
386 case t of |
389 case t of |
387 r@(BTRecord _) -> error $ show r |
390 r@(BTRecord _) -> error $ show r |
|
391 r@(BTUnit) -> error $ show r |
388 a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf |
392 a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf |
389 r2 <- ref2C ref2 |
393 r2 <- ref2C ref2 |
390 return $ |
394 return $ |
391 r1 <> text "." <> r2 |
395 r1 <> text "." <> r2 |
392 ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref |
396 ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref |