tools/pas2c.hs
changeset 6886 4463ee51c9ec
parent 6883 70aec33185e2
child 6887 19d77932ea91
equal deleted inserted replaced
6885:53a87a4c7b35 6886:4463ee51c9ec
   365 initExpr2C (InitString s) = return $ braces $ text ".s = " <> doubleQuotes (text s)
   365 initExpr2C (InitString s) = return $ braces $ text ".s = " <> doubleQuotes (text s)
   366 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
   366 initExpr2C (InitChar a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
   367 initExpr2C (InitReference i) = id2C IOLookup i
   367 initExpr2C (InitReference i) = id2C IOLookup i
   368 initExpr2C (InitRecord fields) = do
   368 initExpr2C (InitRecord fields) = do
   369     (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
   369     (fs :: [Doc]) <- mapM (\(Identifier a _, b) -> liftM (text "." <> text a <+> equals <+>) $ initExpr2C b) fields
   370     return $ lbrace $+$ (nest 4 . vcat $ fs) $+$ rbrace
   370     return $ lbrace $+$ (nest 4 . vcat . punctuate comma $ fs) $+$ rbrace
   371 initExpr2C (InitArray [value]) = initExpr2C value
   371 initExpr2C (InitArray [value]) = initExpr2C value
   372 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
   372 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
   373 initExpr2C (InitRange (Range i)) = id2C IOLookup i
   373 initExpr2C (InitRange (Range i)) = id2C IOLookup i
   374 initExpr2C (InitRange (RangeFromTo (InitNumber "0") (InitNumber a))) = return . text $ show (read a + 1)
   374 initExpr2C (InitRange (RangeFromTo (InitNumber "0") (InitNumber a))) = return . text $ show (read a + 1)
   375 initExpr2C (InitRange a) = return $ text "<<range>>"
   375 initExpr2C (InitRange a) = return $ text "<<range>>"
   397     type2C' (String l) = return (text ("string" ++ show l) <+>)
   397     type2C' (String l) = return (text ("string" ++ show l) <+>)
   398     type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i
   398     type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i
   399     type2C' (PointerTo t) = liftM (\t a -> t (text "*" <> a)) $ type2C t
   399     type2C' (PointerTo t) = liftM (\t a -> t (text "*" <> a)) $ type2C t
   400     type2C' (RecordType tvs union) = do
   400     type2C' (RecordType tvs union) = do
   401         t <- withState' id $ mapM (tvar2C False) tvs
   401         t <- withState' id $ mapM (tvar2C False) tvs
   402         return $ \i -> text "struct" <+> lbrace $+$ (nest 4 . vcat . map (<> semi) . concat $ t) $+$ rbrace <+> i
   402         u <- unions
       
   403         return $ \i -> text "struct" <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
       
   404         where
       
   405             unions = case union of
       
   406                      Nothing -> return empty
       
   407                      Just a -> do
       
   408                          structs <- mapM struct2C a
       
   409                          return $ text "union" $+$ braces (nest 4 $ vcat structs) <> semi
       
   410             struct2C tvs = do
       
   411                 t <- withState' id $ mapM (tvar2C False) tvs
       
   412                 return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ t)) <> semi
   403     type2C' (RangeType r) = return (text "<<range type>>" <+>)
   413     type2C' (RangeType r) = return (text "<<range type>>" <+>)
   404     type2C' (Sequence ids) = do
   414     type2C' (Sequence ids) = do
   405         is <- mapM (id2C IOInsert . setBaseType bt) ids
   415         is <- mapM (id2C IOInsert . setBaseType bt) ids
   406         return (text "enum" <+> (braces . vcat . punctuate comma . map (\(a, b) -> a <+> equals <+> text "0x" <> text (showHex b "")) $ zip is (iterate (*2) 1)) <+>)
   416         return (text "enum" <+> (braces . vcat . punctuate comma . map (\(a, b) -> a <+> equals <+> text "0x" <> text (showHex b "")) $ zip is (iterate (*2) 1)) <+>)
   407         where
   417         where