[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-138-g89d2
From: |
No Itisnt |
Subject: |
[Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-138-g89d2361 |
Date: |
Mon, 21 Jun 2010 02:59:13 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=89d236124e6f32aac3e1043346564f3edd5153b3
The branch, lua has been updated
via 89d236124e6f32aac3e1043346564f3edd5153b3 (commit)
from 9620ec1b750fb23281d1a8e63bc02b52fa191909 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 89d236124e6f32aac3e1043346564f3edd5153b3
Author: No Itisnt <address@hidden>
Date: Sun Jun 20 21:57:43 2010 -0500
lua: Add support for string escapes and single-quoted strings. Add the
beginnings of module support, including skeletons for several of the
standard
modules.
-----------------------------------------------------------------------
Summary of changes:
module/language/lua/global-environment.scm | 60 +++++++++++++++++++++++++--
module/language/lua/lexer.scm | 44 ++++++++++++++++++--
module/language/lua/parser.scm | 2 +-
module/language/lua/runtime.scm | 23 ++++++-----
module/language/lua/standard/io.scm | 4 ++
module/language/lua/standard/math.scm | 6 +++
module/language/lua/standard/os.scm | 2 +
module/language/lua/standard/table.scm | 15 +++++++
test-suite/tests/lua.test | 36 ++++++++++++++---
9 files changed, 164 insertions(+), 28 deletions(-)
create mode 100644 module/language/lua/standard/io.scm
create mode 100644 module/language/lua/standard/math.scm
create mode 100644 module/language/lua/standard/os.scm
create mode 100644 module/language/lua/standard/table.scm
diff --git a/module/language/lua/global-environment.scm
b/module/language/lua/global-environment.scm
index 61c4117..69b0a9b 100644
--- a/module/language/lua/global-environment.scm
+++ b/module/language/lua/global-environment.scm
@@ -5,28 +5,29 @@
;; shorthand for accessing modules without polluting the namespace
(define-syntax $
- (syntax-rules (srfi-69 lua error)
+ (syntax-rules (srfi-69 srfi-98 lua error)
((_ (srfi-69) name . rest) ((@ (srfi srfi-69) name) . rest))
+ ((_ (srfi-98) name . rest) ((@ (srfi srfi-98) name) . rest))
((_ (error) . rest) ((@ (language lua common) runtime-error) . rest))
((_ (lua) name . rest) ((@ (language lua runtime) name) . rest))
))
-(define (rawget table key)
+(define (rawget table key . _)
($ (lua) assert-table 1 "rawget" table)
($ (srfi-69) hash-table-ref ($ (lua) table/slots table) key))
-(define (rawset table key value)
+(define (rawset table key value . _)
($ (lua) assert-table 1 "rawset" table)
($ (srfi-69) hash-table-set! ($ (lua) table/slots table) key value)
table)
-(define (setmetatable table metatable)
+(define (setmetatable table metatable . _)
($ (lua) assert-table 1 "setmetatable" table)
($ (lua) assert-type 2 "setmetatable" "nil or table" metatable (lambda (x)
(or ($ (lua) table? x) (eq? x #nil))))
($ (lua) table/metatable! table metatable)
table)
-(define (getmetatable table)
+(define (getmetatable table . _)
($ (lua) assert-table 1 "getmetatable" table)
($ (lua) table/metatable table))
@@ -46,3 +47,52 @@
(if ($ (lua) false? v)
($ (error) message)
(apply values (cons v (cons message rest)))))
+
+;; package
+(define package ($ (lua) make-table))
+
+;; package.cpath
+($ (lua) new-index! package "cpath"
+ (or ($ (srfi-98) get-environment-variable "LUA_CPATH")
"./?.so;/usr/lib/lua/5.1/?.so;/usr/lib/lua/5.1/loadall.so"))
+
+;; package.loaded
+(define %loaded ($ (lua) make-table))
+($ (lua) new-index! package "loaded" %loaded)
+
+;; package.loaders
+(define %loaders ($ (lua) make-table))
+($ (lua) new-index! package "loaders" %loaders)
+
+;; package.loadlib
+($ (lua) new-index! package "loadlib"
+ (lambda (libname funcname . _)
+ (runtime-error "loadlib not implemented")))
+
+;; package.path
+($ (lua) new-index! package "path"
+ (or ($ (srfi-98) get-environment-variable "LUA_PATH")
"./?.lua;/usr/share/lua/5.1/?.lua;/usr/share/lua/5.1/?/init.lua;/usr/lib/lua/5.1/?.lua;/usr/lib/lua/5.1/?/init.lua"))
+
+;; package.preload
+(define %preload ($ (lua) make-table))
+($ (lua) new-index! package "preload" %preload)
+
+;; package.seeall
+($ (lua) new-index! package "seeall"
+ (lambda (module)
+ (runtime-error "seeall not implemented")))
+
+(define (%standard-module-exists? name)
+ (if (module-public-interface (resolve-module `(language lua standard
,(string->symbol name))))
+ #t
+ #f))
+
+;; require
+(define (%register-loaded-module name module)
+ #f)
+
+(define (require module-name . _)
+ (if (not ($ (srfi-69) hash-table-exists? %loaded module-name))
+ (if (%standard-module-exists? module-name)
+ (runtime-error "cannot load standard modules atm")))
+ ($ (srfi-69) index %loaded module-name))
+
\ No newline at end of file
diff --git a/module/language/lua/lexer.scm b/module/language/lua/lexer.scm
index adc9c32..867eaed 100644
--- a/module/language/lua/lexer.scm
+++ b/module/language/lua/lexer.scm
@@ -28,20 +28,57 @@
(define (make-lexer port)
(define buffer (open-output-string))
+
(define (clear-buffer)
"Reset the buffer and return a string of the contents"
(define string (get-output-string buffer))
(truncate-file buffer 0)
string)
+
(define saved-source-info #f)
+
(define (save-source-info)
"Save source code information for a particular location e.g. the beginning
of an identifier"
(set! saved-source-info (source-info port)))
+
(define (get-source-info)
(if saved-source-info
saved-source-info
(source-info port)))
+
+ (define (read-string delimiter)
+ (read-char) ;; consume delimiter
+ (let loop ((c (peek-char)))
+ (cond
+ ;; string ends early
+ ((or (eof-object? c) (eq? c #\cr) (eq? c #\newline))
+ (syntax-error (get-source-info) "unfinished string ~S" c))
+ ;; string escape
+ ((char=? c #\\)
+ ;; discard \ and read next character
+ (let* ((escape (begin (read-char) (read-char))))
+ (write-char
+ (case escape
+ ((#\a) #\alarm)
+ ((#\b) #\backspace)
+ ((#\f) #\page)
+ ((#\n) #\newline)
+ ((#\r) #\return)
+ ((#\t) #\tab)
+ ((#\v) #\vtab)
+ ((#\x) (syntax-error (get-source-info) "hex escapes
unsupported"))
+ ((#\d) (syntax-error (get-source-info) "decimal escapes
unsupported"))
+ (else escape)))
+ (loop (peek-char))))
+ (else
+ (if (eq? c delimiter)
+ (read-char) ;; terminate loop and discard delimiter
+ (begin
+ (write-char (read-char))
+ (loop (peek-char)))))))
+ (clear-buffer))
+
(define (lex)
(parameterize ((current-input-port port)
(current-output-port buffer))
@@ -89,11 +126,8 @@ of an identifier"
(while (is-digit? (peek-char))
(write-char (read-char)))
(string->number (clear-buffer)))
- ((#\")
- (read-char)
- (while (not (or (eq? (peek-char) #\") (eof-object? (peek-char))))
- (write-char (read-char)))
- (clear-buffer))
+ ((#\") (read-string #\"))
+ ((#\') (read-string #\'))
;; strings
(else
diff --git a/module/language/lua/parser.scm b/module/language/lua/parser.scm
index ab032e2..1dba7cd 100644
--- a/module/language/lua/parser.scm
+++ b/module/language/lua/parser.scm
@@ -292,7 +292,7 @@
(define (enforce-next! expect)
"Throw an error if the current token is not the expected token"
(if (not (maybe-skip-next! expect))
- (syntax-error (get-source-info) "expected ~a but got ~a" expect
token)))
+ (syntax-error (get-source-info) "expected '~A' but got '~A'" expect
token)))
;;;;; GRAMMAR
diff --git a/module/language/lua/runtime.scm b/module/language/lua/runtime.scm
index 5bdbbb2..948f794 100644
--- a/module/language/lua/runtime.scm
+++ b/module/language/lua/runtime.scm
@@ -6,13 +6,14 @@
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-69)
- #:duplicates (replace last)
+ #:export-syntax (table/slots table? table/metatable table/metatable!)
#:export (
;; semantics
false? true?
;; misc
+ value-type->string
assert-type
assert-table
@@ -28,6 +29,7 @@
;; metatable events
index
new-index!
+
;; operators
len unm eq lt le gt ge add sub mul div pow
neq
@@ -63,31 +65,30 @@
(define-record-type table
(%make-table metatable slots)
- %table?
- (metatable %table/metatable %table/metatable!)
- (slots %table/slots))
+ table?
+ (metatable table/metatable table/metatable!)
+ (slots table/slots))
(define (make-table)
(%make-table #nil (make-hash-table)))
;; table accessors for export
-(define (table? x) (%table? x))
-(define (table/slots x) (%table/slots x))
-(define (table/metatable x) (%table/metatable x))
-(define (table/metatable! x y) (%table/metatable! x y))
+(define (table? x) (table? x))
+(define (table/metatable x) (table/metatable x))
+(define (table/metatable! x y) (table/metatable! x y))
(define (dispatch-metatable-event key default table . arguments)
(apply (if (true? (table/metatable table)) (hash-table-ref/default
(table/slots (table/metatable table)) key default) default) arguments))
(define (index table key)
- (hash-table-ref/default (%table/slots table) key #nil))
+ (hash-table-ref/default (table/slots table) key #nil))
(define (new-index! table key value)
- (hash-table-set! (%table/slots table) key value))
+ (hash-table-set! (table/slots table) key value))
;;;;; OPERATORS
-;; this macro could be even cooler and generate the slot names as well as the
+;; This macro could be even cooler and generate the slot names as well as the
;; parsers name/function mappings at expand-time
(letrec-syntax
((define-binary-operators
diff --git a/module/language/lua/standard/io.scm
b/module/language/lua/standard/io.scm
new file mode 100644
index 0000000..47cfe06
--- /dev/null
+++ b/module/language/lua/standard/io.scm
@@ -0,0 +1,4 @@
+(define-module (language lua standard io)
+ #:use-module (language lua runtime))
+
+;; close, flush, input, lines, open, output, popen, read, tmpfile, type,
write, file:close, file:flush, file:lines, file:read, file:seek, file:setvbuf,
file:write
diff --git a/module/language/lua/standard/math.scm
b/module/language/lua/standard/math.scm
new file mode 100644
index 0000000..cbc7811
--- /dev/null
+++ b/module/language/lua/standard/math.scm
@@ -0,0 +1,6 @@
+(define-module (language lua standard math)
+ #:use-module (language lua runtime))
+
+;; abs, acos, asin, atan, atan2, ceil, cos, cosh, deg, exp, floor, fmod, frexp,
+;; huge (???), ldexp, log, log10, max, min, modf, pi, pow, rad, random,
randomseed,
+;; sin, sinh, sqrt, tan, tanh
diff --git a/module/language/lua/standard/os.scm
b/module/language/lua/standard/os.scm
new file mode 100644
index 0000000..e948cf3
--- /dev/null
+++ b/module/language/lua/standard/os.scm
@@ -0,0 +1,2 @@
+(define-module (language lua standard os)
+ #:use-module (language lua runtime))
diff --git a/module/language/lua/standard/table.scm
b/module/language/lua/standard/table.scm
new file mode 100644
index 0000000..7f57bc5
--- /dev/null
+++ b/module/language/lua/standard/table.scm
@@ -0,0 +1,15 @@
+(define-module (language lua standard table)
+ #:use-module (language lua runtime)
+ #:export (maxn))
+
+;; TODO - concat, insert, remove, sort
+
+(define (maxn table . _)
+ (let loop ((rest (hash-table-keys table))
+ (n 0))
+ (if (null? rest)
+ n
+ (let* ((item (car rest)))
+ (if (and (number? item) (> item n))
+ (loop (cdr rest) item)
+ (loop (cdr rest) n))))))
diff --git a/test-suite/tests/lua.test b/test-suite/tests/lua.test
index 48532e7..2afa65e 100644
--- a/test-suite/tests/lua.test
+++ b/test-suite/tests/lua.test
@@ -1,4 +1,4 @@
-;; lua.test --- lua test suite -*- mode: scheme -*-
+; lua.test --- lua test suite -*- mode: scheme -*-
(define-module (test-lua)
#:use-module (ice-9 format)
#:use-module (language tree-il)
@@ -17,9 +17,9 @@
(lex)))
(let-syntax
((test
- (syntax-rules (eof predicate)
+ (syntax-rules (eof)
((_ string expect)
- (pass-if (format "~S => ~A" string expect) (equal? (from-string
string) expect)))
+ (pass-if (format "~S => ~S" string expect) (equal? (from-string
string) expect)))
((_ (eof string))
(pass-if (format "~a => #<eof>" string) (eof-object? (from-string
string)))))))
@@ -35,6 +35,13 @@
(test "/" #\/)
(test "*" #\*)
+ ;; string escapes
+ (test "'\\a\\b\\f\\n\\r\\t\\v'"
+ "\a\b\f\n\r\t\v")
+
+ (test "'\\''"
+ "'")
+
))
(define (tree-il? x) (or (application? x) (module-ref? x) (primitive-ref? x)
@@ -59,7 +66,7 @@
(let* ((real-string (string-append "return " string))
(real-expect `(begin (apply (primitive return) ,@`expect)))
(result (from-string real-string)))
- (pass-if (format "~S => ~A" real-string real-expect) (equal? result
real-expect)))))))
+ (pass-if (format "~S => ~S" real-string real-expect) (equal? result
real-expect)))))))
;; shortcuts
(define (from-string string) (strip-tree-il! ((make-parser
(open-input-string string)))))
@@ -94,7 +101,7 @@
((test
(syntax-rules ()
((_ string expect)
- (pass-if (format "~S => ~A" string expect) (equal? (from-string
string) expect)))
+ (pass-if (format "~S => ~S" string expect) (equal? (from-string
string) expect)))
((_ string)
(test string #t)))))
@@ -200,7 +207,7 @@ setmetatable(table, { __add = function(a,b) return a end })
return 5 + table" 5)
(test "return true")
- ;; table methods/functions
+ ;; field functions
(test "table = {}
function table.identity(x) return x end
return table.identity(true)")
@@ -211,14 +218,31 @@ return table.identity(true)")
;; length operator
(test "return #\"asdf\"" 4)
+
+ ;; modules
+ #;(test "require(\"table\")")
+
+ ;; - lexer
+ ;; floating point numbers
+ ;; multi-line strings [[ string ]]
;; - compiler
+ ;; applications with no parenthesis (it is considered an application if an
expression is followed by a freestanding string or table)
+ ;; concatenation
;; method invocations
;; for loops
;; variable arguments
;; multiple returns
+
;; - runtime
;; __pairs, __ipairs, __len
+
+ ;; - language
+ ;; require, _G
+ ;; os, table, io, math
+
+ ;; - after project
+ ;; bitlib, coroutine, debug, string
))
#;(begin
hooks/post-receive
--
GNU Guile
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-138-g89d2361,
No Itisnt <=