gash/mes/gash.mes

(mes-use-module (mes fluids))
(mes-use-module (mes lalr))
(mes-use-module (mes match))
(mes-use-module (mes scm))
(mes-use-module (srfi srfi-1))
(mes-use-module (srfi srfi-8))
(mes-use-module (srfi srfi-9))
(mes-use-module (srfi srfi-14))
(mes-use-module (srfi srfi-26))



;; Stuff for the lexer.


;; SRFI 14 extras

(define (char-set-union . css)
  (apply lset-union equal? css))

(define (char-set-intersection . css)
  (apply lset-intersection equal? css))

(define char-set:ascii
  (list->char-set (map integer->char (iota 128))))

(define char-set:letter
  (char-set-union char-set:upper-case char-set:lower-case))

(define char-set:letter+digit
  (char-set-union char-set:letter char-set:digit))

(define char-set:blank
  (char-set #\tab #\space))


;; Parameters

;; This is cute, but maybe a record would be better.
(define *fluid-accessor* (list 'fluid-accessor))

(define (make-parameter init)
  (define fluid (make-fluid init))
  (lambda args
    (if (null? args)
        (fluid-ref fluid)
        (let ((new-value (car args)))
          (if (eq? new-value *fluid-accessor*)
              fluid
              (let ((old-value (fluid-ref fluid)))
                (fluid-set! new-value)
                old-value))))))

(define-syntax-rule (parameterize ((param value) ...) body ...)
  (with-fluids (((param *fluid-accessor*) value) ...) body ...))


;; Input shims

(define-record-type <soft-input-port>
  (make-soft-input-port thunk buffer)
  soft-input-port?
  (thunk soft-input-port-thunk)
  (buffer soft-input-port-buffer set-soft-input-port-buffer!))

(define (make-soft-port pv modes)
  (unless (equal? modes "r")
    (error "Soft ports must have mode \"r\""))
  (make-soft-input-port (vector-ref pv 3) '()))

(define (push-soft-input-port-buffer! sip char)
  (let ((buffer (soft-input-port-buffer sip)))
    (set-soft-input-port-buffer! sip (cons char buffer))))

(define (pop-soft-input-port-buffer! sip)
  (let* ((buffer (soft-input-port-buffer sip))
         (result (car buffer)))
    (set-soft-input-port-buffer! sip (cdr buffer))
    result))

(define-syntax-rule (with-input-port port body ...)
  (let ((old-port (current-input-port)))
    (set-current-input-port port)
    (let ((result (begin body ...)))
      (set-current-input-port old-port)
      result)))

(define (get-char port)
  (if (soft-input-port? port)
      (let ((thunk (soft-input-port-thunk port))
            (buffer (soft-input-port-buffer port)))
        (if (null? buffer)
            (thunk)
            (pop-soft-input-port-buffer! port)))
      (with-input-port port (read-char))))

(define (unget-char port char)
  (if (soft-input-port? port)
      (push-soft-input-port-buffer! port char)
      (with-input-port port (unread-char char))))

(define (lookahead-char port)
  (let ((result (get-char port)))
    (unget-char port result)
    result))

(define (set-port-line! port line)
  #f)


;; String funtions

(define (string-every pred str)
  (every pred (string->list str)))


;; Misc. fixes

(define-syntax-rule (define-inlinable stuff ...)
  (define stuff ...))



;; Stuff for the parser

(define the-eof-object (integer->char -1))

(define (noop . args) #f)


;; Main show

(include-from-path "gash/lexer.scm")
(include-from-path "gash/parser.scm")

;; XXX: Mes module loading seems to bork reading from stdin.
(set-current-input-port
 (open-input-file "/home/samplet/code/gash/mes/test.sh"))

(write (read-sh-all))
(newline)