# HG changeset patch
# User nemo
# Date 1321734993 18000
# Node ID 789c17eac2fe1b956e2786aa05f3aca62b4ffc81
# Parent  b9d9024cf20380880ceadde755a7f25048bd5f3b# Parent  4670f003f91b3246665ca0de95fa056d2d2f3f54
Aaaand merge into trunk too in case guys I was playing earlier are on trunk

diff -r 4670f003f91b -r 789c17eac2fe CMakeLists.txt
--- a/CMakeLists.txt	Sat Nov 19 15:34:38 2011 -0500
+++ b/CMakeLists.txt	Sat Nov 19 15:36:33 2011 -0500
@@ -12,7 +12,7 @@
 
 
 #detect Mercurial revision (if present)
-set(version_suffix "") #UNSET THIS VARIABLE AT RELEASE TIME
+set(version_suffix "-dev") #UNSET THIS VARIABLE AT RELEASE TIME
 set(HGCHANGED "")
 IF(version_suffix MATCHES "-dev")
 	set(HW_DEV true)
diff -r 4670f003f91b -r 789c17eac2fe tools/PascalParser.hs
--- a/tools/PascalParser.hs	Sat Nov 19 15:34:38 2011 -0500
+++ b/tools/PascalParser.hs	Sat Nov 19 15:36:33 2011 -0500
@@ -9,6 +9,7 @@
 import Text.Parsec.String
 import Control.Monad
 import Data.Char
+import Data.Maybe
 
 data PascalUnit =
     Program Identifier Implementation
@@ -24,7 +25,7 @@
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
-    | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
+    | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars,Phrase))
     deriving Show
 data TypeDecl = SimpleType Identifier
     | RangeType Range
@@ -32,7 +33,7 @@
     | ArrayDecl Range TypeDecl
     | RecordType [TypeVarDeclaration]
     | PointerTo TypeDecl
-    | String
+    | String Integer
     | UnknownType
     deriving Show
 data Range = Range Identifier
@@ -237,7 +238,8 @@
         
 typeDecl = choice [
     char '^' >> typeDecl >>= return . PointerTo
-    , try (string "shortstring") >> return String
+    , try (string "shortstring") >> return (String 255)
+    , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
     , arrayDecl
     , recordDecl
     , sequenceDecl >>= return . Sequence
@@ -324,17 +326,11 @@
         try $ string "procedure"
         comments
         i <- iD
-        optional $ do
-            char '('
-            varsDecl False
-            char ')'
+        optional $ parens pas $ varsDecl False
         comments
         char ';'
+        comments
         b <- if isImpl then
-                do
-                comments
-                optional $ typeVarDeclaration True
-                comments
                 liftM Just functionBody
                 else
                 return Nothing
@@ -345,10 +341,7 @@
         try $ string "function"
         comments
         i <- iD
-        optional $ do
-            char '('
-            varsDecl False
-            char ')'
+        optional $ parens pas $ varsDecl False
         comments
         char ':'
         comments
@@ -357,9 +350,6 @@
         char ';'
         comments
         b <- if isImpl then
-                do
-                optional $ typeVarDeclaration True
-                comments
                 liftM Just functionBody
                 else
                 return Nothing
@@ -540,6 +530,7 @@
         comments
         return o
     string "end"
+    comments
     return $ SwitchCase e cs o2
     where
     aCase = do
@@ -559,10 +550,12 @@
 parameters = (commaSep pas) expression <?> "parameters"
         
 functionBody = do
+    tv <- typeVarDeclaration True
+    comments
     p <- phrasesBlock
     char ';'
     comments
-    return p
+    return (TypesAndVars tv, p)
 
 uses = liftM Uses (option [] u)
     where
diff -r 4670f003f91b -r 789c17eac2fe tools/pas2c.hs
--- a/tools/pas2c.hs	Sat Nov 19 15:34:38 2011 -0500
+++ b/tools/pas2c.hs	Sat Nov 19 15:36:33 2011 -0500
@@ -34,10 +34,14 @@
 tvar2C :: TypeVarDeclaration -> Doc
 tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = 
     type2C returnType <+> text (name ++ "();")
-tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = 
+tvar2C (FunctionDeclaration (Identifier name) returnType (Just (tvars, phrase))) = 
     type2C returnType <+> text (name ++ "()") 
     $$
+    text "{" $+$ (nest 4 $ typesAndVars2C tvars)
+    $+$
     phrase2C phrase
+    $+$ 
+    text "}"
 tvar2C (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";"
 tvar2C (VarDeclaration isConst (ids, t) mInitExpr) = 
     if isConst then text "const" else empty
@@ -66,7 +70,7 @@
 
 type2C :: TypeDecl -> Doc
 type2C UnknownType = text "void"
-type2C String = text "string"
+type2C (String l) = text $ "string" ++ show l
 type2C (SimpleType (Identifier i)) = text i
 type2C (PointerTo t) = type2C t <> text "*"
 type2C (RecordType tvs) = text "{" $+$ (nest 4 . vcat . map tvar2C $ tvs) $+$ text "}"