guile-commits
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]