tools/pas2c.hs
author unc0rr
Mon, 05 Dec 2011 17:56:49 +0400
changeset 6499 33180b479efa
parent 6489 e1f0058cfedd
child 6509 648caa66991b
permissions -rw-r--r--
Start converting into monadic code using Reader monad (will be used to store information about namespace)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     1
module Pas2C where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     2
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     3
import Text.PrettyPrint.HughesPJ
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
     4
import Data.Maybe
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
     5
import Data.Char
6417
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
     6
import Text.Parsec.Prim
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
     7
import Control.Monad.State
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
     8
import System.IO
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
     9
import System.Directory
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    10
import Control.Monad.IO.Class
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    11
import PascalPreprocessor
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    12
import Control.Exception
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    13
import System.IO.Error
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    14
import qualified Data.Map as Map
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    15
import Control.Monad.Reader
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    16
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    17
import PascalParser
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    18
import PascalUnitSyntaxTree
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    19
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    20
pas2C :: String -> IO ()
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    21
pas2C fn = do
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    22
    setCurrentDirectory "../hedgewars/"
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    23
    s <- flip execStateT initState $ f fn
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    24
    mapM_ toCFiles (Map.toList s)
6417
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    25
    where
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    26
    printLn = liftIO . hPutStrLn stderr
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    27
    print = liftIO . hPutStr stderr
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    28
    initState = Map.empty
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    29
    f :: String -> StateT (Map.Map String PascalUnit) IO ()
6417
eae5900fd8a4 Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
unc0rr
parents: 6399
diff changeset
    30
    f fileName = do
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    31
        processed <- gets $ Map.member fileName
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    32
        unless processed $ do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    33
            print ("Preprocessing '" ++ fileName ++ ".pas'... ")
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    34
            fc' <- liftIO 
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    35
                $ tryJust (guard . isDoesNotExistError) 
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    36
                $ preprocess (fileName ++ ".pas")
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    37
            case fc' of
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6450
diff changeset
    38
                (Left a) -> do
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6450
diff changeset
    39
                    modify (Map.insert fileName System)
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6450
diff changeset
    40
                    printLn "doesn't exist"
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    41
                (Right fc) -> do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    42
                    print "ok, parsing... "
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    43
                    let ptree = parse pascalUnit fileName fc
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    44
                    case ptree of
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    45
                         (Left a) -> do
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    46
                            liftIO $ writeFile "preprocess.out" fc
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    47
                            printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    48
                            fail "stop"
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    49
                         (Right a) -> do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    50
                            printLn "ok"
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    51
                            modify (Map.insert fileName a)
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    52
                            mapM_ f (usesFiles a)
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    53
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    54
toCFiles :: (String, PascalUnit) -> IO ()
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    55
toCFiles (_, System) = return ()
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    56
toCFiles p@(fn, pu) = do
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    57
    hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..."
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    58
    toCFiles' p
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    59
    where
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    60
    toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C . pascal2C) p
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    61
    toCFiles' (fn, (Unit _ interface implementation _ _)) = do
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    62
        writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render2C . interface2C $ interface)
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    63
        writeFile (fn ++ ".c") $ (render2C . implementation2C) implementation
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    64
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    65
system :: [(String, String)]
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    66
system = []
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    67
        
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    68
render2C = render . flip runReader system
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    69
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    70
usesFiles :: PascalUnit -> [String]
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    71
usesFiles (Program _ (Implementation uses _) _) = uses2List uses
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    72
usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = uses2List uses1 ++ uses2List uses2
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    73
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    74
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
    75
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    76
pascal2C :: PascalUnit -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    77
pascal2C (Unit _ interface implementation init fin) =
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    78
    liftM2 ($+$) (interface2C interface) (implementation2C implementation)
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    79
    
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    80
pascal2C (Program _ implementation mainFunction) = do
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    81
    impl <- implementation2C implementation
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    82
    main <- tvar2C True 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    83
        (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction)))
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    84
    return $ impl $+$ main
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    85
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    86
    
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    87
    
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    88
interface2C :: Interface -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    89
interface2C (Interface uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    90
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    91
implementation2C :: Implementation -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    92
implementation2C (Implementation uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    93
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    94
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    95
typesAndVars2C :: Bool -> TypesAndVars -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    96
typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    97
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    98
uses2C :: Uses -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    99
uses2C uses = return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
   100
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
   101
uses2List :: Uses -> [String]
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   102
uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   103
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   104
tvar2C :: Bool -> TypeVarDeclaration -> Reader a Doc
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   105
tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) = do
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   106
    t <- type2C returnType 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   107
    p <- liftM hcat $ mapM (tvar2C False) params
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   108
    return $ t <+> text name <> parens p <> text ";"
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   109
tvar2C True (FunctionDeclaration (Identifier name _) returnType params (Just (tvars, phrase))) = do
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   110
    t <- type2C returnType 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   111
    p <- liftM hcat $ mapM (tvar2C False) params
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   112
    ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   113
    return $ 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   114
        t <+> text name <> parens p
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
   115
        $+$
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   116
        text "{" 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   117
        $+$ 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   118
        nest 4 ph
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   119
        $+$
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   120
        text "}"
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
   121
    where
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   122
    phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6417
diff changeset
   123
    phrase2C' p = phrase2C p
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   124
tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   125
tvar2C _ (TypeDeclaration (Identifier i _) t) = do
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   126
    tp <- type2C t
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   127
    return $ text "type" <+> text i <+> tp <> text ";"
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
   128
tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = 
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   129
    if isConst then text "const" else empty
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   130
    <+>
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   131
    type2C t
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   132
    <+>
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   133
    (hsep . punctuate (char ',') . map (\(Identifier i _) -> text i) $ ids)
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   134
    <+>
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   135
    initExpr mInitExpr
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   136
    <>
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   137
    text ";"
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   138
    where
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   139
    initExpr Nothing = empty
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   140
    initExpr (Just e) = text "=" <+> initExpr2C e
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
   141
tvar2C f (OperatorDeclaration op _ ret params body) = 
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   142
    tvar2C f (FunctionDeclaration (Identifier ("<op " ++ op ++ ">") Unknown) ret params body)
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   143
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   144
initExpr2C :: InitExpression -> Reader a Doc
6391
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   145
initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2)
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   146
initExpr2C (InitNumber s) = text s
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   147
initExpr2C (InitFloat s) = text s
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   148
initExpr2C (InitHexNumber s) = text "0x" <> (text . map toLower $ s)
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   149
initExpr2C (InitString s) = doubleQuotes $ text s 
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   150
initExpr2C (InitReference (Identifier i _)) = text i
6391
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   151
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   152
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   153
initExpr2C _ = text "<<expression>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   154
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   155
type2C :: TypeDecl -> Reader a Doc
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   156
type2C UnknownType = text "void"
6399
a904c735979c Improve parser and converter
unc0rr
parents: 6391
diff changeset
   157
