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-159-gcca7


From: No Itisnt
Subject: [Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-159-gcca79a4
Date: Wed, 23 Jun 2010 04:52:35 +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=cca79a406e8d15a74bc6a77e0596a7e87f6ee986

The branch, lua has been updated
       via  cca79a406e8d15a74bc6a77e0596a7e87f6ee986 (commit)
      from  d2b6d6245ae15a81a310895e2514636c17780ad6 (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 cca79a406e8d15a74bc6a77e0596a7e87f6ee986
Author: No Itisnt <address@hidden>
Date:   Tue Jun 22 23:51:43 2010 -0500

    lua: Allow ... in parameter lists, and add rest arguments to functions. Add 
_G,
    and a metatable for tables backed by Guile modules.

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

Summary of changes:
 module/language/lua/global-environment.scm |   18 ++++++-
 module/language/lua/parser.scm             |   86 ++++++++++++----------------
 module/language/lua/runtime.scm            |   43 +++++++++++++-
 test-suite/tests/lua-eval.test             |   30 ++++++++--
 4 files changed, 117 insertions(+), 60 deletions(-)

diff --git a/module/language/lua/global-environment.scm 
b/module/language/lua/global-environment.scm
index c3e2307..4aaea8f 100644
--- a/module/language/lua/global-environment.scm
+++ b/module/language/lua/global-environment.scm
@@ -97,4 +97,20 @@
     (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))
\ No newline at end of file
+  ($ (lua) index %loaded module-name))
+
+;; arg
+;; this table is used to pass around the command line arguments to the 
program, as well as variable arguments to functions
+(define arg ($ (lua) make-table))
+(let lp ((rest (command-line))
+         (i 0))
+  ($ (lua) new-index! arg i (car rest))
+  (if (not (null? (cdr rest)))
+      (lp (cdr rest))))
+
+;; _VERSION
+;; 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
diff --git a/module/language/lua/parser.scm b/module/language/lua/parser.scm
index 1dba7cd..5aeaaed 100644
--- a/module/language/lua/parser.scm
+++ b/module/language/lua/parser.scm
@@ -46,8 +46,9 @@
         ((string? t) 'STRING)
         (else
          (case t
-           ((#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\]
-             #\: #\# #:function #:end #:if #:return #:elseif #:then #:else 
#:true #:false #:nil #:== #:~= #:= #:local) t)
+           ((#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #\: #\# #:function
+#:end #:if #:return #:elseif #:then #:else #:true #:false #:nil #:== #:~= #:=
+#:local #:dots) t)
            (else (error #:TOKEN/TYPE t))))))
 
 ;; name of global environment module
@@ -248,20 +249,6 @@
 
   ;;;;; TREE-IL UTILITIES
   ;; tree-il utilities that need access to this closure
-  (define (make-lua-function src parameters body-promise)
-    "Generate a function"
-
-    ;; create a new environment and populate it with the function's parameters
-    
-    (enter-environment!)
-    (for-each (lambda (p) (environment-define! p 'parameter)) parameters)
-
-    (let* ((body (force body-promise))
-           (parameter-gensyms (map environment-lookup-gensym parameters)))
-      (leave-environment!)
-      (make-lambda
-       src '()
-       (make-lambda-case src parameters #f #f #f '() parameter-gensyms (if 
(null? body) (make-void src) body) #f))))
 
   ;;;;; LEXER INTERACTION
   
@@ -458,32 +445,43 @@
   (define (parameter-list function-name)
     (if (eq? token #\))
         '()
-        (let loop ((parameters '()))
-          ;; the parameters can either be a name or a ...
+        (let lp ((parameters '()))
+          ;; parameter
           (let* ((parameters
-                  (case (token/type token)
-                    ((NAME) (append parameters (list token)))
-                    (else (syntax-error (get-source-info) "expected either a 
name or a ... in the parameter list of ~a, but got ~a" function-name token)))))
+                  (if (eq? (token/type token) 'NAME)
+                      (append! parameters (list token))
+                      (if (eq? token #:dots)
+                          parameters
+                          (syntax-error (get-source-info) "expected either a 
name or ... in the parameter list of '~a', but got ~a" function-name token))))
+                 (last-token token))
             (advance!)
             (if (eq? token #\,)
-                (advance! (loop parameters))
-                parameters)))))
-                
+                (if (eq? last-token #:dots)
+                    (syntax-error (get-source-info) "expected ')' after ... in 
the parameter list of '~a' function-name")
+                    (advance! (lp parameters)))
+                (values parameters (eq? last-token #:dots)))))))
+
   ;; function-body -> '(' parameter-list ')' chunk END
-  (define* (function-body #:optional (src (get-source-info)) (need-self? #f))
+  (define* (function-body #:optional (src (get-source-info)) (need-self? #f) 
(name "anonymous"))
     ;; '('
     (enforce-next! #\()
     ;; parameter-list
-    (let* ((parameters (parameter-list "anonymous function")))
-      ;; ')'
-      (enforce-next! #\))
-      (let* ((result
-              (make-lua-function
-               src
-               parameters
-               (delay (chunk)))))
-        (enforce-next! #:end)
-        result)))
+    (receive (parameters variable-arguments?)
+             (parameter-list name)
+             (enforce-next! #\))
+             ;; create function
+             (enter-environment!)
+             (for-each (lambda (p) (environment-define! p 'parameter)) 
parameters)
+             ;; chunk
+             (let* ((body (chunk))
+                    ;; %rest is always attached because lua functions must 
ignore variable arguments
+                    (parameter-gensyms (append! (map environment-lookup-gensym 
parameters) (list '%rest)))
+                    (result
+                     (make-lambda src '() (make-lambda-case src parameters #f 
'%rest #f '() parameter-gensyms (if (null? body) (make-void src) body) #f))))
+               (leave-environment!)
+               ;; END
+               (enforce-next! #:end)
+               result)))
 
   ;; expression-list -> expression { ',' expression }
   (define (expression-list)
@@ -566,20 +564,7 @@
         ;; END
         (enforce-next! #:end)
         (make-while-loop src condition body))))
-#|        
-        (define result (apply-named-lua-function
-         src
-         (lambda (loop)
-           (make-lua-conditional
-            src
-            condition
-            (make-sequence
-             src
-             (list body (make-application src (make-lexical-ref src loop loop) 
'())))
-            (make-void src)))))
-        (enforce-next! #:end)
-        result)))
-|#
+
   ;; return-statement -> RETURN expression-list
   (define (return-statement)
     (define src (get-source-info))
@@ -716,7 +701,7 @@
                    (if (eq? token #\:)
                        (values (make-table-ref src last-expr (advance! 
(single-name))) 'table-method)
                        (values last-expr 'function))))
-             (define body (function-body src (eq? type 'table-method)))
+             (define body (function-body src (eq? type 'table-method) 
(symbol->string name)))
              (case type
                ((table-function) (make-runtime-application src 'new-index!
                                     (list (cdr prefix) (make-const src 
(symbol->string (car prefix))) body)))
@@ -801,6 +786,7 @@
            (make-lexer port)
            (set! get-source-info get-source-info%)
            (set! lexer lexer%))
+  
   ;; toplevel local environment
   (enter-environment!)
   ;; read first token
diff --git a/module/language/lua/runtime.scm b/module/language/lua/runtime.scm
index 0119dc2..8905b8d 100644
--- a/module/language/lua/runtime.scm
+++ b/module/language/lua/runtime.scm
@@ -33,6 +33,9 @@
             ;; operators
             len unm eq lt le gt ge add sub mul div pow
             neq
+
+            ;; table
+            make-module-table
             )
 
 
@@ -83,13 +86,28 @@
 (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))
+  (apply
+   ;; if the table has a metatable
+   (if (true? (table/metatable table))
+       ;; if the metatable has the appropriate slot, use its value, otherwise 
use the default function
+       (hash-table-ref/default (table/slots (table/metatable table)) key 
default)
+       ;; otherwise, use the provided default function
+       default)
+   arguments))
 
 (define (index table key)
-  (hash-table-ref/default (table/slots table) key #nil))
+  (dispatch-metatable-event
+   "__index"
+   (lambda (table key) (hash-table-ref/default (table/slots table) key #nil))
+   table
+   table key))
 
 (define (new-index! table key value)
-  (hash-table-set! (table/slots table) key value))
+  (dispatch-metatable-event
+   "__newindex"
+   (lambda (table key value) (hash-table-set! (table/slots table) key value))
+   table
+   table key value))
 
 ;;;;; OPERATORS
 
@@ -143,3 +161,22 @@
 (define (gt a b)
   "A function backing the > (greater-than) operator"
   (not (le a b)))
+
+;;;;; MODULES
+
+;; A metatable for tables backed by modules
+(define module-metatable (make-table))
+
+(hash-table-set!
+ (table/slots module-metatable) "__index"
+ (lambda (table key)
+   (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)))))
+
+(define (make-module-table name)
+  (define table (make-table))
+  (table/metatable! table module-metatable)
+  (hash-table-set! (table/slots table) 'module-name name)
+  table)
diff --git a/test-suite/tests/lua-eval.test b/test-suite/tests/lua-eval.test
index caf9386..8d0b3dd 100644
--- a/test-suite/tests/lua-eval.test
+++ b/test-suite/tests/lua-eval.test
@@ -137,25 +137,40 @@ return table.identity(true)")
     ;; length operator
     (test "return #\"asdf\"" 4)
 
+    ;; _G
+    (test "a = true
+return _G.a")
+    
     ;; modules
     #;(test "require(\"table\")")
 
-    ;; - lexer
-    ;; multi-line strings [[ string ]]
+    ;; 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")
     
+    ;; multiple returns
+
     ;; - 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    
+    ;; 'arg' command line arguments
     ;; os, table, io, math
 
     ;; - after project
@@ -164,7 +179,10 @@ return table.identity(true)")
 
 #;(begin
   (define var
-    "return .34e5"
+    "function test(...)
+  return arg[1]
+end
+return test(true)"
   ) (display (compile ((make-parser (open-input-string var)))
-                    #:from 'lua #:to 'tree-il))
+                    #:from 'lua #:to 'value))
   (newline))
\ No newline at end of file


hooks/post-receive
-- 
GNU Guile



reply via email to

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