summaryrefslogtreecommitdiff
path: root/module/language/lua/standard/io.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/lua/standard/io.scm')
-rw-r--r--module/language/lua/standard/io.scm185
1 files changed, 185 insertions, 0 deletions
diff --git a/module/language/lua/standard/io.scm b/module/language/lua/standard/io.scm
new file mode 100644
index 000000000..d18db9e2e
--- /dev/null
+++ b/module/language/lua/standard/io.scm
@@ -0,0 +1,185 @@
+;;; Guile Lua --- io standard library
+
+;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;
+;;; This library is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU Lesser General Public
+;;; License as published by the Free Software Foundation; either
+;;; version 3 of the License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this library; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+;;; Code:
+
+(define-module (language lua standard io)
+ #:use-module (language lua runtime)
+
+ #:use-module (ice-9 popen)
+ #:use-module (ice-9 rdelim)
+ #:use-module (rnrs control))
+
+;; io.file:read
+
+;; metatable for file objects
+(define file (make-table))
+
+(rawset file '__index
+ (lambda (self key)
+ (rawget file key)))
+
+(define stdin (current-input-port))
+(define stdout (current-output-port))
+(define stderr (current-error-port))
+
+(define* (close #:optional (file stdout))
+ (close-port file))
+
+(rawset file 'close
+ (lambda (self)
+ (close self)))
+
+;; lua doesn't actually have an optional flush argument, but this is more in line with everything else
+(define* (flush #:optional (file stdout))
+ (force-output file))
+
+(rawset file 'flush
+ (lambda (self)
+ (flush self)))
+
+(define* (input #:optional filename)
+ (if filename
+ (let* ((file (open filename)))
+ (set! stdin file)
+ file)
+ stdin))
+
+(define (line-iterator file auto-close?)
+ (lambda ()
+ (let* ((line (read-line file)))
+ (if (eof-object? line)
+ (begin
+ (if auto-close?
+ (close-port file))
+ #nil)
+ line))))
+
+(define* (lines #:optional filename)
+ (let* ((file (if filename (open filename) stdin)))
+ (line-iterator file (and filename))))
+
+(rawset file 'lines
+ (lambda (self)
+ (line-iterator self #f)))
+
+(define* (open filename #:optional (mode "r"))
+ (assert-string 1 "io.open" filename)
+ (assert-string 2 "io.open" mode)
+ (let* ((handle (open-file filename mode)))
+ (register-userdata! handle file)
+ handle))
+
+(define* (output #:optional filename)
+ (if filename
+ (let* ((file (open filename "w")))
+ (set! stdout file)
+ file)
+ stdout))
+
+(define* (popen prog #:optional (mode "r"))
+ (assert-string 2 "io.popen" mode)
+ (open-pipe
+ prog
+ (if (string=? mode "w") OPEN_WRITE OPEN_READ)))
+
+(define (default-read port)
+ (if (eof-object? (peek-char port))
+ #nil
+ (read-line port)))
+
+(rawset file 'read
+ (lambda (self . formats)
+ (if (null? formats)
+ (default-read self)
+ (apply
+ values
+ (map
+ (lambda (self . formats)
+ (unless (or (number? format) (string? format))
+ (runtime-error "'file:read' expects a string or number as format argument, but got ~a" format))
+ (if (number? format)
+ (if (eof-object? (peek-char self))
+ #nil
+ (let lp ((out (open-output-string))
+ (i format))
+ (if (= i 0)
+ (get-output-string out)
+ (let ((c (read-char self)))
+ (if (eof-object? self)
+ (get-output-string out)
+ (begin
+ (write-char c out)
+ (lp out (- i 1))))))))
+
+ (let* ((format-length (string-length format))
+ (c1 (if (> format-length 0) (string-ref format 0) #f))
+ (c2 (if (> format-length 1) (string-ref format 1) #f)))
+ (cond ((eq? c2 #\n) (runtime-error "'file:read' number reading is not yet supported"))
+ ((eq? c2 #\a)
+ (if (eof-object? (peek-char self))
+ #nil
+ (let lp ((out (open-output-string)))
+ (let ((c (read-char self)))
+ (if (eof-object? c)
+ (get-output-string out)
+ (begin
+ (write-char c out)
+ (lp out)))))))
+ ((eq? c2 #\l)
+ (default-read self))
+ (else
+ (runtime-error "file:read does not understand format ~a" format))))))
+ formats)))))
+
+(rawset file 'seek
+ (lambda* (self #:optional (whence "cur") (offset 0))
+ (assert-string 1 "file:seek" whence)
+ (assert-number 2 "file:seek" offset)
+ (seek self offset
+ (cond ((string=? whence "cur") SEEK_CUR)
+ ((string=? whence "set") SEEK_SET)
+ ((string=? whence "end") SEEK_END)
+ (else (runtime-error "invalid 'whence' argument to 'file:seek'; expected \"cur\", \"set\", or \"end\""))))))
+
+(rawset file 'setvbuf
+ (lambda* (self mode #:optional size)
+ (assert-string 1 "file:setvbuf" mode)
+ (let* ((translated-mode
+ (cond ((string=? mode "no") _IONBF)
+ ((string=? mode "line") _IOLBF)
+ ((string=? mode "full") _IOFBF))))
+ (if size
+ (setvbuf self mode)
+ (setvbuf self mode size)))))
+
+(rawset file 'write
+ (lambda* (self . args)
+ (for-each
+ (lambda (arg)
+ (unless (or (string? arg) (number? arg))
+ (runtime-error "'file:write' expects string or number as argument but got '~a'" arg))
+ (display arg self))
+ args)))
+
+(define (type obj)
+ (if (port? obj)
+ (if (port-closed? obj)
+ "closed"
+ "file")
+ #nil))