[Guile-commits] GNU Guile branch, lua, updated. release_1-9-11-39-g8899ae7

[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=8899ae7e9ba749c3edcccd13dd5b92da4fae5622

The branch, lua has been updated
       via  8899ae7e9ba749c3edcccd13dd5b92da4fae5622 (commit)
       via  984f535596f3dbf6ba2b292f5db60faf105f293a (commit)
      from  cee1530a1e4d0c45e4ada7aa1c05bd5eabf0d7b5 (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 8899ae7e9ba749c3edcccd13dd5b92da4fae5622
Author: No Itisnt <address@hidden>
Date:   Mon Jun 14 16:59:50 2010 -0500

    lua: Support for declaration and assignment of local variables.

commit 984f535596f3dbf6ba2b292f5db60faf105f293a
Author: No Itisnt <address@hidden>
Date:   Mon Jun 14 15:37:13 2010 -0500

    Add primtiive support for locals; fix heretoforth untested lexical set! 
functionality.

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

Summary of changes:
 lua.scm |  134 +++++++++++++++++++++++++++++++++++++++++++--------------------
 1 files changed, 92 insertions(+), 42 deletions(-)

diff --git a/lua.scm b/lua.scm
index dd24c0e..baa256c 100644
--- a/lua.scm
+++ b/lua.scm
@@ -66,7 +66,7 @@
 (define (possible-keyword k)
   "Convert a symbol to a keyword if it is a reserved word in Lua"
   (case k
-    ((return function end if then elseif else true false nil or and do while) 
(symbol->keyword k))
+    ((return function end if then elseif else true false nil or and do while 
local) (symbol->keyword k))
     (else k)))
 
 (define (make-lexer port)
@@ -316,7 +316,7 @@ of an identifier"
         ((string? t) 'STRING)
         (else
          (case t
-           ((#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #:function #:end 
#:if #:elseif #:then #:else #:true #:false #:nil #:== #:~= #:=) t)
+           ((#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #:function #:end 
#:if #:elseif #:then #:else #:true #:false #:nil #:== #:~= #:= #:local) t)
            (else (error #:TOKEN/TYPE t))))))
 
 ;; name of global environment module
@@ -398,7 +398,7 @@ of an identifier"
   (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-ref (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))))
 
 (define (make-runtime-application src name arguments)
   "Apply a function in the (language lua runtime) module"
@@ -411,6 +411,13 @@ of an identifier"
 (define (make-table-ref src table index)
   (make-runtime-application src 'table-get (list table index)))
 
+(define (wrap-expression-in-environment src e x)
+  "Wrap an expression in an enclosing lexical environment if necessary"
+  (define names (environment/names e))
+  (if (not (null? names))
+      (make-let src (map car names) (map cdr names) (map (lambda (x) 
(make-const src #nil)) names) x)
+      x))
+
 (define (make-parser port)
   ;; functions that will be retrieved from make-lexer
   (define get-source-info)
@@ -451,6 +458,16 @@ of an identifier"
               (environment-lookup name (environment/parent e))))
         #f))
 
+  (define (resolve-ref src name)
+    (let* ((binding (environment-lookup name)))
+      (if binding
+          (make-lexical-ref src name binding)
+          ;; TODO: Consider _G
+          (begin
+            (if (not (module-defined? *global-env* name))
+                (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
   (define (make-lua-function src parameters body-promise)
@@ -486,7 +503,7 @@ of an identifier"
           (set! token2 #f))
         (set! token (lexer))))
 
-  (define* (assert-token-type type #:optional (token token))
+  (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)))
@@ -518,14 +535,7 @@ of an identifier"
   (define (single-variable)
     (receive (src save)
              (single-name #:return-src #t)
-             (let* ((binding (environment-lookup save)))
-               (if binding
-                   (make-lexical-ref src save binding)
-                   ;; TODO: Consider _G
-                   (begin
-                     (if (not (module-defined? *global-env* save))
-                         (module-define! *global-env* save #nil))
-                     (make-module-ref src *global-env-name* save #f))))))
+             (resolve-ref src save)))
 
   ;; application-arguments -> '(' [ expression-list ] ')'
   (define (application-arguments)
@@ -709,7 +719,7 @@ of an identifier"
           ;; finished
           (reverse! tree))))
 
-  ;; simple-expression -> (nil | true | false | NUMBER | STRING) | 
table-literal | FUNCTION function-body | primary-expression
+  ;; simple-expression -> (nil | true | false | NUMBER | STRING) | 
table-literal | FUNCTION function-body 
   (define (simple-expression)
     (define src src)
     (receive
@@ -763,6 +773,7 @@ of an identifier"
           ;; finished
           left)))
 
+  ;; expression -> subexpression
   (define (expression)
     (subexpression 0))
   
@@ -770,7 +781,7 @@ of an identifier"
   (define (while-statement)
     (define src (get-source-info))
     ;; WHILE
-    (enforce-next! #:while)
+    (advance!)
     ;; expression
     (let* ((condition (expression)))
       ;; DO
@@ -796,7 +807,7 @@ of an identifier"
     (define src (get-source-info))
 
     ;; RETURN
-    (enforce-next! #:return)
+    (advance!)
 
     (make-application src (make-primitive-ref src 'return)
                       ;; if followed by END or ';', the return has no 
arguments, otherwise
@@ -817,25 +828,7 @@ of an identifier"
       (let* ((body (chunk)))
         (values condition body))))
 
-  ;; assignment -> '=' expression-list | ',' primary-expression assignment
-  (define (assignment first)
-    ;; assignments are unfortunately complicated because multiple variables may
-    ;; be assigned to multiple expressions in a single assignment, and the
-    ;; number of variables and expressions need not match
-
-    ;; so this function accumulates the entire assignment
-    (let* ((src (get-source-info))
-           (left (let loop ((x first)
-                            (tree '()))
-                   (set! tree (append! (list x) tree))
-                   (if (eq? token #\,)
-                       (begin (advance!) (loop (primary-expression) tree))
-                       (reverse! tree))))
-
-           (right (begin
-                    (enforce-next! #:=)
-                    (expression-list))))
-
+  (define (parse-assignment src left right)
       ;; and then parses it, branching to handle overflows on either side if 
necessary
       (make-sequence
        src
@@ -863,7 +856,27 @@ of an identifier"
                 (if (null? rest)
                     (reverse! (append! (list il) tree))
                     (loop (append! (list il) tree) (cdr rest))))))
-           (else (error #:ASSIGNMENT "should not happen")))))
+           (else (error #:PARSE-ASSIGNMENT "should not happen"))))))
+
+  ;; assignment -> '=' expression-list | ',' primary-expression assignment
+  (define (assignment first)
+    ;; assignments are unfortunately complicated because multiple variables may
+    ;; be assigned to multiple expressions in a single assignment, and the
+    ;; number of variables and expressions need not match
+
+    ;; so this function accumulates the entire assignment
+    (let* ((src (get-source-info))
+           (left (let loop ((x first)
+                            (tree '()))
+                   (set! tree (append! (list x) tree))
+                   (if (eq? token #\,)
+                       (begin (advance!) (loop (primary-expression) tree))
+                       (reverse! tree))))
+
+           (right (begin
+                    (enforce-next! #:=)
+                    (expression-list))))
+      (parse-assignment src left right)
       
       ) ; let*
     ) ; assignment
@@ -900,20 +913,46 @@ of an identifier"
     (let* ((name (single-name)))
       (module-define! (resolve-module '(language lua global-environment)) name 
*unspecified*)
       (make-module-set src '(language lua global-environment) name #f 
(function-body))))
-  
+
+  ;; local-statement -> LOCAL NAME { ',' NAME } [ '=' expression-list ]
+  (define (local-statement)
+    (define src (get-source-info))
+    ;; LOCAL
+    ;; (already advanced by calling function)
+
+    (let lp ((names '()))
+      ;; NAME
+      (assert-token-type 'NAME)
+      (set! names (append! (list token) names))
+      (advance!)
+      (if (maybe-skip-next! #\,)
+          ;; { ',' NAME }
+          (lp names)
+          (begin
+            (for-each environment-define! names)
+            (if (maybe-skip-next! #:=)
+                ;; [ '=' expression-list ]
+                (let* ((left (map (lambda (x) (resolve-ref src x)) names))
+                       (right (expression-list)))
+                  ;(format #t "~A ~A\n" left right)
+                  (parse-assignment src left (reverse! right)))
+                ;; otherwise, it's not a declaration, not an assignment, and 
evaluates to nothing
+                (make-void #f))))))
+
   ;; statement
   (define (statement)
     (case token
       ((#\;) (advance!) (statement))
       ;; statement -> return
       ((#:return) (values #t (return-statement)))
-      ((#:if #:function #:do #:while)
+      ((#:if #:function #:do #:while #:local)
        (values
          #f
           (case token
             ((#:while) (while-statement))
             ((#:if) (if-statement))
             ((#:function) (function-statement))
+            ((#:local) (advance!) (local-statement))
             ((#:do)
              (begin
                (advance!)
@@ -929,7 +968,11 @@ of an identifier"
     (let loop ((is-last (end-of-block? token))
                (tree '()))
       (if is-last
-          (begin (maybe-skip-next! #\;) (make-sequence src (reverse! tree)))
+          (begin (maybe-skip-next! #\;)
+                 (wrap-expression-in-environment
+                  src
+                  environment
+                  (make-sequence src (reverse! tree))))
         (receive
          (is-last node)
          (statement)
@@ -1111,6 +1154,7 @@ of an identifier"
     (test "variable = true; return variable")
     (test "a,b = 1,2; return a" 1)
     (test "a,b=1,2;return b" 2)
+    (test "a,b,c=false,true,false; return b")
     (test "a,b=1;return b" #nil)
 
     ;; parenthetical expressions
@@ -1130,19 +1174,25 @@ of an identifier"
     (test "a = { a = false , false ; b = true , true ; }; return a.b" #t)
     (test "a = { a = false , false ; b = true , true ; }; return a[2]" #t)
 
+    ;; locals
+    (test "local a; a = true; return a")
+    (test "local a = true; return a")
+    (test "local a,b=false,true; return b")
+
+    ;; - compiler
     ;; method invocations
     ;; for loops
     ;; repeat loops
-    ;; local syntax
-    ;; metatables
-    ;; metatable events
     ;; variable arguments
     ;; multiple returns
+    ;; - runtime
+    ;; metatables
+    ;; metatable events
 ))
 
 #;(begin
   (define var
-  "a = { b = true }")
+  "local a,b=false,true; return b")
   (display (compile ((make-parser (open-input-string var)))
                     #:from 'lua #:to 'tree-il))
   (newline))


hooks/post-receive
-- 
GNU Guile