FreeBASIC  0.91.0
parser-label.bas
Go to the documentation of this file.
1 '' label declarations
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 "ast.bi"
10 
11 '':::::
12 ''Label = NUM_LIT
13 '' | ID ':' .
14 ''
15 function cLabel as integer
16  dim as FBSYMBOL ptr l = NULL
17  dim as FBSYMCHAIN ptr chain_ = any
18 
19  function = FALSE
20 
21  '' NUM_LIT
22  select case as const lexGetClass( )
23  case FB_TKCLASS_NUMLITERAL
24 
25  if( fbLangOptIsSet( FB_LANG_OPT_NUMLABEL ) = FALSE ) then
26  errReportNotAllowed( FB_LANG_OPT_NUMLABEL )
27  '' error recovery: skip stmt
28  hSkipStmt( )
29  else
30  l = symbAddLabel( lexGetText( ), _
31  FB_SYMBOPT_DECLARING or FB_SYMBOPT_CREATEALIAS )
32  if( l = NULL ) then
33  errReport( FB_ERRMSG_DUPDEFINITION )
34  '' error recovery: skip stmt
35  hSkipStmt( )
36  else
37  lexSkipToken( )
38  end if
39 
40  '' fake a ':'
41  parser.stmt.cnt += 1
42  end if
43 
44  '' ID (labels can't be quirk-keywords)
45  case FB_TKCLASS_IDENTIFIER
46  '' ':'
47  if( lexGetLookAhead( 1 ) = FB_TK_STMTSEP ) then
48  '' ambiguity: it could be a proc call followed by a ':' stmt separator..
49  '' no need to call Identifier(), ':' wouldn't follow 'ns.symbol' ids
50  chain_ = lexGetSymChain( )
51  if( symbFindByClass( chain_, FB_SYMBCLASS_PROC ) <> NULL ) then
52  exit function
53  end if
54 
55  l = symbAddLabel( lexGetText( ), _
56  FB_SYMBOPT_DECLARING or FB_SYMBOPT_CREATEALIAS )
57  if( l = NULL ) then
58  errReport( FB_ERRMSG_DUPDEFINITION )
59  end if
60 
61  lexSkipToken( )
62 
63  '' skip ':'
64  lexSkipToken( )
65  end if
66  end select
67 
68  if( l <> NULL ) then
69  astAdd( astNewLABEL( l ) )
70 
71  symbSetLastLabel( l )
72 
73  function = TRUE
74  end if
75 
76 end function
77