[Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-160-g0d8fcea

[No Itisnt]

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=0d8fcea7966a3322a2eef7a6ce19c68493386beb

The branch, lua has been updated
       via  0d8fcea7966a3322a2eef7a6ce19c68493386beb (commit)
      from  cca79a406e8d15a74bc6a77e0596a7e87f6ee986 (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 0d8fcea7966a3322a2eef7a6ce19c68493386beb
Author: No Itisnt <address@hidden>
Date:   Sat Jun 26 04:35:28 2010 -0500

    lua: Add beginnings of module system and the math module

-----------------------------------------------------------------------

Summary of changes:
 module/language/lua/global-environment.scm |   49 +++++++++++++-----------
 module/language/lua/parser.scm             |   33 +++++++++-------
 module/language/lua/runtime.scm            |   19 ++++++---
 module/language/lua/standard/math.scm      |   15 +++++++
 test-suite/tests/lua-eval.test             |   57 ++++++++++++++++-----------
 5 files changed, 107 insertions(+), 66 deletions(-)

diff --git a/module/language/lua/global-environment.scm 
b/module/language/lua/global-environment.scm
index 4aaea8f..3a4969a 100644
--- a/module/language/lua/global-environment.scm
+++ b/module/language/lua/global-environment.scm
@@ -66,7 +66,7 @@
 ;; package.loadlib
 ($ (lua) new-index! package "loadlib"
    (lambda (libname funcname . _)
-     (runtime-error "loadlib not implemented")))
+     ($ (error) "loadlib not implemented")))
 
 ;; package.path
 ($ (lua) new-index! package "path"
@@ -79,25 +79,7 @@
 ;; package.seeall
 ($ (lua) new-index! package "seeall"
    (lambda (module . _)
-     ($ (lua) 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)
-  ($ (lua) new-index! %loaders name module))
-
-(define (require module-name . _)
-  ;; try to load module, if it's not already loaded
-  (if (not ($ (srfi-69) hash-table-exists? ($ (lua) table/slots %loaded) 
module-name))
-    ;; first check (language lua standard)
-    (if (%standard-module-exists? module-name)
-        ($ (lua) runtime-error "cannot load standard module atm")
-        ($ (lua) runtime-error "cannot load standard modules atm")))
-  ($ (lua) index %loaded module-name))
+     ($ (error) "seeall not implemented")))
 
 ;; arg
 ;; this table is used to pass around the command line arguments to the 
program, as well as variable arguments to functions
@@ -112,5 +94,28 @@
 ;; contains a string describing the lua version
 (define _VERSION "Guile-Lua 5.1")
 