type2C (String l) = text $ "string" ++ show l
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   158
type2C (SimpleType (Identifier i _)) = text i
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   159
type2C (PointerTo t) = type2C t <> text "*"
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
   160
type2C (RecordType tvs union) = text "{" $+$ (nest 4 . vcat . map (tvar2C False) $ tvs) $+$ text "}"
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   161
type2C (RangeType r) = text "<<range type>>"
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   162
type2C (Sequence ids) = text "<<sequence type>>"
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   163
type2C (ArrayDecl r t) = text "<<array type>>"
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   164
type2C (Set t) = text "<<set>>"
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   165
type2C (FunctionType returnType params) = text "<<function>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   166
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   167
phrase2C :: Phrase -> Reader a Doc
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   168
phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   169
phrase2C (ProcCall f@(FunCall {}) []) = ref2C f <> semi
6450
14224c9b4594 - Improvement to the parser
unc0rr
parents: 6425
diff changeset
   170
phrase2C (ProcCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   171
phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $+$ (phrase2C . wrapPhrase) phrase1 $+$ elsePart
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   172
    where
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   173
    elsePart | isNothing mphrase2 = empty
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   174
             | otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2)
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   175
phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   176
phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase)
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   177
phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   178
    where
6450
14224c9b4594 - Improvement to the parser
unc0rr
parents: 6425
diff changeset
   179
    case2C :: ([InitExpression], Phrase) -> Doc
14224c9b4594 - Improvement to the parser
unc0rr
parents: 6425
diff changeset
   180
    case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map initExpr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   181
phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p)
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   182
phrase2C (ForCycle (Identifier i _) e1 e2 p) = 
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   183
    text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i])
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   184
    $$
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   185
    phrase2C (wrapPhrase p)
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   186
phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e))
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   187
phrase2C NOP = text ";"
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   188
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   189
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   190
wrapPhrase p@(Phrases _) = p
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   191
wrapPhrase p = Phrases [p]
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   192
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   193
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   194
expr2C :: Expression -> Reader a Doc
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   195
expr2C (Expression s) = text s
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   196
expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   197
expr2C (NumberLiteral s) = text s
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   198
expr2C (FloatLiteral s) = text s
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   199
expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s)
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   200
expr2C (StringLiteral s) = doubleQuotes $ text s 
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   201
expr2C (Reference ref) = ref2C ref
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   202
expr2C (PrefixOp op expr) = op2C op <+> expr2C expr
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   203
expr2C Null = text "NULL"
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   204
expr2C (BuiltInFunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   205
expr2C _ = text "<<expression>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   206
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   207
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   208
ref2C :: Reference -> Reader a Doc
6317
83b93a2d2741 Improve parsing of complex references like "a^[b[c], d]"
unc0rr
parents: 6307
diff changeset
   209
ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs)
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   210
ref2C (SimpleReference (Identifier name _)) = text name
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   211
ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   212
ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   213
ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
6317
83b93a2d2741 Improve parsing of complex references like "a^[b[c], d]"
unc0rr
parents: 6307
diff changeset
   214
ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   215
ref2C (Address ref) = text "&" <> parens (ref2C ref)
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   216
ref2C (TypeCast (Identifier t _) expr) = parens (text t) <> expr2C expr
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   217
ref2C (RefExpression expr) = expr2C expr
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   218
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   219
op2C "or" = text "|"
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   220
op2C "and" = text "&"
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   221
op2C "not" = text "!"
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   222
op2C "xor" = text "^"
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   223
op2C "div" = text "/"
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   224
op2C "mod" = text "%"
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   225
op2C "shl" = text "<<"
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   226
op2C "shr" = text ">>"
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   227
op2C "<>" = text "!="
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   228
op2C "=" = text "=="
6275
f1b4f37dba22 Many improvements to the parser
unc0rr
parents: 6274
diff changeset
   229
op2C a = text a
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   230
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   231
maybeVoid "" = "void"
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   232
maybeVoid a = a