142 lines
3.4 KiB
Plaintext
142 lines
3.4 KiB
Plaintext
(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)
|