-;; _G  
-(define _G ($ (lua) make-module-table '(language lua global-environment)))
\ No newline at end of file
+;; _G
+;; global variable table
+(define _G ($ (lua) make-module-table '(language lua global-environment)))
+
+;; require
+(define (%register-loaded-module name table)
+  ;; TODO: needs to be fixed to use _G once globals are fixed
+  (module-define! (resolve-module '(language lua global-environment)) 
(string->symbol name) table)
+  (rawset %loaded name table))
+
+(define (%module-exists? name)
+  (if (module-public-interface (resolve-module name))
+      #t
+      #f))
+
+(define (require module-name . _)
+  ;; try to load module, if it's not already loaded
+  (if (not ($ (srfi-69) hash-table-exists? ($ (lua) table/slots %loaded) 
module-name))
+      (let* ((std-module-name `(language lua standard ,(string->symbol 
module-name))))
+        (if (%module-exists? std-module-name)
+            (%register-loaded-module module-name ($ (lua) make-module-table 
std-module-name)))))
+  
+  (if (not ($ (srfi-69) hash-table-exists? ($ (lua) table/slots %loaded) 
module-name))
+      ($ (error) "require failed"))
+  (rawget %loaded module-name))
diff --git a/module/language/lua/parser.scm b/module/language/lua/parser.scm
index 5aeaaed..281a6a4 100644
--- a/module/language/lua/parser.scm
+++ b/module/language/lua/parser.scm
@@ -1,4 +1,4 @@
-;; parser.scm --- lua parser which produces tree-il
+; parser.scm --- lua parser which produces tree-il
 (define-module (language lua parser)
 
   #:use-module (language tree-il)
@@ -8,6 +8,7 @@
 
   #:use-module (language lua common)
   #:use-module (language lua lexer)
+  #:use-module (language lua runtime)
 
   #:export (make-parser))
 
@@ -36,9 +37,6 @@
     ((#:else #:elseif #:end #:until) #t)
     (else (eof-object? k))))
 
-;; TODO: this is here mainly to ensure that no unwanted values are propagated
-;; through the parser -- it will be removed and replaced with the informal
-;; equivalents later
 (define (token/type t)
   (cond ((number? t) 'NUMBER)
         ((eof-object? t) 'EOS)
@@ -134,7 +132,9 @@
   (cond ((module-ref? left)
          (make-module-set (module-ref-src left) (module-ref-mod left) 
(module-ref-name left) (module-ref-public? left) right))
         ((lexical-ref? left)
-         (make-lexical-set (lexical-ref-src left) (lexical-ref-name left) 
(lexical-ref-gensym left) right))))
+         (make-lexical-set (lexical-ref-src left) (lexical-ref-name left) 
(lexical-ref-gensym left) right))
+        (else
+         (error #:MAKE-LUA-ASSIGNMENT "should not happen"))))
 
 (define (make-runtime-application src name arguments)
   "Apply a function in the (language lua runtime) module"
@@ -247,12 +247,9 @@
                 (module-define! *global-env* name #nil))
             (make-module-ref src *global-env-name* name #f)))))
 
-  ;;;;; TREE-IL UTILITIES
-  ;; tree-il utilities that need access to this closure
-
   ;;;;; LEXER INTERACTION
   
-  (define* (advance-aux)
+  (define (advance-aux)
     "Read a new token and store it in TOKEN"
     (if token2
         (begin
@@ -265,7 +262,7 @@
       ((_ x) (begin (advance-aux) x))
       ((_) (advance-aux))))
 
-  (define* (assert-token-type type)
+  (define (assert-token-type type)
     "Throw an error if the current token does not have the expected type"
     (if (not (equal? (token/type token) type))
         (syntax-error (get-source-info) "expected ~a" type)))
@@ -292,16 +289,22 @@
     (if (not (null? return-src?))
         (values src save)
         save))
-  
+
   ;; single-variable -> single-name
   (define (single-variable)
     (receive (src save)
              (single-name #:return-src #t)
              (resolve-ref src save)))
 
-  ;; application-arguments -> '(' [ expression-list ] ')'
+  ;; application-arguments -> '(' [ expression-list ] ')' | STRING
   (define (application-arguments)
-    (case token
+    (case (token/type token)
+      ;; STRING
+      ((STRING)
+       (let* ((string token))
+         (advance!)
+         (list (make-const #f string))))
+      ;; TODO: table constructor
       ;; '('
       ((#\()
        (advance!)
@@ -357,7 +360,7 @@
            (let* ((indice (index)))
              (lp (make-table-ref src expr indice))))
           ;; application-arguments
-          ((#\()
+          ((#\( STRING)
            (lp (make-application src expr (application-arguments))))
           (else expr))))
 
@@ -792,4 +795,4 @@
   ;; read first token
   (advance!)
   ;; return parser
-  chunk)
+  chunk)
\ No newline at end of file
diff --git a/module/language/lua/runtime.scm b/module/language/lua/runtime.scm
index 8905b8d..ce182c1 100644
--- a/module/language/lua/runtime.scm
+++ b/module/language/lua/runtime.scm
@@ -1,12 +1,13 @@
 ;; runtime.scm --- lua runtime functionality
 
+;; be careful not to introduce circular dependencies -- in particular, both
+;; parser.scm and global-environment.scm depend on this file
+
 (define-module (language lua runtime)
   #:use-module (language lua common)
 
   #:use-module (srfi srfi-9)
   #:use-module ((srfi srfi-69) #:renamer (lambda (s) (if (eq? s 
'make-hash-table) 'srfi-69-make-hash-table s)))
-
-  #:re-export (runtime-error)
   
   #:export (
             ;; semantics
@@ -34,11 +35,13 @@
             len unm eq lt le gt ge add sub mul div pow
             neq
 
-            ;; table
+            ;; modules
             make-module-table
+            *global-env-table*
+            set-global!
+            get-global
             )
 
-
   #:export-syntax (table/slots table? table/metatable table/metatable!)
 
 ) ; define-module
@@ -173,10 +176,14 @@
    (define slots (table/slots table))
    (if (hash-table-exists? slots key)
        (hash-table-ref slots key)
-       (module-ref (resolve-module (hash-table-ref slots 'module-name)) 
(string->symbol key)))))
+       (let ((key (string->symbol key))
+             (module (hash-table-ref slots 'module)))
+         (if (not (module-defined? module key))
+             #nil
+             (module-ref module key))))))
 
 (define (make-module-table name)
   (define table (make-table))
   (table/metatable! table module-metatable)
-  (hash-table-set! (table/slots table) 'module-name name)
+  (hash-table-set! (table/slots table) 'module (resolve-module name))
   table)
diff --git a/module/language/lua/standard/math.scm 
b/module/language/lua/standard/math.scm
index cbc7811..f93a3fd 100644
--- a/module/language/lua/standard/math.scm
+++ b/module/language/lua/standard/math.scm
@@ -4,3 +4,18 @@
 ;; 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
+
+(letrec-syntax
+    ((wrap-math-procedures
+      (syntax-rules ()
+        ((_ () (1 name))
+         (define (name a . _)
+           ((@ (guile) name) a)))
+        ((_ () (name))
+         (wrap-math-procedures () (1 name)))
+        ((_ subform ...)
+         (begin
+           (wrap-math-procedures () subform)
+           ...)))))
+  (wrap-math-procedures
+   (abs)))
diff --git a/test-suite/tests/lua-eval.test b/test-suite/tests/lua-eval.test
index 8d0b3dd..8ef7423 100644
--- a/test-suite/tests/lua-eval.test
+++ b/test-suite/tests/lua-eval.test
@@ -7,8 +7,9 @@
   #:use-module (system base compile)
   #:use-module (test-suite lib)
 
-  #:use-module (language lua lexer)
-  #:use-module (language lua parser))
+  #:use-module (language lua parser)
+
+  )
 
 (with-test-prefix "lua-eval"
   (define (from-string string)
@@ -140,27 +141,40 @@ return table.identity(true)")
     ;; _G
     (test "a = true
 return _G.a")
-    
+    (test "a = true
+return _G._G.a")
+    (test "a = true
+return _G._G._G.a")
+
     ;; modules
-    #;(test "require(\"table\")")
-
-    ;; variable arguments
-    #;(test "
-function test(...)
-  return arg[1]
-end
-return test(true)")
-
-    #;(test "
-function test(...)
-  return arg.n
-end
-return test(1,2,3,4,5) == 5")
+    (test "require 'math'
+return math.abs(-1)" 1)
+    
+    ;; 2.4.3 - Assignment
+    
+    ;; Before the assignment, the list of values is adjusted to the length of
+    ;; the list of variables. If there are more values than needed, the excess
+    ;; values are thrown away. If there are fewer values than needed, the list
+    ;; is extended with as many nil's as needed. If the list of expressions 
ends
+    ;; with a function call, then all values returned by that call enter the
+    ;; list of values, before the adjustment (except when the call is enclosed
+    ;; in parentheses; see §2.5).
+
+    ;; 2.5 - Expressions
+    
+    ;; Both function calls and vararg expressions can result in multiple
+    ;; values. If an expression is used as a statement (only possible for
+    ;; function calls (see §2.4.6)), then its return list is adjusted to zero
+    ;; elements, thus discarding all returned values. If an expression is used
+    ;; as the last (or the only) element of a list of expressions, then no
+    ;; adjustment is made (unless the call is enclosed in parentheses). In all
+    ;; other contexts, Lua adjusts the result list to one element, discarding
+    ;; all values except the first one.
     
     ;; multiple returns
 
     ;; - compiler
-    ;; applications with no parenthesis (it is considered an application if an 
expression is followed by a freestanding string or table)
+    ;; applications with no parenthesis (it is considered an application if an 
expression is followed by a freestanding table literal)
     ;; concatenation
     ;; method invocations
     ;; for loops
@@ -179,10 +193,7 @@ return test(1,2,3,4,5) == 5")
 
 #;(begin
   (define var
-    "function test(...)
-  return arg[1]
-end
-return test(true)"
+"return a"
   ) (display (compile ((make-parser (open-input-string var)))
-                    #:from 'lua #:to 'value))
+                    #:from 'lua #:to 'tree-il))
   (newline))
\ No newline at end of file


hooks/post-receive
-- 
GNU Guile