~ubuntu-branches/ubuntu/saucy/bnfc/saucy

« back to all changes in this revision

Viewing changes to src/formats/cpp/CFtoFlex.hs

  • Committer: Package Import Robot
  • Author(s): Joachim Breitner
  • Date: 2013-05-24 12:49:41 UTC
  • mfrom: (7.1.1 experimental)
  • Revision ID: package-import@ubuntu.com-20130524124941-tepbsbvdogyegb6k
Tags: 2.6.0.3-2
* Change Homepage field (Closes: #677988)
* Enable compat level 9
* Bump standards version to 3.9.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
{-
 
2
    BNF Converter: Flex generator
 
3
    Copyright (C) 2004  Author:  Michael Pellauer
 
4
 
 
5
    This program is free software; you can redistribute it and/or modify
 
6
    it under the terms of the GNU General Public License as published by
 
7
    the Free Software Foundation; either version 2 of the License, or
 
8
    (at your option) any later version.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
    GNU General Public License for more details.
 
14
 
 
15
    You should have received a copy of the GNU General Public License
 
16
    along with this program; if not, write to the Free Software
 
17
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
18
-}
 
19
 
 
20
{- 
 
21
   **************************************************************
 
22
    BNF Converter Module
 
23
 
 
24
    Description   : This module generates the Flex file. It is
 
25
                    similar to JLex but with a few peculiarities.
 
26
                    
 
27
    Author        : Michael Pellauer (pellauer@cs.chalmers.se)
 
28
 
 
29
    License       : GPL (GNU General Public License)
 
30
 
 
31
    Created       : 5 August, 2003                           
 
32
 
 
33
    Modified      : 22 August, 2006 by Aarne Ranta                          
 
34
 
 
35
   
 
36
   ************************************************************** 
 
37
-}
 
38
module CFtoFlex (cf2flex) where
 
39
 
 
40
import CF
 
41
import RegToFlex
 
42
import Utils((+++), (++++))
 
43
import NamedVariables
 
44
import Data.List
 
45
import STLUtils
 
46
 
 
47
--The environment must be returned for the parser to use.
 
48
cf2flex :: Maybe String -> String -> CF -> (String, SymEnv)
 
49
cf2flex inPackage name cf = (unlines
 
50
 [
 
51
  prelude inPackage name,
 
52
  cMacros,
 
53
  lexSymbols env,
 
54
  restOfFlex inPackage cf env'
 
55
 ], env')
 
56
  where
 
57
   env = makeSymEnv (symbols cf ++ reservedWords cf) (0 :: Int)
 
58
   env' = env ++ (makeSymEnv (fst (unzip (tokenPragmas cf))) (length env))
 
59
   makeSymEnv [] _ = []
 
60
   makeSymEnv (s:symbs) n = (s, nsDefine inPackage "_SYMB_" ++ (show n)) : (makeSymEnv symbs (n+1))
 
61
 
 
62
prelude :: Maybe String -> String -> String
 
63
prelude inPackage name = unlines
 
64
  [
 
65
   maybe "" (\ns -> "%option prefix=\"" ++ ns ++ "yy\"") inPackage,
 
66
   "/* This FLex file was machine-generated by the BNF converter */",
 
67
   "%{",
 
68
   "#include <string.h>",
 
69
   "#include \"Parser.H\"",
 
70
   "#define YY_BUFFER_LENGTH 4096",
 
71
   "extern int " ++ nsString inPackage ++ "yy_mylinenumber ;", --- hack to get line number. AR 2006
 
72
   "static char YY_PARSED_STRING[YY_BUFFER_LENGTH];",
 
73
   "static void YY_BUFFER_APPEND(char *s)",
 
74
   "{",
 
75
   "  strcat(YY_PARSED_STRING, s); //Do something better here!",
 
76
   "}",
 
77
   "static void YY_BUFFER_RESET(void)",
 
78
   "{",
 
79
   "  for(int x = 0; x < YY_BUFFER_LENGTH; x++)",
 
80
   "    YY_PARSED_STRING[x] = 0;",
 
81
   "}",
 
82
   "",
 
83
   "%}"
 
84
  ]
 
85
 
 
86
--For now all categories are included.
 
87
--Optimally only the ones that are used should be generated.
 
88
cMacros :: String
 
89
cMacros = unlines
 
90
  [
 
91
  "LETTER [a-zA-Z]",
 
92
  "CAPITAL [A-Z]",
 
93
  "SMALL [a-z]",
 
94
  "DIGIT [0-9]",
 
95
  "IDENT [a-zA-Z0-9'_]",
 
96
  "%START YYINITIAL COMMENT CHAR CHARESC CHAREND STRING ESCAPED",
 
97
  "%%"
 
98
  ]
 
99
 
 
100
lexSymbols :: SymEnv -> String
 
101
lexSymbols ss = concatMap transSym ss
 
102
  where
 
103
    transSym (s,r) = 
 
104
      "<YYINITIAL>\"" ++ s' ++ "\"      \t return " ++ r ++ ";\n"
 
105
        where
 
106
         s' = escapeChars s
 
107
 
 
108
restOfFlex :: Maybe String -> CF -> SymEnv -> String
 
109
restOfFlex inPackage cf env = concat
 
110
  [
 
111
   lexComments inPackage (comments cf),
 
112
   userDefTokens,
 
113
   ifC "String" strStates,
 
114
   ifC "Char" chStates,
 
115
   ifC "Double" ("<YYINITIAL>{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)?      \t " ++ ns ++ "yylval.double_ = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";\n"),
 
116
   ifC "Integer" ("<YYINITIAL>{DIGIT}+      \t " ++ ns ++ "yylval.int_ = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";\n"),
 
117
   ifC "Ident" ("<YYINITIAL>{LETTER}{IDENT}*      \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";\n"),
 
118
   "\\n  ++" ++ ns ++ "yy_mylinenumber ;\n",
 
119
   "<YYINITIAL>[ \\t\\r\\n\\f]      \t /* ignore white space. */;\n",
 
120
   "<YYINITIAL>.      \t return " ++ nsDefine inPackage "_ERROR_" ++ ";\n",
 
121
   "%%\n",
 
122
   footer
 
123
  ]
 
124
  where
 
125
   ifC cat s = if isUsedCat cf cat then s else ""
 
126
   ns = nsString inPackage
 
127
   userDefTokens = unlines $
 
128
     ["<YYINITIAL>" ++ printRegFlex exp ++ 
 
129
      "     \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ sName name ++ ";"
 
130
       | (name, exp) <- tokenPragmas cf]
 
131
      where
 
132
          sName n = case lookup n env of
 
133
              Just x -> x
 
134
              Nothing -> n
 
135
   strStates = unlines --These handle escaped characters in Strings.
 
136
    [
 
137
     "<YYINITIAL>\"\\\"\"      \t BEGIN STRING;",
 
138
     "<STRING>\\\\      \t BEGIN ESCAPED;",
 
139
     "<STRING>\\\"      \t " ++ ns ++ "yylval.string_ = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";",
 
140
     "<STRING>.      \t YY_BUFFER_APPEND(yytext);",
 
141
     "<ESCAPED>n      \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;",
 
142
     "<ESCAPED>\\\"      \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;",
 
143
     "<ESCAPED>\\\\      \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;",
 
144
     "<ESCAPED>t       \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;",
 
145
     "<ESCAPED>.       \t YY_BUFFER_APPEND(yytext); BEGIN STRING;"
 
146
    ]
 
147
   chStates = unlines --These handle escaped characters in Chars.
 
148
    [
 
149
     "<YYINITIAL>\"'\" \tBEGIN CHAR;",
 
150
     "<CHAR>\\\\      \t BEGIN CHARESC;",
 
151
     "<CHAR>[^']      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
 
152
     "<CHARESC>n      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
 
153
     "<CHARESC>t      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
 
154
     "<CHARESC>.      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
 
155
     "<CHAREND>\"'\"      \t BEGIN YYINITIAL;"
 
156
    ]
 
157
   footer = unlines
 
158
    [
 
159
     "int " ++ ns ++ "initialize_lexer(FILE *inp) { yyin = inp; BEGIN YYINITIAL; }",
 
160
     "int yywrap(void) { return 1; }"
 
161
    ]
 
162
 
 
163
 
 
164
lexComments :: Maybe String -> ([(String, String)], [String]) -> String
 
165
lexComments inPackage (m,s) = 
 
166
  (unlines (map (lexSingleComment inPackage) s)) 
 
167
  ++ (unlines (map (lexMultiComment inPackage) m))
 
168
 
 
169
lexSingleComment :: Maybe String -> String -> String
 
170
lexSingleComment inPackage c = 
 
171
  "<YYINITIAL>\"" ++ c ++ "\"[^\\n]*\\n  ++" ++ nsString inPackage ++ "yy_mylinenumber ; \t /* BNFC single-line comment */;"
 
172
 
 
173
--There might be a possible bug here if a language includes 2 multi-line comments.
 
174
--They could possibly start a comment with one character and end it with another.
 
175
--However this seems rare.
 
176
lexMultiComment :: Maybe String -> (String, String) -> String
 
177
lexMultiComment inPackage (b,e) = unlines [
 
178
  "<YYINITIAL>\"" ++ b ++ "\"      \t BEGIN COMMENT;",
 
179
  "<COMMENT>\"" ++ e ++ "\"      \t BEGIN YYINITIAL;",
 
180
  "<COMMENT>.      \t /* BNFC multi-line comment */;",
 
181
  "<COMMENT>[\\n]   ++" ++ nsString inPackage ++ "yy_mylinenumber ; \t /* BNFC multi-line comment */;"
 
182
 ---- "\\n  ++yy_mylinenumber ;"
 
183
  ]
 
184
  
 
185
 
 
186
--Helper function that escapes characters in strings
 
187
escapeChars :: String -> String
 
188
escapeChars [] = []
 
189
escapeChars ('\\':xs) = '\\' : ('\\' : (escapeChars xs))
 
190
escapeChars ('\"':xs) = '\\' : ('\"' : (escapeChars xs))
 
191
escapeChars (x:xs) = x : (escapeChars xs)