tools/pas2c/Pas2C.hs
branchui-scaling
changeset 15283 c4fd2813b127
parent 14357 3baee596a989
child 15750 036263d63b05
--- a/tools/pas2c/Pas2C.hs	Wed May 16 18:22:28 2018 +0200
+++ b/tools/pas2c/Pas2C.hs	Wed Jul 31 23:14:27 2019 +0200
@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Pas2C where
 
+import Prelude hiding ((<>))
 import Text.PrettyPrint.HughesPJ
 import Data.Maybe
 import Data.Char
@@ -185,6 +186,7 @@
 toCFiles _ _ (_, Redo _) = return ()
 toCFiles outputPath ns pu@(fileName, _) = do
     hPutStrLn stdout $ "Rendering '" ++ fileName ++ "'..."
+    --let (fn, p) = pu in writeFile (outputPath ++ fn ++ ".dump") $ show p
     toCFiles' pu
     where
     toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
@@ -237,7 +239,7 @@
 
 pascal2C (Program _ implementation mainFunction) = do
     impl <- implementation2C implementation
-    [main] <- tvar2C True False True True 
+    main <- liftM head $ tvar2C True False True True
         (FunctionDeclaration (Identifier "main" (BTInt True)) False False False (SimpleType $ Identifier "int" (BTInt True)) 
             [VarDeclaration False False ([Identifier "argc" (BTInt True)], SimpleType (Identifier "Integer" (BTInt True))) Nothing
             , VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] 
@@ -697,12 +699,16 @@
          (Identifier "LongInt" _) -> int (-2^31)
          (Identifier "SmallInt" _) -> int (-2^15)
          _ -> error $ "BuiltInFunction 'low': " ++ show e
-initExpr2C' (BuiltInFunction "high" [e]) = do
+initExpr2C' hi@(BuiltInFunction "high" [e@(InitReference e')]) = do
     void $ initExpr2C e
     t <- gets lastType
     case t of
          (BTArray i _ _) -> initExpr2C' $ BuiltInFunction "pred" [InitRange i]
-         a -> error $ "BuiltInFunction 'high': " ++ show a
+         BTInt _ -> case e' of
+                  (Identifier "LongInt" _) -> return $ int (2147483647)
+                  (Identifier "LongWord" _) -> return $ text "4294967295"
+                  _ -> error $ "BuiltInFunction 'high' in initExpr: " ++ show e'
+         a -> error $ "BuiltInFunction 'high' in initExpr: " ++ show a ++ ": " ++ show hi
 initExpr2C' (BuiltInFunction "succ" [BuiltInFunction "pred" [e]]) = initExpr2C' e
 initExpr2C' (BuiltInFunction "pred" [BuiltInFunction "succ" [e]]) = initExpr2C' e
 initExpr2C' (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C' e
@@ -768,6 +774,12 @@
         where
             bt = BTEnum $ map (\(Identifier i _) -> map toLower i) ids
     type2C' (ArrayDecl Nothing t) = type2C (PointerTo t)
+    type2C' (ArrayDecl (Just r1) (ArrayDecl (Just r2) t)) = do
+        t' <- type2C t
+        lt <- gets lastType
+        r1' <- initExpr2C (InitRange r1)
+        r2' <- initExpr2C (InitRange r2)
+        return $ \i -> t' i <> brackets r1' <> brackets r2'
     type2C' (ArrayDecl (Just r) t) = do
         t' <- type2C t
         lt <- gets lastType