home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / EXAMPLES / SUPERLIN / C_TOKENI.LF < prev    next >
Text File  |  1996-06-04  |  23KB  |  1,126 lines
  1. %
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. %
  4. %
  5. %                          TOKENIZER FOR C CODE
  6. %                          --------------------
  7. %
  8. %  
  9. %
  10. %
  11. %  AUTHOR : Arnaud Venet                     CREATION : July 28th 1993
  12. %  ------                                    --------
  13. %
  14. %
  15. %                             ---------------                        
  16. %
  17. %                    
  18. %                   Last modification : October 22nd 1993 
  19. %
  20. %
  21. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  22. %
  23. %
  24. %  (C) Digital Equipment Corporation 1993  
  25. %  
  26. %
  27. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  28. %
  29.  
  30.  
  31.  
  32. persistent(the_parse_mode) ?
  33.  
  34. persistent(the_error_mode) ?
  35.  
  36. persistent(the_error_log) ?
  37.  
  38. persistent(error_number) ?
  39.  
  40. persistent(parse_error) ?
  41.  
  42. persistent(string_storage) ?
  43.  
  44. persistent(token_number) ?
  45.  
  46.  
  47. %
  48. % ------------------------------------------------------------------------------
  49. %
  50.  
  51.  
  52. persistent(the_previous_token) ?
  53.  
  54. persistent(the_current_token) ?
  55.  
  56. persistent(the_next_token) ?
  57.  
  58. persistent(the_token) ?
  59.  
  60. persistent(the_current_char) ?
  61.  
  62. persistent(the_current_file) ?
  63.  
  64. persistent(the_current_line) ?
  65.  
  66. persistent(the_current_column) ?
  67.  
  68. persistent(the_first_token) ?
  69.  
  70.  
  71. %
  72. % ------------------------------------------------------------------------------
  73. %
  74.  
  75.  
  76. persistent(void_chars_table) ?
  77.  
  78. persistent(separators_table) ?
  79.  
  80. persistent(operators_table) ?
  81.  
  82. persistent(duplicatable_operators_table) ?
  83.  
  84. persistent(combinable_operators_table) ?
  85.  
  86.  
  87. %
  88. % ------------------------------------------------------------------------------
  89. %
  90.  
  91.  
  92. get_the_token -> the_token.1.
  93.  
  94. token -> the_token.1.
  95.  
  96. get_current_token -> the_current_token.1.
  97.  
  98. current_token -> the_current_token.1.
  99.  
  100. get_current_char -> root_sort(the_current_char).
  101.  
  102. current_char -> the_current_char.
  103.  
  104. get_current_file -> the_current_file.1.
  105.  
  106. current_file -> the_current_file.1.
  107.  
  108. get_current_line -> the_current_line.1.
  109.  
  110. current_line -> the_current_line.1.
  111.  
  112. get_current_column -> the_current_column.1.
  113.  
  114. current_column -> the_current_column.1.
  115.  
  116. next_token -> the_next_token.1.
  117.  
  118. previous_token -> the_previous_token.1.
  119.  
  120. get_first_token -> the_first_token.1.
  121.  
  122.  
  123. %
  124. % ------------------------------------------------------------------------------
  125. %
  126.  
  127.  
  128. store(CharList) -> StoredString
  129.   | search(string_of(CharList), string_storage.hash_code(CharList), 
  130.            StoredString).
  131.  
  132.  
  133. %
  134. % ------------------------------------------------------------------------------
  135. %
  136.  
  137.  
  138. read_char :-
  139.   (
  140.     current_char :\== end_of_file,
  141.     !,
  142.     cond(current_char :== 10,
  143.       the_current_column <<- ref(1),
  144.       cond(current_char :== 9,
  145.         the_current_column <<- ref(current_column + 8),
  146.         the_current_column <<- ref(current_column + 1)
  147.       )
  148.     ),
  149.     get(Char),
  150.     the_current_char <<- Char
  151.   ;
  152.     succeed
  153.   ).
  154.  
  155.  
  156. %
  157. % ------------------------------------------------------------------------------
  158. %
  159.  
  160.  
  161. report_err(type => Type, message => Message, cause => Cause) :-
  162.   error_number <<- error_number + 1,
  163.   Error = the_error_log.error_number,
  164.   Error.type <<- Type, 
  165.   Error.message <<- Message, 
  166.   Error.cause <<- Cause, 
  167.   Error.file <<- get_current_file, 
  168.   Error.line <<- get_current_line,
  169.   cond(the_error_mode :== talkie,
  170.     (
  171.       write_err(">>> ", Type, " : ", current_file, ", line ", current_line),
  172.       cond(Cause :\== @,
  173.         write_err(" near '", Cause, "'")
  174.       ),
  175.       write_err(" : ", Message),
  176.       nl_err
  177.     )
  178.   ).
  179.  
  180.  
  181. %
  182. % ------------------------------------------------------------------------------
  183. %
  184.  
  185.  
  186. store_keyword([KeyWord | LKeyWords]) :-
  187.   !,
  188.   (
  189.     CharList = str2list(KeyWord),
  190.     String = store(CharList),
  191.     String.keyword <<- str2psi(KeyWord),
  192.     fail
  193.   ;
  194.     succeed
  195.   ),
  196.   store_keyword(LKeyWords).   
  197.  
  198.  
  199. store_keyword([]).
  200.  
  201.  
  202. %
  203. % ------------------------------------------------------------------------------
  204. %
  205.  
  206.  
  207. init_string_storage :-
  208.   store_keyword(key_words).
  209.  
  210.  
  211. %
  212. % ------------------------------------------------------------------------------
  213. %
  214.  
  215.  
  216. init_void_chars :-
  217.   void_chars_table <<- @(9 => @, 10 => @, 32 => @).
  218.  
  219.  
  220. %
  221. % ------------------------------------------------------------------------------
  222. %
  223.  
  224.  
  225. insert_in_table(What, Table) -> @
  226.   | Table.(asc(What)) <<- What.
  227.  
  228.  
  229. %
  230. % ------------------------------------------------------------------------------
  231. %
  232.  
  233.  
  234. init_separators :-
  235.   separators_table.asc(";") <<- str2psi(";"),
  236.   separators_table.asc("(") <<- str2psi("("),
  237.   separators_table.asc(")") <<- str2psi(")"),
  238.   separators_table.asc("{") <<- str2psi("{"),
  239.   separators_table.asc("}") <<- str2psi("}"),
  240.   separators_table.asc("[") <<- str2psi("["),
  241.   separators_table.asc("]") <<- str2psi("]"),
  242.   separators_table.asc(":") <<- str2psi(":").
  243.  
  244.  
  245. %
  246. % ------------------------------------------------------------------------------
  247. %
  248.  
  249.  
  250. init_operators :-
  251.   map(insert_in_table(2 => operators_table), operator_symbols) = @,
  252.   map(insert_in_table(2 => duplicatable_operators_table), 
  253.       duplicatable_operators) = @,
  254.   map(insert_in_table(2 => combinable_operators_table), 
  255.       combinable_operators) = @.
  256.  
  257.  
  258. %
  259. % ------------------------------------------------------------------------------
  260. %
  261.  
  262.  
  263. init_tables :-
  264.   (
  265.     init_void_chars,
  266.     init_separators,
  267.     init_operators,
  268.     fail
  269.   ;
  270.     succeed
  271.   ).
  272.  
  273.  
  274. %
  275. % ------------------------------------------------------------------------------
  276. %
  277.  
  278.  
  279. tokenize(File) :-
  280.   the_current_file <<- ref(File),
  281.   the_current_line <<- ref(1),
  282.   the_current_column <<- ref(1),
  283.   token_number <<- 0,
  284.   init_string_storage,
  285.   init_tables,
  286.   get(Char),
  287.   the_current_char <<- Char,
  288.   the_token <<- ref(nothing(file => File, line => 1, column => 1,
  289.                             white_spaces => "")),
  290.   the_previous_token <<- ref(get_the_token),
  291.   cond(the_parse_mode :== heavy,
  292.     previous_token.previous <<- previous_token
  293.   ),
  294.   get_single_token,
  295.   the_current_token <<- ref(get_the_token),
  296.   get_single_token,
  297.   the_next_token <<- ref(get_the_token),
  298.   chain_tokens.
  299.  
  300.  
  301. %
  302. % ------------------------------------------------------------------------------
  303. %
  304.  
  305.  
  306. chain_tokens :-
  307.   the_parse_mode :== heavy,
  308.   !,
  309.   cond(previous_token :== nothing,
  310.     the_first_token <<- ref(get_current_token),
  311.     previous_token.next <<- get_current_token
  312.   ),
  313.   current_token.previous <<- previous_token.
  314.  
  315.  
  316. chain_tokens.
  317.  
  318.  
  319. %
  320. % ------------------------------------------------------------------------------
  321. %
  322.  
  323.  
  324. get_single_token :-
  325.   (
  326.     raw_get_single_token,
  327.     token_number <<- token_number + 1,
  328.     cond(token_number :== 20,
  329.       (
  330.         cond(the_error_mode :== talkie,
  331.           write_err(".")
  332.         ),
  333.         token_number <<- 0
  334.       )
  335.     ),
  336.     fail
  337.   ;
  338.     succeed
  339.   ).
  340.  
  341.  
  342. raw_get_single_token :-
  343.   collect_white_spaces(0 => WhiteSpaces, rest => []),
  344.   CurrentColumn = get_current_column,
  345.   (
  346.     get_token,
  347.     !,
  348.     token.line <<- get_current_line,
  349.     token.column <<- CurrentColumn,
  350.     token.file <<- get_current_file,
  351.     cond(the_parse_mode :== heavy,
  352.       token.white_spaces <<- store(WhiteSpaces)
  353.     )
  354.   ;
  355.     the_token <<- ref(nothing(line => get_current_line,
  356.                               column =>  get_current_column, 
  357.                               file => get_current_file,
  358.                               white_spaces => store(WhiteSpaces)))
  359.   ).
  360.  
  361.  
  362. %
  363. % ------------------------------------------------------------------------------
  364. %
  365.  
  366.  
  367. get_next_token :-
  368.   current_token :== nothing,
  369.   !.
  370.  
  371.  
  372. get_next_token :-
  373.   next_token :== nothing,
  374.   !,
  375.   the_current_token <<- ref(next_token).
  376.  
  377.  
  378. get_next_token :-
  379.   the_previous_token <<- ref(current_token),
  380.   the_current_token <<- ref(next_token),
  381.   (
  382.     get_single_token,
  383.     fail
  384.   ;
  385.     succeed
  386.   ),
  387.   (
  388.     token :== nothing,
  389.     !,
  390.     the_next_token <<- ref(token),
  391.     cond(the_parse_mode :== heavy,
  392.       (
  393.         current_token.next <<- next_token,
  394.         next_token.previous <<- current_token,
  395.         next_token.next <<- next_token
  396.       )
  397.     )
  398.   ;
  399.     the_next_token <<- ref(get_the_token)   
  400.   ),
  401.   chain_tokens.
  402.  
  403.  
  404. %
  405. % ------------------------------------------------------------------------------
  406. %
  407.  
  408.  
  409. get_token :-
  410.   alpha(current_char),
  411.   !,
  412.   (
  413.     current_char :== L : asc("L"),
  414.     !,
  415.     read_char,
  416.     (
  417.       current_char :== DoubleQuote : asc(""""),
  418.       !,
  419.       read_char,
  420.       collect_characters(0 => StringOfChars, DoubleQuote, rest => []),
  421.       the_token <<- 
  422.         ref(characters_string(store(StringOfChars), extended => true))
  423.     ;
  424.       current_char :== Quote : asc("'"),
  425.       !,
  426.       read_char,
  427.       collect_characters(0 => Characters, Quote, rest => []),
  428.       the_token <<- ref(character(store(Characters), extended => true))
  429.     ;
  430.       collect_identifier(0 => IdentifierTail, rest => []),
  431.       the_token <<- ref(identifier(store([L | IdentifierTail])))
  432.     )
  433.   ;
  434.     collect_identifier(0 => Identifier, rest => []),
  435.     TheIdentifier = store(Identifier),
  436.     cond(has_feature(keyword, TheIdentifier, KeyWord),
  437.       the_token <<- ref(root_sort(KeyWord)),
  438.       the_token <<- ref(identifier(TheIdentifier))
  439.     )
  440.   ).
  441.  
  442.  
  443. get_token :-
  444.   has_feature(current_char, separators_table, Separator),
  445.   !,
  446.   read_char,
  447.   the_token <<- ref(root_sort(Separator)).
  448.  
  449.  
  450. get_token :-
  451.   has_feature(current_char, operators_table),
  452.   !,
  453.   (
  454.     collect_operator(0 => Operator, rest => []),
  455.     the_token <<- ref(str2psi(string_of(Operator))),
  456.     fail
  457.   ;
  458.     succeed
  459.   ).
  460.  
  461.  
  462. get_token :-
  463.   current_char :== Period : asc("."),
  464.   !,
  465.   read_char,
  466.   (
  467.     current_char :== Period,
  468.     !,
  469.     read_char,
  470.     (
  471.       current_char :== Period,
  472.       !,
  473.       read_char,
  474.       the_token <<- ref(str2psi("..."))      
  475.     ;
  476.       the_token <<- ref('.'),
  477.       report_err(type => warning,
  478.                  message => "Bad operator, replaced by '.'", cause => "..")
  479.     )
  480.   ;
  481.     the_token <<- ref('.')
  482.   ).
  483.  
  484.  
  485. get_token :-
  486.   digit(decimal, current_char),
  487.   !,
  488.   get_numerical_constant.
  489.  
  490.  
  491. get_token :-
  492.   current_char :== DoubleQuote : asc(""""),
  493.   !,
  494.   read_char,
  495.   collect_characters(0 => StringOfChars, DoubleQuote, rest => []),
  496.   the_token <<- ref(characters_string(store(StringOfChars), extended => false)).
  497.  
  498.  
  499. get_token :-
  500.   current_char :== Quote : asc("'"),
  501.   !,
  502.   read_char,
  503.   collect_characters(0 => Characters, Quote, rest => []),
  504.   the_token <<- ref(character(store(Characters), extended => false)).
  505.  
  506.  
  507. get_token :-
  508.   current_char :== end_of_file,
  509.   !,
  510.   fail.
  511.  
  512.  
  513. get_token :-
  514.   report_err(type => error,
  515.              message => "Invalid character", 
  516.              cause => displayable_form_of(current_char)),
  517.   read_char,
  518.   get_token.
  519.  
  520.  
  521. %
  522. % ------------------------------------------------------------------------------
  523. %
  524.  
  525.  
  526. collect_white_spaces -->
  527.   { void_char(current_char) },
  528.   !,
  529.   [get_current_char],
  530.   {
  531.     cond(newline(current_char),
  532.       the_current_line <<- ref(current_line + 1)
  533.     ),
  534.     read_char
  535.   },    
  536.   collect_white_spaces.
  537.  
  538.  
  539. collect_white_spaces -->
  540.   { current_char :== asc("#") },
  541.   !,
  542.   { get_cpp_info },
  543.   collect_white_spaces.
  544.  
  545.  
  546. collect_white_spaces --> [].
  547.  
  548.  
  549. %
  550. % ------------------------------------------------------------------------------
  551. %
  552.  
  553.  
  554. get_cpp_info :-
  555.   read_char,
  556.   skip_blanks, % current_char :== asc(" "), read_char,
  557.   collect_line_number(0 => LineNumber, rest => []),
  558.   the_current_line <<- ref(int_of_digits_list(LineNumber)),
  559.   skip_blanks, % current_char :== asc(" "), read_char,
  560.   current_char :== asc(""""),
  561.   read_char,
  562.   collect_file_name(0 => FileName, rest => []),
  563.   the_current_column <<- ref(1),
  564.   !,
  565.   the_current_file <<- ref(store(FileName)).
  566.  
  567.  
  568. get_cpp_info :-
  569.   report_err(type => error, message => "cpp informations corrupted"),
  570.   fail.  
  571.  
  572.  
  573. %
  574. % ------------------------------------------------------------------------------
  575. %
  576.  
  577.  
  578. collect_line_number -->
  579.   { digit(decimal, current_char) },
  580.   !,
  581.   [get_current_char],
  582.   { read_char },
  583.   collect_line_number.
  584.  
  585.  
  586. collect_line_number --> 
  587.   [].
  588.  
  589.  
  590. %
  591. % ------------------------------------------------------------------------------
  592. %
  593.  
  594.  
  595. collect_file_name -->
  596.   { 
  597.     current_char :== end_of_file,
  598.     !,
  599.     fail
  600.   }.
  601.  
  602.  
  603. collect_file_name -->
  604.   { current_char :== asc("""") },
  605.   !,
  606.   { read_char },
  607.   (
  608.     { skip_blanks },
  609.     { newline(current_char) },
  610.     !,
  611.     { read_char },
  612.     []
  613.   ;
  614.     [asc("""")],
  615.     collect_file_name
  616.   ).
  617.  
  618.  
  619. collect_file_name -->
  620.   [get_current_char],
  621.   { read_char },
  622.   collect_file_name.
  623.  
  624.  
  625. skip_blanks :- current_char :\== asc(" "), !.
  626. skip_blanks :- read_char, skip_blanks.
  627.  
  628. %
  629. % ------------------------------------------------------------------------------
  630. %
  631.  
  632.  
  633. collect_identifier -->
  634.   { alphanum(current_char) },
  635.   !,
  636.   [get_current_char],
  637.   { read_char },
  638.   collect_identifier.
  639.  
  640.  
  641. collect_identifier -->
  642.   [].
  643.  
  644.  
  645. %
  646. % ------------------------------------------------------------------------------
  647. %
  648.  
  649.  
  650. collect_operator -->
  651.   { FirstChar = get_current_char },
  652.   { read_char },
  653.   [FirstChar],
  654.   { SecondChar = get_current_char },
  655.   (
  656.     { FirstChar :== SecondChar },
  657.     !,
  658.     (
  659.       { has_feature(FirstChar, duplicatable_operators_table) },
  660.       !,
  661.       [FirstChar],
  662.       { read_char },
  663.       (
  664.         { FirstChar :== {asc("<"); asc(">")} },
  665.         !,
  666.         { ThirdChar = get_current_char },
  667.         ( 
  668.           { ThirdChar :== asc("=") },
  669.           !,
  670.           [asc("=")],
  671.           { read_char }
  672.         ;
  673.           []
  674.         )
  675.       ;
  676.         []
  677.       )
  678.     ;
  679.       []
  680.     )
  681.   ;
  682.     (
  683.       { SecondChar :== asc("=") },
  684.       !,
  685.       (
  686.         { has_feature(FirstChar, combinable_operators_table) },
  687.         !,
  688.         [asc("=")],
  689.         { read_char }
  690.       ;
  691.         []
  692.       )
  693.     ;
  694.       (
  695.         { FirstChar :== asc("-") },
  696.         !,
  697.         (
  698.           { SecondChar :== asc(">") },
  699.           !,
  700.           [asc(">")],
  701.           { read_char }
  702.         ;
  703.           []
  704.         )
  705.       ;
  706.         []
  707.       )
  708.     )
  709.   ).
  710.  
  711.  
  712. %
  713. % ------------------------------------------------------------------------------
  714. %
  715.  
  716.  
  717. collect_characters(TerminationChar) -->
  718.   { current_char :== asc("\") },
  719.   !,
  720.   { read_char },
  721.   cond(current_char :== end_of_file,
  722.     { 
  723.       report_err(type => error,
  724.                  message => "End of file found when parsing a character constant")
  725.     },
  726.     (
  727.       [escape_char(get_current_char)],
  728.       { read_char },
  729.       collect_characters(TerminationChar)
  730.     )
  731.   ).
  732.  
  733.  
  734. collect_characters(TerminationChar) -->
  735.   { current_char :== TerminationChar },
  736.   !,
  737.   { read_char }.
  738.  
  739.  
  740. collect_characters(TerminationChar) -->
  741.   { current_char :== end_of_file },
  742.   !,
  743.   {
  744.     report_err(type => error,
  745.                message => "End of file found when parsing a character constant")
  746.   }.
  747.  
  748.  
  749. collect_characters(TerminationChar) -->
  750.   { newline(current_char) },
  751.   !,
  752.   {
  753.     report_err(type => error, message => "Non terminated character constant")
  754.   }.
  755.  
  756.  
  757. collect_characters(TerminationChar) -->
  758.   [get_current_char],
  759.   { read_char },
  760.   collect_characters(TerminationChar).
  761.  
  762.  
  763. %
  764. % ------------------------------------------------------------------------------
  765. %
  766.  
  767.  
  768. escape_char(110) -> 10.
  769.  
  770. escape_char(116) -> 9.
  771.  
  772. escape_char(118) -> 11.
  773.  
  774. escape_char(98) -> 8.
  775.  
  776. escape_char(114) -> 13.
  777.  
  778. escape_char(102) -> 12.
  779.  
  780. escape_char(97) -> 7.
  781.  
  782. escape_char(92) -> asc("\").
  783.  
  784. escape_char(63) -> asc("?").
  785.  
  786. escape_char(39) -> asc("'").
  787.  
  788. escape_char(34) -> asc("""").
  789.  
  790. escape_char(120) -> ReturnedChar
  791.   | read_char,
  792.     First = get_current_char,
  793.     read_char,
  794.     Second = get_current_char,
  795.     (
  796.       digit(hexadecimal, First),
  797.       digit(hexadecimal, Second),
  798.       Char = hex2dec([First, Second]),
  799.       Char < 256,
  800.       !,
  801.       ReturnedChar = Char
  802.     ;
  803.       report_err(type => warning, message => "Bad escape sequence",
  804.                  cause => "x"),
  805.       ReturnedChar = 0
  806.     ).
  807.     
  808.  
  809. escape_char(Digit1) -> ReturnedChar
  810.   | (
  811.       read_char,
  812.       Digit2 = get_current_char,
  813.       read_char,
  814.       Digit3 = get_current_char,
  815.       digit(octal, Digit1),
  816.       digit(octal, Digit2),
  817.       digit(octal, Digit3),
  818.       Char = oct2dec([Digit1, Digit2, Digit3]),
  819.       Char < 256,
  820.       !,
  821.       ReturnedChar = Char
  822.     ;
  823.       report_err(type => warning, message => "Bad escape sequence",
  824.                  cause => Char),
  825.       ReturnedChar = 0
  826.     ).
  827.  
  828.  
  829. %
  830. % ------------------------------------------------------------------------------
  831. %
  832.  
  833.  
  834. get_numerical_constant :-
  835.   (
  836.     current_char :== asc("0"),
  837.     !,
  838.     read_char,
  839.     (
  840.       current_char :== {asc("x"); asc("X")},
  841.       !,
  842.       read_char,
  843.       get_integer(hexadecimal)
  844.     ;
  845.       collect_integer(decimal, 0 => IntegerTail, rest => []),
  846.       Integer = [asc("0") | IntegerTail],
  847.       get_numerical_constant_tail(Integer)
  848.     )
  849.   ;
  850.     collect_integer(decimal, 0 => Integer, rest => []),
  851.     get_numerical_constant_tail(Integer)
  852.   ).
  853.  
  854.  
  855. %
  856. % ------------------------------------------------------------------------------
  857. %
  858.  
  859.  
  860. get_numerical_constant_tail(Integer) :-
  861.   (
  862.     current_char :== {asc("."); asc("e"); asc("E")},
  863.     !,
  864.     (
  865.       current_char :== asc("."),
  866.       !,
  867.       read_char,
  868.       collect_integer(decimal, 0 => DecimalPart, rest => []),
  869.       cond(DecimalPart :== [],
  870.         (
  871.           report_err(type => error, 
  872.                      message => "No decimal part for float value"),
  873.           store([asc("0")]) = StoredDecimalPart
  874.         ),
  875.         store(DecimalPart) = StoredDecimalPart
  876.       ),
  877.       (
  878.         current_char :== {asc("e"); asc("E")},
  879.         !,
  880.         read_char,
  881.         collect_exponential_part(Sign, ExponentialPart),
  882.         cond(ExponentialPart :== [],
  883.           store([asc("0")]) = StoredExponentialPart,
  884.           store(ExponentialPart) =  StoredExponentialPart
  885.         )      
  886.       ;
  887.         store([asc("0")]) = StoredExponentialPart,
  888.         Sign = positive
  889.       )
  890.     ;
  891.       current_char :== {asc("e"); asc("E")},
  892.       !,
  893.       read_char,
  894.       store([asc("0")]) = StoredDecimalPart,
  895.       collect_exponential_part(Sign, ExponentialPart),
  896.       cond(ExponentialPart :== [],
  897.         store([asc("0")]) = StoredExponentialPart,
  898.         store(ExponentialPart) = StoredExponentialPart
  899.       )        
  900.     ),
  901.     store(Integer) = StoredInteger,
  902.     collect_suffix(0 => Suffix, rest => []),
  903.     scan_float_suffix(Suffix, Type),
  904.     the_token <<- ref(number(float(integer_part => StoredInteger,
  905.                                    decimal_part => StoredDecimalPart,
  906.                                    exponential_part => 
  907.                                      exponential_part(value => StoredExponentialPart,
  908.                                                       sign => Sign),
  909.                                    type => Type)))
  910.   ;
  911.     (
  912.       Integer = [asc("0")],
  913.       !,
  914.       TheInteger = Integer,
  915.       Base = decimal
  916.     ;
  917.       Integer = [asc("0") | OctalNumber],
  918.       !,
  919.       scan_octal_number(OctalNumber, NewOctalNumber),
  920.       TheInteger = NewOctalNumber,
  921.       Base = octal
  922.     ;
  923.       TheInteger = Integer,
  924.       Base = decimal
  925.     ),
  926.     store(TheInteger) = StoredInteger,
  927.     collect_suffix(0 => Suffix, rest => []),
  928.     scan_integer_suffix(Suffix, Long, Signed),    
  929.     the_token <<- ref(number(integer(StoredInteger, base => Base, 
  930.                                      signed => Signed, long => Long)))
  931.   ).
  932.  
  933.  
  934. %
  935. % ------------------------------------------------------------------------------
  936. %
  937.  
  938.  
  939. scan_octal_number([], []) :- !.
  940.  
  941.  
  942. scan_octal_number([Digit | Digits], [Digit | NewDigits]) :-
  943.   digit(octal, Digit),
  944.   !,
  945.   scan_octal_number(Digits, NewDigits).
  946.  
  947.  
  948. scan_octal_number([Digit | Digits], NewDigits) :-
  949.   report_err(type => warning, message => strcon(chr(Digit), " is not octal")),
  950.   scan_octal_number(Digits, NewDigits).
  951.  
  952.  
  953. %
  954. % ------------------------------------------------------------------------------
  955. %
  956.  
  957.  
  958. get_integer(Base) :-
  959.   collect_integer(Base, 0 => Integer, rest => []),
  960.   (
  961.     Integer :== [],
  962.     !,
  963.     report_err(type => error, message => "Bad integer value"),
  964.     store([asc("0")]) =  StoredInteger
  965.   ;
  966.     store(Integer) = StoredInteger
  967.   ),
  968.   collect_suffix(0 => Suffix, rest => []),
  969.   scan_integer_suffix(Suffix, Long, Signed),
  970.   the_token <<- ref(number(integer(StoredInteger, base => Base, signed => Signed, 
  971.                            long => Long))).
  972.  
  973.  
  974. %
  975. % ------------------------------------------------------------------------------
  976. %
  977.  
  978.  
  979. collect_integer(Base) --> 
  980.   { digit(Base, current_char) },
  981.   !,
  982.   [get_current_char],
  983.   { read_char },
  984.   collect_integer(Base).
  985.  
  986.  
  987. collect_integer(Base) --> [].
  988.  
  989.  
  990. %
  991. % ------------------------------------------------------------------------------
  992. %
  993.  
  994.  
  995. collect_exponential_part(Sign, ExponentialPart) :-
  996.   (
  997.     current_char :== asc("+"),
  998.     !,
  999.     read_char,
  1000.     ReadSign = positive
  1001.   ;
  1002.     current_char :== asc("-"),
  1003.     !,
  1004.     read_char,
  1005.     ReadSign = negative
  1006.   ;
  1007.     ReadSign = positive
  1008.   ),
  1009.   collect_integer(decimal, 0 => ExponentialPart, rest => []),
  1010.   cond(ExponentialPart :== [],
  1011.     (
  1012.       report_err(type => error,
  1013.                  message => "No exponential part for float value"),
  1014.       Sign = positive
  1015.     ),
  1016.     Sign = ReadSign
  1017.   ).
  1018.  
  1019.  
  1020. %
  1021. % ------------------------------------------------------------------------------
  1022. %
  1023.  
  1024.  
  1025. collect_suffix -->
  1026.   { alphanum(current_char) },
  1027.   !,
  1028.   [get_current_char],
  1029.   { read_char },
  1030.   collect_suffix.
  1031.  
  1032.  
  1033. collect_suffix --> [].
  1034.  
  1035.  
  1036. %
  1037. % ------------------------------------------------------------------------------
  1038. %
  1039.  
  1040.  
  1041. scan_integer_suffix([Suffix | LSuffixes], Long, Signed) :-
  1042.   Suffix :== {asc("u"); asc("U")},
  1043.   !,
  1044.   cond(Signed :== @,
  1045.     Signed = false,
  1046.     report_err(type => warning, message => "Redundant suffix 'u'")
  1047.   ),
  1048.   scan_integer_suffix(LSuffixes, Long, Signed).
  1049.  
  1050.  
  1051. scan_integer_suffix([Suffix | LSuffixes], Long, Signed) :-
  1052.   Suffix :== {asc("l"); asc("L")},
  1053.   !,
  1054.   cond(Long :== @,
  1055.     Long = true,
  1056.     report_err(type => warning, message => "Redundant suffix 'l'")
  1057.   ),
  1058.   scan_integer_suffix(LSuffixes, Long, Signed).
  1059.  
  1060.  
  1061. scan_integer_suffix([Suffix | LSuffixes], Long, Signed) :-
  1062.   !,
  1063.   report_err(type => warning, message => "Garbage suffix", cause => Suffix),
  1064.   scan_integer_suffix(LSuffixes, Long, Signed).
  1065.  
  1066.  
  1067. scan_integer_suffix([], Long, Signed) :-
  1068.   cond(Long :== @,
  1069.     Long = false
  1070.   ),
  1071.   cond(Signed :== @,
  1072.     Signed = true
  1073.   ).
  1074.  
  1075.  
  1076. %
  1077. % ------------------------------------------------------------------------------
  1078. %
  1079.  
  1080.  
  1081. scan_float_suffix([Suffix | LSuffixes], Type) :-
  1082.   Suffix :== {asc("l"); asc("L")},
  1083.   !,
  1084.   cond(Type :== @,
  1085.     Type = long_double,
  1086.     cond(Type :== float,
  1087.       report_err(type => warning, message => "Incompatible suffix 'l'"),
  1088.       report_err(type => warning, message => "Redundant suffix 'l'")
  1089.     )
  1090.   ),
  1091.   scan_float_suffix(LSuffixes, Type).
  1092.  
  1093.  
  1094. scan_float_suffix([Suffix | LSuffixes], Type) :-
  1095.   Suffix :== {asc("f"); asc("F")},
  1096.   !,
  1097.   cond(Type :== @,
  1098.     Type = float,
  1099.     cond(Type :== long,
  1100.       report_err(type => warning, message => "Incompatible suffix 'f'"),
  1101.       report_err(type => warning, message => "Redundant suffix 'f'")
  1102.     )
  1103.   ),
  1104.   scan_float_suffix(LSuffixes, Type).
  1105.  
  1106.  
  1107. scan_float_suffix([Suffix | LSuffixes], Type) :-
  1108.   !,
  1109.   report_err(type => warning, message => "Garbage suffix", cause => Suffix),
  1110.   scan_float_suffix(LSuffixes, Type).
  1111.  
  1112.  
  1113. scan_float_suffix([], Type) :-
  1114.   cond(Type :== @,
  1115.     Type = double
  1116.   ).
  1117.  
  1118.  
  1119. %
  1120. % ------------------------------------------------------------------------------
  1121. %
  1122.  
  1123.  
  1124.  
  1125.  
  1126.