tools/pas2c.hs
author unc0rr
Wed, 07 Dec 2011 08:01:18 +0300
changeset 6512 0df7f6697939
parent 6511 bc6e67598dde
child 6514 8ba891d34eba
permissions -rw-r--r--
"System" unit to help converter
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
6511
bc6e67598dde Ok, State monad instead
unc0rr
parents: 6509
diff changeset
     6
import Text.Parsec.Prim hiding (State)
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
     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
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    15
import Data.List (find)
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
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    20
type RenderState = [(String, String)]
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    21
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
    22
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
    23
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
    24
    setCurrentDirectory "../hedgewars/"
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    25
    s <- flip execStateT initState $ f fn
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    26
    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
    27
    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
    28
    printLn = liftIO . hPutStrLn stderr
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    29
    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
    30
    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
    31
    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
    32
    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
    33
        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
    34
        unless processed $ do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    35
            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
    36
            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
    37
                $ tryJust (guard . isDoesNotExistError) 
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    38
                $ 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
    39
            case fc' of
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6450
diff changeset
    40
                (Left a) -> do
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    41
                    modify (Map.insert fileName (System []))
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6450
diff changeset
    42
                    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
    43
                (Right fc) -> do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    44
                    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
    45
                    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
    46
                    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
    47
                         (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
    48
                            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
    49
                            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
    50
                            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
    51
                         (Right a) -> do
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    52
                            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
    53
                            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
    54
                            mapM_ f (usesFiles a)
6455
d2b13364eddd More verbose progress log, dump the result
unc0rr
parents: 6453
diff changeset
    55
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    56
toCFiles :: (String, PascalUnit) -> IO ()
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    57
toCFiles (_, System _) = return ()
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    58
toCFiles p@(fn, pu) = do
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    59
    hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..."
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    60
    toCFiles' p
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    61
    where
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    62
    toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C . pascal2C) p
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
    63
    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
    64
        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
    65
        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
    66
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    67
render2C = render . flip evalState []
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    68
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    69
usesFiles :: PascalUnit -> [String]
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    70
usesFiles (Program _ (Implementation uses _) _) = "pas2cSystem" : uses2List uses
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    71
usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = "pas2cSystem" : uses2List uses1 ++ uses2List uses2
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    72
usesFiles (System {}) = []
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
    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
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    75
pascal2C :: PascalUnit -> State RenderState Doc
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 (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
    77
    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
    78
    
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
    79
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
    80
    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
    81
    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
    82
        (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
    83
    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
    84
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    85
    
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
    86
    
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    87
interface2C :: Interface -> State RenderState Doc
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 uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    89
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    90
implementation2C :: Implementation -> State RenderState Doc
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 uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    92
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    93
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    94
typesAndVars2C :: Bool -> TypesAndVars -> State RenderState Doc
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 b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
    96
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
    97
uses2C :: Uses -> State RenderState Doc
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 = 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
    99
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
uses2List :: Uses -> [String]
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   101
uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   102
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   103
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   104
id2C :: Bool -> Identifier -> State RenderState Doc
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   105
id2C True (Identifier i _) = do
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   106
    modify (\s -> (map toLower i, i) : s)
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   107
    return $ text i
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   108
id2C False (Identifier i _) = do
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   109
    let i' = map toLower i
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   110
    v <- gets $ find (\(a, _) -> a == i')
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   111
    if isNothing v then 
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   112
        error $ "Not defined: " ++ i' 
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   113
        else 
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   114
        return . text . snd . fromJust $ v
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   115
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   116
    
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   117
tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   118
tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   119
    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
   120
    p <- liftM hcat $ mapM (tvar2C False) params
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   121
    n <- id2C True name
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   122
    return $ t <+> n <> parens p <> text ";"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   123
tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   124
    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
   125
    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
   126
    ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   127
    n <- id2C True name
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   128
    return $ 
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   129
        t <+> n <> 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
   130
        $+$
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   131
        text "{" 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   132
        $+$ 
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   133
        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
   134
        $+$
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   135
        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
   136
    where
6499
33180b479efa Start converting into monadic code using Reader monad (will be used to store information about namespace)
unc0rr
parents: 6489
diff changeset
   137
    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
   138
    phrase2C' p = phrase2C p
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   139
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
   140
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
   141
    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
   142
    return $ text "type" <+> text i <+> tp <> text ";"
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   143
tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   144
    t' <- type2C t
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   145
    i <- mapM (id2C True) ids
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   146
    ie <- initExpr mInitExpr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   147
    return $ if isConst then text "const" else empty
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   148
        <+> t'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   149
        <+> (hsep . punctuate (char ',') $ i)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   150
        <+> ie
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   151
        <> text ";"
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   152
    where
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   153
    initExpr Nothing = return $ empty
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   154
    initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)
6474
42e9773eedfd - Improve renderer a bit, disallow nested functions
unc0rr
parents: 6467
diff changeset
   155
tvar2C f (OperatorDeclaration op _ ret params body) = 
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6474
diff changeset
   156
    tvar2C f (FunctionDeclaration (Identifier ("<op " ++ op ++ ">") Unknown) ret params body)
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   157
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   158
initExpr2C :: InitExpression -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   159
initExpr2C (InitBinOp op expr1 expr2) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   160
    e1 <- initExpr2C expr1
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   161
    e2 <- initExpr2C expr2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   162
    o <- op2C op
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   163
    return $ parens $ e1 <+> o <+> e2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   164
initExpr2C (InitNumber s) = return $ text s
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   165
initExpr2C (InitFloat s) = return $ text s
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   166
initExpr2C (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   167
initExpr2C (InitString s) = return $ doubleQuotes $ text s 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   168
initExpr2C (InitReference i) = id2C False i
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   169
initExpr2C _ = return $ text "<<expression>>"
6391
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   170
bd5851ab3157 - Parse sets initialization
unc0rr
parents: 6355
diff changeset
   171
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   172
type2C :: TypeDecl -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   173
type2C UnknownType = return $ text "void"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   174
type2C (String l) = return $ text $ "string" ++ show l
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   175
type2C (SimpleType i) = id2C True i
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   176
type2C (PointerTo t) = liftM (<> text "*") $ type2C t
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   177
type2C (RecordType tvs union) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   178
    t <- mapM (tvar2C False) tvs
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   179
    return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   180
type2C (RangeType r) = return $ text "<<range type>>"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   181
type2C (Sequence ids) = return $ text "<<sequence type>>"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   182
type2C (ArrayDecl r t) = return $ text "<<array type>>"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   183
type2C (Set t) = return $ text "<<set>>"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   184
type2C (FunctionType returnType params) = return $ text "<<function>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   185
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   186
phrase2C :: Phrase -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   187
phrase2C (Phrases p) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   188
    ps <- mapM phrase2C p
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   189
    return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   190
phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   191
phrase2C (ProcCall ref params) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   192
    r <- ref2C ref
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   193
    ps <- mapM expr2C params
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   194
    return $ r <> parens (hsep . punctuate (char ',') $ ps) <> semi
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   195
phrase2C (IfThenElse (expr) phrase1 mphrase2) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   196
    e <- expr2C expr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   197
    p1 <- (phrase2C . wrapPhrase) phrase1
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   198
    el <- elsePart
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   199
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   200
        text "if" <> parens e $+$ p1 $+$ el
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   201
    where
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   202
    elsePart | isNothing mphrase2 = return $ empty
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   203
             | otherwise = liftM (text "else" $$) $ (phrase2C . wrapPhrase) (fromJust mphrase2)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   204
phrase2C (Assignment ref expr) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   205
    r <- ref2C ref 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   206
    e <- expr2C expr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   207
    return $
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   208
        r <> text " = " <> e <> semi
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   209
phrase2C (WhileCycle expr phrase) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   210
    e <- expr2C expr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   211
    p <- phrase2C $ wrapPhrase phrase
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   212
    return $ text "while" <> parens e $$ p
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   213
phrase2C (SwitchCase expr cases mphrase) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   214
    e <- expr2C expr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   215
    cs <- mapM case2C cases
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   216
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   217
        text "switch" <> parens e <> text "of" $+$ (nest 4 . vcat) cs
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   218
    where
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   219
    case2C :: ([InitExpression], Phrase) -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   220
    case2C (e, p) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   221
        ie <- mapM initExpr2C e
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   222
        ph <- phrase2C p
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   223
        return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   224
            text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;")
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   225
phrase2C (WithBlock ref p) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   226
    r <- ref2C ref 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   227
    ph <- phrase2C $ wrapPhrase p
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   228
    return $ text "namespace" <> parens r $$ ph
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   229
phrase2C (ForCycle i' e1' e2' p) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   230
    i <- id2C False i'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   231
    e1 <- expr2C e1'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   232
    e2 <- expr2C e2'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   233
    ph <- phrase2C (wrapPhrase p)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   234
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   235
        text "for" <> (parens . hsep . punctuate (char ';') $ [i <+> text "=" <+> e1, i <+> text "<=" <+> e2, text "++" <> i])
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   236
        $$
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   237
        ph
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   238
phrase2C (RepeatCycle e' p') = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   239
    e <- expr2C e'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   240
    p <- phrase2C (Phrases p')
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   241
    return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   242
phrase2C NOP = return $ text ";"
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   243
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   244
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   245
wrapPhrase p@(Phrases _) = p
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   246
wrapPhrase p = Phrases [p]
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   247
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   248
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   249
expr2C :: Expression -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   250
expr2C (Expression s) = return $ text s
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   251
expr2C (BinOp op expr1 expr2) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   252
    e1 <- expr2C expr1
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   253
    e2 <- expr2C expr2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   254
    o <- op2C op
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   255
    return $ parens $ e1 <+> o <+> e2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   256
expr2C (NumberLiteral s) = return $ text s
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   257
expr2C (FloatLiteral s) = return $ text s
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   258
expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   259
expr2C (StringLiteral s) = return $ doubleQuotes $ text s 
6277
627b5752733a A try to improve parser move (has regressions)
unc0rr
parents: 6275
diff changeset
   260
expr2C (Reference ref) = ref2C ref
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   261
expr2C (PrefixOp op expr) = liftM2 (<+>) (op2C op) (expr2C expr)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   262
expr2C Null = return $ text "NULL"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   263
expr2C (BuiltInFunCall params ref) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   264
    r <- ref2C ref 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   265
    ps <- mapM expr2C params
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   266
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   267
        r <> parens (hsep . punctuate (char ',') $ ps)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   268
expr2C _ = return $ text "<<expression>>"
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   269
6307
25cfd9f4a567 Even more improvements to the parser and converter
unc0rr
parents: 6277
diff changeset
   270
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   271
ref2C :: Reference -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   272
ref2C (ArrayElement exprs ref) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   273
    r <- ref2C ref 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   274
    es <- mapM expr2C exprs
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   275
    return $ r <> (brackets . hcat) (punctuate comma es)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   276
ref2C (SimpleReference name) = id2C False name
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   277
ref2C (RecordField (Dereference ref1) ref2) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   278
    r1 <- ref2C ref1 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   279
    r2 <- ref2C ref2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   280
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   281
        r1 <> text "->" <> r2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   282
ref2C (RecordField ref1 ref2) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   283
    r1 <- ref2C ref1 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   284
    r2 <- ref2C ref2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   285
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   286
        r1 <> text "." <> r2
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   287
ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   288
ref2C (FunCall params ref) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   289
    r <- ref2C ref
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   290
    ps <- mapM expr2C params
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   291
    return $ 
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   292
        r <> parens (hsep . punctuate (char ',') $ ps)
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   293
ref2C (Address ref) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   294
    r <- ref2C ref
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   295
    return $ text "&" <> parens r
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   296
ref2C (TypeCast t' expr) = do
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   297
    t <- id2C False t'
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   298
    e <- expr2C expr
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   299
    return $ parens t <> e
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents: 6455
diff changeset
   300
ref2C (RefExpression expr) = expr2C expr
6355
734fed7aefd3 Introduce initialization expressions
unc0rr
parents: 6317
diff changeset
   301
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   302
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6511
diff changeset
   303
op2C :: String -> State RenderState Doc
6509
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   304
op2C "or" = return $ text "|"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   305
op2C "and" = return $ text "&"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   306
op2C "not" = return $ text "!"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   307
op2C "xor" = return $ text "^"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   308
op2C "div" = return $ text "/"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   309
op2C "mod" = return $ text "%"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   310
op2C "shl" = return $ text "<<"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   311
op2C "shr" = return $ text ">>"
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   312
op2C "<>" = return $ text "!="
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   313
op2C "=" = return $ text "=="
648caa66991b Convert into Reader monad
unc0rr
parents: 6499
diff changeset
   314
op2C a = return $ text a
6273
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   315
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   316
maybeVoid "" = "void"
13262c6e5027 Starting pas2C using library called 'pretty'
unc0rr
parents:
diff changeset
   317
maybeVoid a = a