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))


;; 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)))


;; Prompts

(define* (make-prompt-tag #:optional (stem "prompt"))
  (list stem))


;; Misc. fixes

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

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

(define (noop . args) #f)

(define (alist->hash-table alist)
  (define ht (make-hash-table 100))
  (fold-right (lambda (kvp acc)
                (hash-set! ht (car kvp) (cdr kvp)))
              #f
              alist)
  ht)

;; FIXME: Actually do somrething here.
(define (canonicalize-path path) path)

;; Shadow these so that optional arguments work.
(define mes-make-hash-table make-hash-table)
(define mes-hash-ref hash-ref)
(define* (make-hash-table #:optional (size 0))
  (mes-make-hash-table size))
(define* (hash-ref table key #:optional dflt)
  (mes-hash-ref table key dflt))

(define X_OK 1)

(define program-arguments command-line)

(define (hash-fold proc init table)
  (define (proc* kvp acc)
    (proc (car kvp) (cdr kvp) acc))
  (define buckets (struct-ref table 4))
  (let loop ((k 0) (acc init))
    (if (>= k (vector-length buckets))
        acc
        (let ((bucket (vector-ref buckets k)))
          (loop (1+ k)
                (if (pair? bucket)
                    (fold proc* acc bucket)
                    acc))))))

(define delete-duplicates! delete-duplicates)

;; Mes does not have port buffers.
(define flush-all-ports noop)

;; Mes uses raw file descriptors for file ports.
(define file-port? number?)

;; This is probably OK....
(define (input-port? port) #f)
(define (output-port? port) #f)

;; More interface adjustments.
(define mes-dup dup)
(define* (dup fd #:optional new)
  (if new (dup2 fd new) (dup fd)))


;; Main show

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

;; These should come from (gash built-ins), but that whole system needs
;; to be reworked.
(define (search-built-ins name) #f)
(define (search-special-built-ins name) #f)

(include-from-path "gash/shell.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"))

(sh:exec "guile" "--version")

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