FreeBASIC  0.91.0
parser-quirk-string.bas
Go to the documentation of this file.
1 '' quirk string statements (MID, LSET) and functions (MID, INSTR) parsing
2 ''
3 '' chng: sep/2004 written [v1ctor]
4 
5 
6 #include once "fb.bi"
7 #include once "fbint.bi"
8 #include once "parser.bi"
9 #include once "rtl.bi"
10 #include once "ast.bi"
11 
12 '' MidStmt = MID '(' Expression{str}, Expression{int} (',' Expression{int}) ')' '=' Expression{str} .
13 function cMidStmt( ) as integer
14  dim as ASTNODE ptr expr1 = any, expr2 = any, expr3 = any, expr4 = any
15 
16  function = FALSE
17 
18  '' MID
19  lexSkipToken( )
20 
21  '' '('
22  hMatchLPRNT()
23 
24  '' Expression{str}
25  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
26  if( astIsConstant( expr1 ) ) then
27  errReport( FB_ERRMSG_CONSTANTCANTBECHANGED, TRUE )
28  end if
29 
30  '' ','
31  hMatchCOMMA( )
32 
33  '' Expression{int}
34  hMatchExpressionEx( expr2, FB_DATATYPE_INTEGER )
35 
36  '' ','?
37  if( hMatch( CHAR_COMMA ) ) then
38  '' Expression{int}
39  hMatchExpressionEx( expr3, FB_DATATYPE_INTEGER )
40  else
41  expr3 = astNewCONSTi( -1 )
42  end if
43 
44  '' ')'
45  hMatchRPRNT( )
46 
47  '' '='
48  if( cAssignToken( ) = FALSE ) then
49  errReport( FB_ERRMSG_EXPECTEDEQ )
50  end if
51 
52  '' Expression{str}
53  hMatchExpressionEx( expr4, FB_DATATYPE_STRING )
54 
55  function = rtlStrAssignMid( expr1, expr2, expr3, expr4 ) <> NULL
56 end function
57 
58 #define CREATEFAKEID() _
59  astNewVAR( symbAddTempVar( FB_DATATYPE_STRING ) )
60 
61 '':::::
62 '' LRsetStmt = LSET|RSET String|UDT (','|'=') Expression|UDT
63 function cLRSetStmt(byval tk as FB_TOKEN) as integer
64  dim as ASTNODE ptr dstexpr = any, srcexpr = any
65  dim as integer dtype1 = any, dtype2 = any
66  dim as FBSYMBOL ptr dst = any, src = any
67  dim as integer is_rset = any
68 
69  function = FALSE
70 
71  '' (LSET|RSET)
72  is_rset = (tk = FB_TK_RSET)
73  lexSkipToken( )
74 
75  '' Expression
76  dstexpr = cVarOrDeref( )
77  if( dstexpr = NULL ) then
78  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER )
79  '' error recovery: fake a var
80  dstexpr = CREATEFAKEID( )
81  end if
82 
83  dtype1 = astGetDataType( dstexpr )
84  select case as const dtype1
85  case FB_DATATYPE_STRING, FB_DATATYPE_FIXSTR, _
86  FB_DATATYPE_CHAR, FB_DATATYPE_WCHAR, _
87  FB_DATATYPE_STRUCT
88 
89  if( is_rset and (dtype1 = FB_DATATYPE_STRUCT) ) then
90  errReport( FB_ERRMSG_INVALIDDATATYPES )
91  '' error recovery: do lset instead
92  is_rset = FALSE
93  end if
94 
95  dim as FBSYMBOL ptr sym = astGetSymbol( dstexpr )
96 
97  if( sym = NULL ) then
98  '' deref...
99  if (astGetClass( dstexpr ) = AST_NODECLASS_DEREF) then
100  sym = iif( astGetLeft( dstexpr ), astGetSymbol( astGetLeft( dstexpr ) ), NULL )
101  end if
102  end if
103 
104  if( sym = NULL ) then
105  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER, TRUE )
106  else
107  if( symbIsConstant( sym ) or typeIsConst( astGetFullType( dstexpr ) ) ) then
108  errReport( FB_ERRMSG_CONSTANTCANTBECHANGED, TRUE )
109  end if
110  end if
111 
112  case else
113  errReport( FB_ERRMSG_INVALIDDATATYPES )
114  '' error recovery: fake a var
115  astDelTree( dstexpr )
116  dstexpr = CREATEFAKEID( )
117  end select
118 
119  '' ',' or '='
120  if( hMatch( CHAR_COMMA ) = FALSE ) then
121  if( cAssignToken( ) = FALSE ) then
122  errReport( FB_ERRMSG_EXPECTEDCOMMA )
123  end if
124  end if
125 
126  '' Expression
127  hMatchExpressionEx( srcexpr, dtype1 )
128 
129  dtype2 = astGetDataType( srcexpr )
130  select case as const dtype2
131  case FB_DATATYPE_STRING, FB_DATATYPE_FIXSTR, _
132  FB_DATATYPE_CHAR, FB_DATATYPE_WCHAR, _
133  FB_DATATYPE_STRUCT
134 
135  case else
136  errReport( FB_ERRMSG_INVALIDDATATYPES )
137  '' error recovery: fake a var
138  astDelTree( srcexpr )
139  srcexpr = CREATEFAKEID( )
140  end select
141 
142  if( (dtype1 = FB_DATATYPE_STRUCT) or _
143  (dtype2 = FB_DATATYPE_STRUCT) ) then
144 
145  if( dtype1 <> dtype2 ) then
146  errReport( FB_ERRMSG_INVALIDDATATYPES )
147  '' no error recovery: stmt already parsed
148  astDelTree( srcexpr )
149  astDelTree( dstexpr )
150  return TRUE
151  end if
152 
153  dst = astGetSymbol( dstexpr )
154  src = astGetSymbol( srcexpr )
155  if( (dst = NULL) or (src = NULL) ) then
156  errReport( FB_ERRMSG_EXPECTEDIDENTIFIER )
157  '' no error recovery: stmt already parsed
158  astDelTree( srcexpr )
159  astDelTree( dstexpr )
160  return TRUE
161  end if
162 
163  function = rtlMemCopyClear( dstexpr, symbGetLen( dst->subtype ), _
164  srcexpr, symbGetLen( src->subtype ) )
165  else
166  function = rtlStrLRSet( dstexpr, srcexpr, is_rset )
167  end if
168 
169 end function
170 
171 function cStrCHR(byval is_wstr as integer) as ASTNODE ptr
172  static as zstring * 32*6+1 zs
173  static as wstring * 32*6+1 ws
174  static as zstring * 8+1 o
175  dim as longint v = any, i = any, cnt = any, isconst = any
176  dim as ASTNODE ptr exprtb(0 to 31) = any
177 
178  hMatchLPRNT( )
179 
180  cnt = 0
181  do
182  hMatchExpressionEx( exprtb(cnt), FB_DATATYPE_INTEGER )
183  cnt += 1
184  if( cnt >= 32 ) then
185  exit do
186  end if
187  loop while( hMatch( CHAR_COMMA ) )
188 
189  hMatchRPRNT( )
190 
191  '' if wstring, check if compile-time conversion can be done
192  if( is_wstr and (env.wchar_doconv = FALSE) ) then
193  isconst = FALSE
194  else
195  '' constant? evaluate at compile-time
196  isconst = TRUE
197  for i = 0 to cnt-1
198  if( astIsCONST( exprtb(i) ) = FALSE ) then
199  isconst = FALSE
200  exit for
201  end if
202 
203  '' when the constant value is 0, we must not handle
204  '' this as a constant string
205  if( astConstEqZero( exprtb(i) ) ) then
206  isconst = FALSE
207  exit for
208  end if
209  next
210  end if
211 
212  if( isconst ) then
213  if( is_wstr = FALSE ) then
214  zs = ""
215  else
216  ws = ""
217  end if
218 
219  for i = 0 to cnt-1
220  v = astConstFlushToInt( exprtb(i) )
221  exprtb(i) = NULL
222 
223  if( is_wstr = FALSE ) then
224  if( culngint( v ) > 255 ) then
225  v = 255
226  end if
227  if( (v < CHAR_SPACE) or (v > 127) ) then
228  zs += ESCCHAR
229  o = oct( v )
230  zs += chr( len( o ) )
231  zs += o
232  else
233  zs += chr( v )
234  end if
235  else
236  if( (v < CHAR_SPACE) or (v > 127) ) then
237  ws += ESCCHAR
238  o = oct( v )
239  ws += wchr( len( o ) )
240  ws += o
241  else
242  ws += wchr( v )
243  end if
244  end if
245  next
246 
247  if( is_wstr = FALSE ) then
248  function = astNewVAR( symbAllocStrConst( zs, cnt ) )
249  else
250  function = astNewVAR( symbAllocWstrConst( ws, cnt ) )
251  end if
252  else
253  function = rtlStrChr( cnt, exprtb(), is_wstr )
254  end if
255 end function
256 
257 function cStrASC() as ASTNODE ptr
258  dim as ASTNODE ptr expr1 = any, posexpr = any
259  dim as longint p = any
260 
261  hMatchLPRNT( )
262  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
263 
264  '' (',' Expression)?
265  if( hMatch( CHAR_COMMA ) ) then
266  hMatchExpressionEx( posexpr, FB_DATATYPE_INTEGER )
267  else
268  posexpr = NULL
269  end if
270 
271  hMatchRPRNT( )
272 
273  '' constant? evaluate at compile-time
274  dim as FBSYMBOL ptr litsym = NULL
275  select case astGetDataType( expr1 )
276  case FB_DATATYPE_CHAR, FB_DATATYPE_WCHAR
277  litsym = astGetStrLitSymbol( expr1 )
278  end select
279 
280  if( litsym <> NULL ) then
281  '' if wstring, check if compile-time conversion can be done
282  if( (astGetDataType( expr1 ) = FB_DATATYPE_WCHAR) and _
283  (env.wchar_doconv = FALSE) ) then
284  p = -1
285  else
286  '' pos is an constant too?
287  if( posexpr <> NULL ) then
288  if( astIsCONST( posexpr ) ) then
289  p = astConstFlushToInt( posexpr )
290  posexpr = NULL
291 
292  if( p < 0 ) then
293  p = 0
294  end if
295  else
296  p = -1
297  end if
298  else
299  p = 1
300  end if
301  end if
302 
303  if( p >= 0 ) then
304  '' zstring?
305  if( astGetDataType( expr1 ) <> FB_DATATYPE_WCHAR ) then
306  '' remove internal escape format
307  dim as zstring ptr zs = hUnescape( symbGetVarLitText( litsym ) )
308  function = astNewCONSTi( asc( *zs, p ), FB_DATATYPE_UINT )
309  '' wstring..
310  else
311  '' ditto
312  dim as wstring ptr ws = hUnescapeW( symbGetVarLitTextW( litsym ) )
313  function = astNewCONSTi( asc( *ws, p ), FB_DATATYPE_UINT )
314  end if
315  astDelNode( expr1 )
316  expr1 = NULL
317  end if
318  end if
319 
320  if( expr1 <> NULL ) then
321  function = rtlStrAsc( expr1, posexpr )
322  end if
323 end function
324 
325 '':::::
326 '' cCVXFunct = CVD '(' Expression{str} ')'
327 '' | CVS '(' Expression{str} ')'
328 '' | CVI '(' Expression{str} ')'
329 '' | CVL '(' Expression{str} ')'
330 '' | CVSHORT '(' Expression{str} ')'
331 '' | CVLONGINT '(' Expression{str} ')'
332 ''
333 function cCVXFunct(byval tk as FB_TOKEN) as ASTNODE ptr
334  '' CVD | CVS | CVI | CVL | CVSHORT | CVLONGINT
335  lexSkipToken( )
336 
337  dim as FB_DATATYPE dtype = FB_DATATYPE_INVALID
338 
339  '' ['<' lgt '>']
340  if( (tk = FB_TK_CVI) andalso hMatch( FB_TK_LT ) ) then
341 
342  '' expr
343  var lgt = cConstIntExpr( cGtInParensOnlyExpr( ) )
344 
345  '' disallow BYTEs here (would need to use ASC)
346  if( lgt = 8 ) then lgt = 0
347 
348  dtype = hIntegerTypeFromBitSize( lgt, FALSE )
349 
350  if( hMatch( FB_TK_GT ) = FALSE ) then
351  errReport( FB_ERRMSG_EXPECTEDGT )
352  end if
353 
354  end if
355 
356  '' '('
357  hMatchLPRNT( )
358 
359  '' string expression
360  dim as ASTNODE ptr expr1 = any
361  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
362 
363  '' ')'
364  hMatchRPRNT( )
365 
366  '' constant? evaluate at compile-time
367  dim as FBSYMBOL ptr litsym = NULL
368  dim as integer is_str = FALSE
369  select case astGetDataType( expr1 )
370  case FB_DATATYPE_CHAR
371  litsym = astGetStrLitSymbol( expr1 )
372  is_str = TRUE
373  case FB_DATATYPE_STRING, FB_DATATYPE_FIXSTR, FB_DATATYPE_WCHAR
374  is_str = TRUE
375  end select
376 
377  dim as integer allowconst = TRUE
378 
379  '' determine return type (use this to determine function name)
380  dim as FB_DATATYPE functype = any
381  select case as const tk
382  case FB_TK_CVD
383  functype = FB_DATATYPE_DOUBLE
384  allowconst = FALSE
385  case FB_TK_CVS
386  functype = FB_DATATYPE_SINGLE
387  allowconst = FALSE
388  case FB_TK_CVI
389  if( dtype <> FB_DATATYPE_INVALID ) then
390  functype = dtype
391  else
392  functype = env.lang.integerkeyworddtype
393  end if
394 
395  case FB_TK_CVL
396  functype = FB_DATATYPE_LONG
397  case FB_TK_CVSHORT
398  functype = FB_DATATYPE_SHORT
399  case else
400  assert(tk = FB_TK_CVLONGINT)
401  functype = FB_DATATYPE_LONGINT
402  end select
403 
404  dim as zstring ptr zs = any
405  dim as integer zslen = any
406  if( (allowconst <> FALSE) and (litsym <> NULL) ) then
407  '' remove internal escape format
408  zs = hUnescape( symbGetVarLitText( litsym ) )
409  zslen = len( *zs )
410  else
411  zs = NULL
412  zslen = 0
413  end if
414 
415  dim as ASTNODE ptr funcexpr = NULL
416  '' string parameter, or CVSHORT/CVI<16> (which can only take strings)
417  if( is_str orelse (functype = FB_DATATYPE_SHORT) ) then
418  if( zslen >= typeGetSize( functype ) ) then
419  select case( functype )
420  case FB_DATATYPE_DOUBLE
421  funcexpr = astNewCONSTf( cvd( *zs ), FB_DATATYPE_DOUBLE )
422  case FB_DATATYPE_SINGLE
423  funcexpr = astNewCONSTf( cvs( *zs ), FB_DATATYPE_SINGLE )
424  case else
425  select case( typeGetSize( functype ) )
426  case 2
427  funcexpr = astNewCONSTi( cvshort( *zs ), FB_DATATYPE_SHORT )
428  case 4
429  funcexpr = astNewCONSTi( cvl( *zs ), functype )
430  case else
431  funcexpr = astNewCONSTi( cvlongint( *zs ), functype )
432  end select
433  end select
434  astDelNode( expr1 )
435  else
436  select case( functype )
437  case FB_DATATYPE_DOUBLE
438  funcexpr = astNewCALL( PROCLOOKUP( CVD ) )
439  case FB_DATATYPE_SINGLE
440  funcexpr = astNewCALL( PROCLOOKUP( CVS ) )
441  case else
442  select case( typeGetSize( functype ) )
443  case 2
444  funcexpr = astNewCALL( PROCLOOKUP( CVSHORT ) )
445  case 4
446  funcexpr = astNewCALL( PROCLOOKUP( CVL ) )
447  case else
448  funcexpr = astNewCALL( PROCLOOKUP( CVLONGINT ) )
449  end select
450  end select
451 
452  '' byref expr as string
453  if( astNewARG( funcexpr, expr1 ) = NULL ) then
454  funcexpr = NULL
455  end if
456  end if
457  else
458  select case( functype )
459  case FB_DATATYPE_DOUBLE
460  funcexpr = astNewCALL( PROCLOOKUP( CVDFROMLONGINT ) )
461  case FB_DATATYPE_SINGLE
462  funcexpr = astNewCALL( PROCLOOKUP( CVSFROML ) )
463  case else
464  if( typeGetSize( functype ) = 4 ) then
465  funcexpr = astNewCALL( PROCLOOKUP( CVLFROMS ) )
466  else
467  funcexpr = astNewCALL( PROCLOOKUP( CVLONGINTFROMD ) )
468  end if
469  end select
470 
471  if( funcexpr <> NULL ) then
472  '' byref expr as numtype
473  if( astNewARG( funcexpr, expr1 ) = NULL ) then
474  funcexpr = NULL
475  end if
476  end if
477  end if
478 
479  if( funcexpr <> NULL ) then
480  funcexpr = astNewCONV( functype, NULL, funcexpr )
481  end if
482 
483  if( funcexpr = NULL ) then
484  '' miscellaneous problem, this message should be roughly appropriate
485  errReport( FB_ERRMSG_INVALIDDATATYPES )
486  end if
487 
488  function = funcexpr
489 end function
490 
491 '':::::
492 '' cMKXFunct = MKD '(' Expression{double} ')'
493 '' | MKS '(' Expression{float} ')'
494 '' | MKI '(' Expression{int} ')'
495 '' | MKL '(' Expression{long} ')'
496 '' | MKSHORT '(' Expression{short} ')'
497 '' | MKLONGINT '(' Expression{longint} ')'
498 ''
499 function cMKXFunct(byval tk as FB_TOKEN) as ASTNODE ptr
500  '' MKD | MKS | MKI | MKL | MKSHORT | MKLONGINT
501  lexSkipToken( )
502 
503  dim as FB_DATATYPE dtype = FB_DATATYPE_INVALID
504 
505  '' ['<' lgt '>']
506  if( (tk = FB_TK_MKI) andalso hMatch( FB_TK_LT ) ) then
507 
508  '' expr
509  var lgt = cConstIntExpr( cGtInParensOnlyExpr( ) )
510 
511  '' disallow BYTEs here (would need to use CHR)
512  if( lgt = 8 ) then lgt = 0
513 
514  dtype = hIntegerTypeFromBitSize( lgt, FALSE )
515 
516  if( hMatch( FB_TK_GT ) = FALSE ) then
517  errReport( FB_ERRMSG_EXPECTEDGT )
518  end if
519 
520  end if
521 
522 
523  hMatchLPRNT( )
524 
525  dim as ASTNODE ptr expr1 = any
526  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
527 
528  hMatchRPRNT( )
529 
530  dim as ASTNODE ptr funcexpr = NULL
531 
532  #macro doMKX( token )
533  select case as const astGetDataType( expr1 )
534  case FB_DATATYPE_LONGINT, FB_DATATYPE_ULONGINT
535  funcexpr = astNewCONSTstr( str( token( astConstGetAsInt64( expr1 ) ) ) )
536  case FB_DATATYPE_SINGLE, FB_DATATYPE_DOUBLE
537  funcexpr = astNewCONSTstr( str( token( astConstGetAsDouble( expr1 ) ) ) )
538  case FB_DATATYPE_LONG, FB_DATATYPE_ULONG
539  if( 4 = len( integer ) ) then
540  funcexpr = astNewCONSTstr( str( token( astGetValueAsInt( expr1 ) ) ) )
541  else
542  funcexpr = astNewCONSTstr( str( token( astConstGetAsInt64( expr1 ) ) ) )
543  end if
544  case else
545  funcexpr = astNewCONSTstr( str( token( astGetValueAsInt( expr1 ) ) ) )
546  end select
547  #endmacro
548 
549 ' '' I don't know how to do this properly, the NULLs ruin it.
550 ' '' constant? eval at compile-time
551 ' if( astIsCONST( expr1 ) ) then
552 ' select case as const tk
553 ' case FB_TK_MKD
554 ' doMKX( mkd )
555 ' case FB_TK_MKS
556 ' doMKX( mks )
557 ' case FB_TK_MKI
558 ' doMKX( mki )
559 ' case FB_TK_MKL
560 ' doMKX( mkl )
561 ' case FB_TK_MKSHORT
562 ' doMKX( mkshort )
563 ' case FB_TK_MKLONGINT
564 ' doMKX( mklongint )
565 ' end select
566 ' astDelNode( expr1 )
567 ' expr1 = NULL
568 ' end if
569 
570  if( expr1 <> NULL ) then
571  select case as const tk
572  case FB_TK_MKD
573  funcexpr = astNewCALL( PROCLOOKUP( MKD ) )
574  case FB_TK_MKS
575  funcexpr = astNewCALL( PROCLOOKUP( MKS ) )
576  case FB_TK_MKI
577  if( dtype = FB_DATATYPE_INVALID ) then
578  dtype = env.lang.integerkeyworddtype
579  end if
580 
581  if( typeGetDtAndPtrOnly( dtype ) = FB_DATATYPE_INTEGER ) then
582  '' fb_MKI() is for INTEGERs, both on 32bit and on 64bit
583  funcexpr = astNewCALL( PROCLOOKUP( MKI ) )
584  else
585  select case( typeGetSizeType( dtype ) )
586  case FB_SIZETYPE_INT16
587  funcexpr = astNewCALL( PROCLOOKUP( MKSHORT ) )
588  case FB_SIZETYPE_INT32
589  funcexpr = astNewCALL( PROCLOOKUP( MKL ) )
590  case FB_SIZETYPE_INT64
591  funcexpr = astNewCALL( PROCLOOKUP( MKLONGINT ) )
592  end select
593  end if
594 
595  case FB_TK_MKL
596  funcexpr = astNewCALL( PROCLOOKUP( MKL ) )
597  case FB_TK_MKSHORT
598  funcexpr = astNewCALL( PROCLOOKUP( MKSHORT ) )
599  case else
600  assert(tk = FB_TK_MKLONGINT)
601  funcexpr = astNewCALL( PROCLOOKUP( MKLONGINT ) )
602  end select
603 
604  '' byval expr as {type}
605  if( astNewARG( funcexpr, expr1 ) = NULL ) then
606  funcexpr = NULL
607  end if
608  end if
609 
610  if( funcexpr = NULL ) then
611  '' miscellaneous problem, this message should be roughly appropriate
612  errReport( FB_ERRMSG_INVALIDDATATYPES )
613  end if
614 
615  function = funcexpr
616 end function
617 
618 
619 '':::::
620 '' cStringFunct = W|STR$ '(' Expression{int|float|double} ')'
621 '' | MID$ '(' Expression ',' Expression (',' Expression)? ')'
622 '' | W|STRING$ '(' Expression ',' Expression{int|str} ')' .
623 '' | INSTR '(' (Expression{int} ',')? Expression{str}, "ANY"? Expression{str} ')'
624 '' | INSTRREV '(' Expression{str}, "ANY"? Expression{str} (',' Expression{int})? ')'
625 '' | RTRIM$ '(' Expression{str} (, "ANY" Expression{str} )? ')'
626 '' | LCASE|UCASE '(' Expression{str} [, Expression{integer}] ')'
627 ''
628 function cStringFunct(byval tk as FB_TOKEN) as ASTNODE ptr
629  dim as ASTNODE ptr expr1 = any, expr2 = any, expr3 = any
630  dim as integer dclass = any, dtype = any, is_any = any, is_wstr = any
631 
632  function = NULL
633 
634  select case tk
635  '' W|STR '(' Expression{int|float|double|wstring} ')'
636  case FB_TK_STR, FB_TK_WSTR
637  is_wstr = (tk = FB_TK_WSTR)
638  lexSkipToken( )
639 
640  hMatchLPRNT( )
641  hMatchExpressionEx( expr1, FB_DATATYPE_INTEGER )
642  hMatchRPRNT( )
643 
644  if( is_wstr = FALSE ) then
645  expr1 = rtlToStr( expr1, fbLangIsSet( FB_LANG_QB ) )
646  else
647  expr1 = rtlToWstr( expr1 )
648  end if
649  if( expr1 = NULL ) then
650  errReport( FB_ERRMSG_INVALIDDATATYPES )
651  expr1 = astNewCONSTi( 0 )
652  end if
653 
654  function = expr1
655 
656  '' MID '(' Expression ',' Expression (',' Expression)? ')'
657  case FB_TK_MID
658  lexSkipToken( )
659 
660  hMatchLPRNT( )
661  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
662  hMatchCOMMA( )
663  hMatchExpressionEx( expr2, FB_DATATYPE_INTEGER )
664  if( hMatch( CHAR_COMMA ) ) then
665  hMatchExpressionEx( expr3, FB_DATATYPE_INTEGER )
666  else
667  expr3 = astNewCONSTi( -1 )
668  end if
669  hMatchRPRNT( )
670 
671  expr1 = rtlStrMid( expr1, expr2, expr3 )
672  if( expr1 = NULL ) then
673  errReport( FB_ERRMSG_INVALIDDATATYPES )
674  expr1 = astNewCONSTi( 0 )
675  end if
676 
677  function = expr1
678 
679  '' W|STRING '(' Expression ',' Expression{int|str} ')'
680  case FB_TK_STRING, FB_TK_WSTRING
681  is_wstr = (tk = FB_TK_WSTRING)
682  lexSkipToken( )
683 
684  hMatchLPRNT( )
685  hMatchExpressionEx( expr1, FB_DATATYPE_INTEGER )
686  hMatchCOMMA( )
687  hMatchExpressionEx( expr2, FB_DATATYPE_INTEGER )
688  hMatchRPRNT( )
689 
690  if( is_wstr = FALSE ) then
691  expr1 = rtlStrFill( expr1, expr2 )
692  else
693  expr1 = rtlWstrFill( expr1, expr2 )
694  end if
695  if( expr1 = NULL ) then
696  errReport( FB_ERRMSG_INVALIDDATATYPES )
697  expr1 = astNewCONSTi( 0 )
698  end if
699 
700  function = expr1
701 
702  '' W|CHR '(' Expression (',' Expression )* ')'
703  case FB_TK_CHR, FB_TK_WCHR
704  is_wstr = (tk = FB_TK_WCHR)
705  lexSkipToken( )
706 
707  function = cStrCHR(is_wstr)
708 
709  '' ASC '(' Expression (',' Expression)? ')'
710  case FB_TK_ASC
711  lexSkipToken( )
712 
713  function = cStrASC()
714 
715  case FB_TK_INSTR
716  lexSkipToken( )
717 
718  hMatchLPRNT( )
719  hMatchExpressionEx( expr1, FB_DATATYPE_INTEGER )
720  hMatchCOMMA( )
721  is_any = hMatch( FB_TK_ANY )
722  hMatchExpressionEx( expr2, FB_DATATYPE_STRING )
723  expr3 = NULL
724  if( is_any = FALSE ) then
725  if( hMatch( CHAR_COMMA ) ) then
726  is_any = hMatch( FB_TK_ANY )
727  hMatchExpressionEx( expr3, FB_DATATYPE_STRING )
728  end if
729  end if
730  if( expr3 = NULL ) then
731  expr3 = expr2
732  expr2 = expr1
733  expr1 = astNewCONSTi( 1 )
734  end if
735  hMatchRPRNT( )
736 
737  expr1 = rtlStrInstr( expr1, expr2, expr3, is_any )
738  if( expr1 = NULL ) then
739  errReport( FB_ERRMSG_INVALIDDATATYPES )
740  expr1 = astNewCONSTi( 0 )
741  end if
742 
743  function = expr1
744 
745  case FB_TK_INSTRREV
746  lexSkipToken( )
747 
748  hMatchLPRNT( )
749  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
750  hMatchCOMMA( )
751  is_any = hMatch( FB_TK_ANY )
752  hMatchExpressionEx( expr2, FB_DATATYPE_STRING )
753  if( hMatch( CHAR_COMMA ) ) then
754  hMatchExpressionEx( expr3, FB_DATATYPE_INTEGER )
755  else
756  expr3 = astNewCONSTi( -1 )
757  end if
758  hMatchRPRNT( )
759 
760  expr1 = rtlStrInstrRev( expr3, expr1, expr2, is_any )
761  if( expr1 = NULL ) then
762  errReport( FB_ERRMSG_INVALIDDATATYPES )
763  expr1 = astNewCONSTi( 0 )
764  end if
765 
766  function = expr1
767 
768  case FB_TK_TRIM, FB_TK_LTRIM, FB_TK_RTRIM
769  lexSkipToken( )
770 
771  hMatchLPRNT( )
772  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
773  if( hMatch( CHAR_COMMA ) ) then
774  is_any = hMatch( FB_TK_ANY )
775  hMatchExpressionEx( expr2, FB_DATATYPE_STRING )
776  else
777  is_any = FALSE
778  expr2 = NULL
779  end if
780  hMatchRPRNT( )
781 
782  select case (tk)
783  case FB_TK_TRIM
784  expr1 = rtlStrTrim( expr1, expr2, is_any )
785  case FB_TK_LTRIM
786  expr1 = rtlStrLTrim( expr1, expr2, is_any )
787  case FB_TK_RTRIM
788  expr1 = rtlStrRTrim( expr1, expr2, is_any )
789  end select
790 
791  if( expr1 = NULL ) then
792  errReport( FB_ERRMSG_INVALIDDATATYPES )
793  expr1 = astNewCONSTi( 0 )
794  end if
795 
796  function = expr1
797 
798  '' LCASE|UCASE '(' Expression{string} [, Expression{integer}] ')'
799  case FB_TK_LCASE, FB_TK_UCASE
800  lexSkipToken( )
801 
802  hMatchLPRNT( )
803  hMatchExpressionEx( expr1, FB_DATATYPE_STRING )
804 
805  '' Mode parameter given?
806  if( hMatch( CHAR_COMMA ) ) then
807  hMatchExpressionEx( expr2, FB_DATATYPE_INTEGER )
808  else
809  expr2 = NULL '' Let rtlStrCase() use the default value
810  end if
811 
812  hMatchRPRNT( )
813 
814  function = rtlStrCase( expr1, expr2, (tk = FB_TK_LCASE) )
815 
816  end select
817 
818 end function
819