wip! Port the evaluator to Mes.wip-mes

Cf. Mes commit 87cd202a1acc6774daf66450f276c04919cfb91d.

* mes/gash.mes: Add some more shims; read and evaluate the test
script.

1 files changed, 48 insertions, 4 deletions

diff --git a/mes/gash.mes b/mes/gash.mes
index 868903a..a2f92e4 100644
--- a/mes/gash.mes
+++ b/mes/gash.mes
@@ -9,6 +9,18 @@
 (mes-use-module (srfi srfi-26))
 
 
+;; SRFI 1 extras
+
+(define (partition pred lst)
+  (let loop ((lst lst) (yeas '()) (nays '()))
+    (if (null? lst)
+        (values (reverse yeas) (reverse nays))
+        (let ((x (car lst)))
+          (if (pred x)
+              (loop (cdr lst) (cons x yeas) nays)
+              (loop (cdr lst) yeas (cons x nays)))))))
+
+
 ;; SRFI 14 extras
 
 (define (char-set-union . css)
@@ -106,8 +118,30 @@
 
 ;; String funtions
 
+(define (string-concatenate-reverse lst)
+  (apply string-append (reverse lst)))
+
+(define (char-pred pred)
+  (cond
+   ((char? pred) (lambda (x) (char=? x pred)))
+   ((char-set? pred) (lambda (x) (char-set-contains? pred x)))
+   ((procedure? pred) pred)
+   (else (error "Invalid character predicate."))))
+
 (define (string-every pred str)
-  (every pred (string->list str)))
+  (every (char-pred pred) (string->list str)))
+
+(define (string-any pred str)
+  (any (char-pred pred) (string->list str)))
+
+
+;; Vector functions
+
+(define vector-empty?
+  (compose zero? vector-length))
+
+(define (vector-every pred . lst)
+  (apply every pred (map vector->list lst)))
 
 
 ;; Prompts
@@ -193,11 +227,21 @@
 
 (include-from-path "gash/shell.scm")
 
+;; Arithmetic is hard without modules.  Many names conflict with the
+;; shell parser.
+;; (include-from-path "gash/arithmetic.scm")
+
+(include-from-path "gash/word.scm")
+(include-from-path "gash/eval.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")
+;; (sh:exec "guile" "--version")
 
-(write (read-sh-all))
-(newline)
+(let ((script (read-sh-all)))
+  (write script)
+  (newline)
+  (display "******************************************\n")
+  (eval-sh `(<sh-begin> ,@script)))