;; -*- Hen -*-
;;
;; The lexical analyzer for Ersatz.
;;
;; Based on the Jingoo library by Masaki WATANABE.
;;
;; Copyright 2012-2013 Ivan Raikov and the Okinawa Institute of
;; Science and Technology.
;;
;; This program 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 3 of the
;; License, or (at your option) any later version.
;;
;; This program 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.
;;
;; A full copy of the GPL license can be found at
;; .
;;
;;
;; This procedure generates a textual lexer description in the format
;; required by SILex.
;;
(define (make-ersatz-lexer output-port
#!key
(begin-comment "{#")
(end-comment "#}")
(begin-expand "{{")
(end-expand "}}")
(begin-logic "{%")
(end-logic "%}")
)
(let ((begin-comment-len (string-length begin-comment))
(end-comment-len (string-length end-comment)))
(fprintf output-port #<string cs)) ]
[else (loop (cons c cs))])))
))
"\'" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display #\' (lexer-text-buffer))
(yycontinue))
(else
(let loop ([cs '()])
(let ([c (yygetc)])
(cond [(eq? 'eof c) (lexer-error "unexpected end of string constant")]
[(char=? c #\\) (let ((n (yygetc)))
(loop (cons n cs)))]
[(char=? c #\') (tok yyline STRING (reverse-list->string cs)) ]
[else (loop (cons c cs))])))
))
"\n" (begin
(display #\newline (lexer-text-buffer))
(yycontinue))
{intlit} (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(begin
(display yytext (lexer-text-buffer))
(yycontinue)))
(else
(tok yyline INT (string->number yytext)))
)
{floatlit} (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(begin
(display yytext (lexer-text-buffer))
(yycontinue)))
(else
(let ((n (string-length yytext)))
(tok yyline FLOAT (string->number
(substring yytext 0 n)))))
)
{identfst}{identchr}* (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(begin
(display yytext (lexer-text-buffer))
(yycontinue)))
(else
(let*
((word (string->symbol yytext))
(t (alist-ref word lexer-keywords)))
(if t (tok yyline ,t)
(tok yyline IDENT word))))
)
"==" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(tok yyline EQEQ)))
"**" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(tok yyline POWER)))
"||" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(tok yyline OR)))
"&&" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(tok yyline AND)))
"!=" (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(tok yyline NEQ)))
. (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(display yytext (lexer-text-buffer))
(yycontinue))
(else
(let* ((word yytext)
(t (find-operator word lexer-operators )))
(case (car t)
((full) (tok yyline ,(cadr t)))
((partial) (let ((c (yygetc)))
(if (char=? c (string-ref (cadr t) 1))
(tok yyline ,(caddr t))
(begin (yyungetc)
(tok yyline IDENT (string->symbol word))
))
))
(else (if (char-set-contains? char-set:whitespace (string-ref word 0))
(yycontinue)
(tok yyline IDENT (string->symbol word))))
))
))
<> (cases lexer-mode (lexer-curmode)
(LexerPlain ()
(let ((text (lexer-get-text)))
(if (string-null? text)
'*eoi*
(tok yyline TEXT text)
)))
(else (lexer-error "unexpected end of input (lexer)")))
EOF
)))