Parse shebang line too

This commit is contained in:
Lassi Kortela 2019-05-12 16:18:34 +03:00
parent 2773292aaf
commit 4edcffdc3a
2 changed files with 22 additions and 15 deletions

View File

@ -4,7 +4,7 @@
(scheme read) (scheme read)
(scheme write)) (scheme write))
(define (read-encoding filename) (define (read-declarations-from-file filename)
(let ((bytes (let ((bytes (call-with-port (let ((bytes (let ((bytes (call-with-port
(open-binary-input-file filename) (open-binary-input-file filename)
(lambda (port) (read-bytevector 1000 port))))) (lambda (port) (read-bytevector 1000 port)))))
@ -42,11 +42,11 @@
(eqv? c #\))))) (eqv? c #\)))))
(define (skip-char* k) (define (skip-char* k)
(when (read-char? k) (skip-char* k))) (when (read-char? k) (skip-char* k)))
(define (skip-rest-of-line) (define (read-rest-of-line)
(skip-char* (lambda (c) (not (or (eof-object? c) (eqv? c #\newline)))))) (read-char* (lambda (c) (not (or (eof-object? c) (eqv? c #\newline))))))
(define (skip-whitespace-and-comments) (define (skip-whitespace-and-comments)
(cond ((read-char? #\;) (cond ((read-char? #\;)
(skip-rest-of-line) (read-rest-of-line)
(skip-whitespace-and-comments)) (skip-whitespace-and-comments))
((read-char? whitespace-char?) ((read-char? whitespace-char?)
(skip-char* whitespace-char?) (skip-char* whitespace-char?)
@ -77,15 +77,19 @@
(if symbol-name (if symbol-name
(string->symbol symbol-name) (string->symbol symbol-name)
(eof-object))))) (eof-object)))))
(let* ((form (read-form)) (let* ((shebang (if (and (read-char? #\#) (read-char? #\!))
(coding-pair (and (list? form) (assoc 'coding (cdr form)))) (read-rest-of-line)
(coding (if (and coding-pair #f))
(pair? (cdr coding-pair)) (first-form (read-form))
(null? (cddr coding-pair)) (declarations (and (list? first-form)
(symbol? (cadr coding-pair))) (eqv? 'declare-file (car first-form))
(cadr coding-pair) (cdr first-form))))
#f))) (if shebang
coding))) (cons (list 'shebang shebang) declarations)
declarations))))
(display (read-encoding "test.scm")) (define (writeln x)
(newline) (write x)
(newline))
(for-each writeln (read-declarations-from-file "test.scm"))

View File

@ -1,4 +1,7 @@
#! /usr/bin/env gosh
(declare-file (declare-file
(coding shift_jis)) (coding shift_jis))
(display "こんにちは世界") (display "こんにちは世界")
(newline)