// // Copyright (C) 1999, 2000 Refal+ Development Group // // Refal+ is free software; you can redistribute it and/or modify // it under the terms of the GNU General Public License as published by // the Free Software Foundation; either version 2 of the License, or // (at your option) any later version. // // Refal+ is distributed in the hope that it will be useful, // but WITHOUT ANY WARRANTY; without even the implied warranty of // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the // GNU General Public License for more details. // // You should have received a copy of the GNU General Public License // along with Refal+; if not, write to the Free Software // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA // // $Source$ // $Revision$ // $Date$ // Author: Andrey Slepuhin // synhl.rfi $use "rfp_src" ; // rfp_src.rfi $use StdIO ; $use Box ; $use Dos ; $use Arithm ; $use Class ; $use Access ; $use Compare ; $use Convert ; $use Table ; $box Source ; $box Position ; $box Mode ; $func RFP-Error (e.pos) (e.message) = ; $func RFP-Warning (e.pos) (e.message) = ; $func? Get-Source-Line = e.line ; $func Scan-Token e.line = (e.tokens) (e.new-line) ; $func Scan-Tokens s.start e.line = e.tokens ; $func? Blank? s.char = ; $func? Skip-Blank e.line = e.new-line ; $func Next-Column = ; $func Next-Row = ; $func? Uppercase-Letter? s.letter = ; $func Token-Position = e.position; $func? Scan-Number? e.line = (e.num) (e.new-line) ; $func Scan-Number-Rest (e.start) (e.line) = (e.num) (e.new-line) ; $func? Scan-Keyword? e.line = (e.token) (e.new-line) ; $func Scan-Keyword-Rest (e.start) (e.line) = (e.keyword) (e.new-line) ; $func? Scan-Variable? e.line = (e.token) (e.new-line) ; $func? Scan-Identifier? e.line = (e.token) (e.new-line) ; $func Scan-Identifier-Rest (e.start) (e.line) = (e.word) (e.new-line) ; $func? Scan-Word? e.line = (e.token) (e.new-line) ; $func? Scan-String? e.line = (e.token) (e.new-line) ; $func Scan-String-Rest (e.start) (e.line) s.term = (e.string) (e.new-line) ; $func? Skip-Comment e.line = e.new-line ; $func Start-Table = ; $func Finish-Table = ; $func Start-Row = ; $func Finish-Row = ; $func Start-Cell e = ; $func Finish-Cell = ; Main = :: e.filename, { e.filename : v = ; ; } :: e.source, , , , , , ; Start-Table = // ">, // ">, ">; Finish-Table = ">; // ">, // ">; Start-Row = ">; Finish-Row = ">; Start-Cell e.x = ">; Finish-Cell = ">; Scan-Tokens s.start e.line = :: (e.t) (e.line), //, e.t : { ((e) (EOF)) = , ; ((e) (EQUAL)) = , , , , , , ; ((e) (VAR e.value)) = { s.start : T = ;; }, ' e.value ''>, ; ((e) (LINE)) = , , , ; ((e) (s.type e.value)) = { s.type : LPAREN = '>; s.type : RPAREN = '>; s.type : LBRACKET = '>, ; s.type : WORD, : = '>; ; }, , { s.type : LPAREN = '>; s.type : RPAREN = '>; s.type : RBRACKET = '>, ; s.type : WORD, : = '>; ; }, ; }; Scan-Token e.line = e.line : { = { :: e.line, { e.line : = ((() (LINE))) (); ; }; ((() (EOF))) (); }; s.char e.rest = :: e.saved-position, { = , ; s.char : \{ '(' = LPAREN '('; ')' = RPAREN ')'; '[' = LBRACKET '['; ']' = RBRACKET ']'; '|' = BAR; } :: e.tk = , (((e.saved-position) (e.tk))) (e.rest); s.char : \{ ':' = , { e.rest : ':=' e.rest2 = , , (((e.saved-position) (EQUAL))) (e.rest2); }; '/' = , e.rest : \{ '/' e.rest2 = ; '*' e.rest2 = >; s.err e.rest2 = ) ("Invalid character \'" s.err "\'")>, , ; = ) ("Unexpected end of line")>, ; }; }; \{ ; ; ; ; ; ; } :: (e.tk) (e.new-line), (((e.saved-position) (e.tk))) (e.new-line); ) ("Invalid character \'" s.char "\'")>, , ; }; }; Get-Source-Line = > :: e.line, , e.line; Blank? s.char = ' \n\t' : e s.char e; Skip-Blank e.line = e.line : { = >; s.char e.rest = { = , ; e.line; }; }; Scan-Keyword? '$' e.rest = , :: (e.ident) (e.line), e.ident : { '$box' = BOX; '$channel' = CHANNEL; '$const' = CONST; '$error' = ERROR; '$fail' = FAIL; '$func' = FUNC; '$func?' = FUNC?; '$iter' = ITER; '$l' = L; '$r' = R; '$string' = STRING; '$table' = TABLE; '$trace' = TRACE; '$traceall' = TRACEALL; '$trap' = TRAP; '$use' = USE; '$vector' = VECTOR; '$with' = WITH; } :: s.key, (s.key) (e.line); Scan-Keyword-Rest (e.start) (e.line) = (e.start) (e.line) T $iter { e.l : s.first e.rest, \{ ; s.first : \{ '?'; '!'; }; }, , (e.w s.first) (e.rest) T; (e.w) (e.l) F; } :: (e.w) (e.l) s.cond, s.cond : F, (e.w) (e.l) ; Scan-Variable? e.line = e.line : s.first e.rest, s.first : \{ 's', VAR 's'; 'e', VAR 'e'; 'v', VAR 'v'; 't', VAR 't'; } :: s.type s.pfx, , { e.rest : '.' e.rest2 = , ; ; } :: (e.name) (e.new-line), { e.name : = (s.type) (e.new-line); (s.type s.pfx '.' e.name) (e.new-line); }; Scan-Number? e.line = e.line : s.first e.rest, \{ \{ ; s.first : \{ '+'; '-'; }; }, , :: (e.num) (e.rest), (NUMBER )(e.rest); }; Scan-Number-Rest (e.start) (e.line) = { e.line : '\\' = )>; (e.start) (e.line) T $iter { e.l : s.first e.rest, , , (e.w s.first) (e.rest) T; (e.w) (e.l) F; } :: (e.w) (e.l) s.cond, s.cond : F, (e.w) (e.l) ; }; Scan-Identifier? e.line = e.line : s.first e.rest, \{ \{ ; s.first : \{ '?'; '!'; }; }, , :: (e.word) (e.rest), (WORD e.word) (e.rest); }; Scan-Identifier-Rest (e.start) (e.line) = (e.start) (e.line) T $iter { e.l : s.first e.rest, \{ ; ; s.first : \{ '?'; '!'; '-'; '.'; }; }, , (e.w s.first) (e.rest) T; (e.w) (e.l) F; } :: (e.w) (e.l) s.cond, s.cond : F, (e.w) (e.l) ; Scan-Word? e.line = e.line : '\"' e.rest, \{ , :: (e.word) (e.rest), (WORD e.word) (e.rest); }; Scan-String? e.line = e.line : '\'' e.rest, \{ , :: (e.str) (e.rest), (SYMBOLS e.str) (e.rest); }; Scan-String-Rest (e.start) (e.line) s.term = (e.start) (e.line) T $iter { e.l : s.first e.rest, , s.first : { s.term = (e.s) (e.rest) F; '\\' = { e.rest : s.first2 e.rest2, , s.first2 : \{ 't' = (e.s '\t') (e.rest2) T; 'n' = (e.s '\n') (e.rest2) T; 'r' = (e.s '\r') (e.rest2) T; '\\' = (e.s '\\') (e.rest2) T; '\'' = (e.s '\'') (e.rest2) T; '\"' = (e.s '\'') (e.rest2) T; s = ) ("Unknown control sequence \'\\" s.first2 "\'")>, (e.s s.first2) (e.rest2) T; }; (e.s) () T; ) (Error "Unterminated string detected")>, (e.s) () F; }; s = (e.s s.first) (e.rest) T; }; (e.s '\n') () T; ) ("Unterminated string detected")>, (e.s) () F; } :: (e.s) (e.l) s.cond, s.cond : F, (e.s) (e.l) ; Skip-Comment e.line = { e.line : e1 '*/' e.rest = e.rest ; >; ) ("Unexpected end of file")>; }; Next-Column = >>; Next-Row = >>; Uppercase-Letter? s.letter = , <"=" () (s.letter)>; Token-Position = ; RFP-Error (s.row s.column) (e.message) = ; RFP-Warning (s.row s.column) (e.message) = ;