#!/usr/bin/guile \
-e "(scripts lexer-repl)" -s
!#
;;; lexer-repl --- lexical scanner read-eval-print loop

;; 	Copyright (C) 2003,2004,2005 Free Software Foundation, Inc.
;;
;; 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 2, 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.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of GUILE.
;;
;; The exception is that, if you link the GUILE library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the GUILE library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name GUILE.  If you copy
;; code from other Free Software Foundation releases into a copy of
;; GUILE, as the General Public License permits, the exception does
;; not apply to the code that you add in this way.  To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for GUILE, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.

;;; Author: Thien-Thi Nguyen <ttn@gnu.org>

;;; Commentary:

;; Usage: lexer-repl [--emacs] [--offset N] input spec
;;
;; lexer-repl provides a read-eval-print loop specialized for lexical
;; analysis of the INPUT file using a grammar specified in the SPEC
;; file.  The SPEC file is regular Guile scheme code that also defines a
;; grammar, and calls `set-LEXER-SPEC!' with it.
;;
;; The INPUT file should be in a format that can be analyzed using the
;; spec (otherwise you may see many errors!).  Option "--emacs" means
;; don't show a prompt but instead echo the input in a way suitable for
;; feeding to Emacs' `read' function.  Option "--offset N" means to
;; ignore the first N characters.
;;
;; Usage from a Scheme program:
;;  (lexer-repl under-emacs? lexer inp)
;;
;; If UNDER-EMACS? is non-#f, lexer-repl does not display a prompt,
;; but instead displays, after input, a "pseudo-prompt" followed by
;; the input, designed to be comment-like (transparent) to the `read'
;; function in emacs.  LEXER is a lexical analyzer conforming to that
;; returned by `make-lexer' in module (lang lex).  INP is an input
;; port conforming to that returned by `make-line-buffering-input-port'
;; in module (ice-9 lineio).  This port is used to read the INPUT file,
;; and should not be confused w/ current-input-port, from which commands
;; are read.
;;
;; Commands:
;;
;; (next) --- Display the next lexeme to stdout followed by newline.
;;            Lexemes have the form: (LENGTH NAME MATCHED-INPUT)
;;            where NAME is a symbol, MATCHED-INPUT is a string and
;;            LENGTH is the count of characters in the string.  The
;;            spec file may arrange to omit MATCHED-INPUT by using
;;            a "procedure action".  For example, given the rules:
;;
;;              ("<<"  double-less-than)
;;              ("--"  ,(lambda ignored 'double-dash))
;;              (">>"  ,(lambda ignored '(double-greater)))
;;
;;            and given input ">>--<<", lexer-repl displays:
;;
;;              (2 double-greater)
;;              (2 . double-dash)
;;              (2 double-less-than "<<")
;;
;;            on three subsequent invocations of the `(next)' command.
;;
;; (quit) --- Quit the repl.
;;
;; TODO:
;;  - Add "--stop N" option.
;;  - Add commands to examine/reset stats.

;;; Code:

(define-module (scripts lexer-repl)
  #:autoload (scripts PROGRAM) (HVQC-MAIN)
  #:use-module (ice-9 lineio)
  #:use-module (lang lex)
  #:export (lexer-repl
            set-LEXER-SPEC!))

(define LEXER-SPEC #f)

(define (set-LEXER-SPEC! spec)
  (set! LEXER-SPEC spec))

(define (rewrite-spec-actions spec-set)
  (map (lambda (orig-spec)
         (let* ((spec (list-copy orig-spec)) ; be safe
                (action (cadr spec)))
           (set-car! (cdr spec)
                     (cond ((procedure? action)
                            (lambda (s port)
                              (cons (string-length s)
                                    (action s port))))
                           ((symbol? action)
                            (lambda (s port)
                              (list (string-length s) action s)))
                           (else
                            (error "bad spec action:" action))))
           spec))
       spec-set))

(define (consume-trailing-whitespace)   ; from ice-9/boot-9/running-repls.scm
  (let ((ch (peek-char)))
    (cond
     ((eof-object? ch))
     ((or (char=? ch #\space) (char=? ch #\tab))
      (read-char)
      (consume-trailing-whitespace))
     ((char=? ch #\newline)
      (read-char)))))

(define (lexer-repl under-emacs? lexer inp)
  (let ((next (lambda () (lexer inp))))
    (error-catching-repl
     (lambda ()                         ; read
       (or under-emacs?
           (simple-format #t ";-(:-) ")
           (flush-all-ports))
       (read))
     (lambda (form)                     ; eval
       (and under-emacs? (simple-format #t ";-(:-) ~A\n" form))
       (cond ((equal? '(quit) form)
              (newline)
              (quit))
             ((equal? '(next) form)
              (map (if under-emacs?
                       (lambda (x)
                         ;; for emacs
                         (cond ((eq? #t x) 't)
                               ((eq? #f x) 'nil)
                               (else x)))
                       identity)
                   (next)))
             (else
              (simple-format #f ";;; bad input: ~A" form))))
     (lambda (x)                        ; print
       (simple-format #t (if (string? x)
                             "~A\n"
                             "~S\n")
                      x))))
  (simple-format #t ";;; bye\n")
  (consume-trailing-whitespace))

(define (lexer-repl/qop qop)
  (let ((input-file (false-if-exception (car (qop '()))))
        (spec-file (false-if-exception (cadr (qop '())))))
    (or (and input-file spec-file)
        (error "lexer-repl: must specify input and spec files"))
    (simple-format #t ";;; input-file: ~A\n;;; spec-file: ~A\n"
                   input-file spec-file)
    (load spec-file)
    (if LEXER-SPEC
        (simple-format #t ";;; ~A rules in LEXER-SPEC\n" (length LEXER-SPEC))
        (error "lexer-repl: spec file did not set LEXER-SPEC"))
    (let ((inp (make-line-buffering-input-port
                (open-input-file input-file))))
      (qop 'offset
           (lambda (n-str)
             (let loop ((n (string->number n-str)))
               (or (= 0 n)
                   (begin
                     (read-char inp)    ; discard
                     (loop (1- n)))))))
      (lexer-repl (qop 'emacs)
                  (make-lexer (rewrite-spec-actions LEXER-SPEC))
                  inp)
      (close-port inp))))

(define (main args)
  (HVQC-MAIN args lexer-repl/qop
             '(usage . commentary)
             '(package . "Guile")
             '(option-spec (offset (single-char #\o)
                                   (value #t))
                           (emacs))))

;;; lexer-repl ends here
