suzanne.soy/rash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Created working s-exp module language

Browse Source
This commit is contained in:
Cristian Esquivias 2014-08-19 02:05:07 -07:00
parent b8a0eecba7
commit aab5057477
3 changed files with 39 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
language.rkt Normal file
View File

@ -0,0 +1,7 @@
#lang racket/base
(require "rash.rkt")
(provide start
pipe
(all-from-out racket/base))

19
rash-lang.rkt
View File

@ -1,7 +1,10 @@
#lang racket/base
(require syntax/readerr
(prefix-in rash: "rash.rkt"))
(prefix-in rash: "language.rkt"))
(provide (rename-out [rash-read read]
[rash-read-syntax read-syntax]))
(define (rash-read in)
(syntax->datum (rash-read-syntax #f in)))
@ -23,15 +26,21 @@
(define len (string-length m))
(define word (datum->syntax #f m (vector src line col pos len)))
(loop (cons word words) len))]
[(regexp-try-match #px"^\n" in) => (λ (m) (list->rash-syntax
[(regexp-try-match #px"^\n" in) => (λ (m)
(if (null? words)
(loop words (add1 delta))
(list->rash-syntax
(reverse words)
delta))]
delta)))]
[(regexp-try-match #px"^[ \t]+" in) => (λ (r)
(define m
(bytes->string/utf-8 (car r)))
(displayln m)
(loop words (string-length m)))]
[(eof-object? (peek-char in)) (list->rash-syntax (reverse words) delta)]
[(eof-object? (peek-char in))
(read-char in)
(if (null? words)
eof
(list->rash-syntax (reverse words) delta))]
[else (raise-read-error
(string-append "Unknown character " (read-char in))
src line col pos 1)])))

28
rash.rkt
View File

@ -1,10 +1,10 @@
#lang racket
#lang racket/base
(require racket/contract)
(require racket/port)
(require racket/string)
(require (for-syntax racket/syntax))
(require (for-syntax racket/base))
(define (executable? bin)
(find-executable-path bin))
@ -14,7 +14,11 @@
(foldl (λ (i j) (and i j)) #t (map string? (cdr command)))))
(provide (contract-out
[start (->* (executable? (listof string?))
[start (->* (executable?)
()
#:rest (listof string?)
void?)]
[start* (->* (executable? (listof string?))
(#:stdin (or/c #f file-stream-port?))
void?)]
;; TODO: validate pipe's commands are lists of strings
@ -22,7 +26,10 @@
run
~>)
(define (start command args #:stdin [stdin #f])
(define (start command . args)
(start* command args #:stdin (current-input-port)))
(define (start* command args #:stdin [stdin #f])
(define cmd (find-executable-path command))
(define-values (proc out in err)
(apply subprocess
@ -38,10 +45,11 @@
(syntax-case stx ()
[(run command arg ...)
(let ([datum (syntax->datum stx)])
(datum->syntax stx (list 'start
(symbol->string (cadr datum))
(cons 'list
(map symbol->string (cddr datum))))))]))
(datum->syntax stx (apply list
'start
(symbol->string (cadr datum)) ; command
(map symbol->string (cddr datum)) ; args
)))]))
(define-syntax-rule (apply-values fn body ...)
(call-with-values (λ () body ...) fn))
@ -100,7 +108,7 @@
"Spawn a sub process with current-output-port for stdout and
current-error-port for stderr. stdin is not used."
(define stdout (launch-racket
"(require \"rash.rkt\") (start \"echo\" '(\"hello\"))"
"(require \"rash.rkt\") (start \"echo\" \"hello\")"
#f))
(check string=? "hello\n" (get-output-string stdout)))
@ -108,7 +116,7 @@
"Spawn a sub process with piping in stdin."
(define stdout (launch-racket
"(require \"rash.rkt\") \
(start \"wc\" '(\"-c\") #:stdin (current-input-port))"
(start* \"wc\" '(\"-c\") #:stdin (current-input-port))"
(open-input-string "hello")))
(check string=? "5" (string-trim (get-output-string stdout))))