Fix and/or double evaluation. Add math.modf, math.fmod.

* module/language/lua/compile-tree-il.scm: Fix and/or double evaluation.

* module/language/lua/notes.org: Add file describing known issues.

* module/language/lua/parser.scm: (token-type): Recognize and/or.

* module/language/lua/standard/math.scm: Add modf, fmod implementations.

* test-suite/tests/lua-eval-3.test: Add another test file for basic
  language features.

module/language/lua/compile-tree-il.scm

@@ -104,7 +104,6 @@ dropped silently"
   ;; singly-valued continuation.
   (make-application src (make-primitive-ref src 'values) (list exp)))
 
-
 ;; main compiler
 
 (define context (make-parameter #f))
@@ -149,7 +148,7 @@ dropped silently"
         src meta
         (make-lambda-case src '() arguments '... #f
                           (map (lambda (x) (make-const src #nil)) arguments)
-                          (append! argument-gensyms (list '...))
+                          (append argument-gensyms (list (gensym "...")))
                           (compile body)
                           #f))))
 
@@ -401,6 +400,7 @@ dropped silently"
             ((not) (make-primitive-ref src 'not)))
           (list (compile right)))))
 
+
     ((ast-binary-operation src operator left right)
      (let ((left (compile left))
            (right (compile right)))
@@ -417,10 +417,20 @@ dropped silently"
          ((#:==)     (make-runtime-application src 'eq     (list left right)))
          ((#:~=)     (make-runtime-application src 'neq    (list left right)))
          ((#:concat) (make-runtime-application src 'concat (list left right)))
-         ;; FIXME: double-evaluation
+         ((#:or)
-         ((#:or)     (make-conditional src left left right))
+          (let ((tmp (gensym "or-tmp")))
-         ;; FIXME: double-evaluation
+            (make-let src '(or-tmp) (list tmp) (list left)
-         ((#:and)    (make-conditional src left right left))
+              (make-conditional src
+                (make-lexical-ref src 'or-tmp tmp)
+                (make-lexical-ref src 'or-tmp tmp)
+                right))))
+        ((#:and)
+          (let ((tmp (gensym "and-tmp")))
+            (make-let src '(and-tmp) (list tmp) (list left)
+              (make-conditional src
+                (make-lexical-ref src 'and-tmp tmp)
+                right
+                (make-lexical-ref src 'and-tmp tmp)))))
          (else (error #:COMPILE "unknown binary operator" operator)))))))
 
 ;; exported compiler function

module/language/lua/notes.org

@@ -0,0 +1,31 @@
+This is an org-mode todo list of stuff that needs to be done for Guile Lua.
+
+* Before inclusion
+** DONE And/or evaluate too much
+   CLOSED: [2011-04-19 Tue 19:36]
+** DONE Standard library functions: math.modf, math.fmod
+   CLOSED: [2011-04-21 Thu 15:43]
+** TODO Variable arguments and multiple returns
+** TODO Use prompt and abort instead of throw and catch
+** TODO Standard library function: module
+** TODO Standard library function: table.sort
+** TODO Get the official test suite running
+
+* Eh
+** TODO Better testing of standard library modules io, os
+** TODO Function environments (getfenv and setfenv)
+** TODO Parser should probably be rewritten
+
+
+* Differences
+  Here are some difference in Guile Lua's behavior that should not cause
+  problems in porting Lua code.
+
+** Guile Lua will accept the "break" statement anywhere
+   For instance:
+   for k,v in table do
+     function breaky() break end
+   end
+   Would be rejected by Lua but not by Guile Lua.
+
+** math.sqrt accepts negative arguments since Guile's numeric tower is capable of representing complex numbers

module/language/lua/parser.scm

@@ -125,7 +125,8 @@
 (define *special-tokens*
   '(#\. #\( #\) #\, #\- #\< #\; #\+ #\{ #\} #\[ #\] #\: #\#
     #:function #:end #:if #:return #:elseif #:then #:else #:true #:false
-    #:nil #:== #:~= #:= #\> #:>= #:<= #:local #:dots #:break #:do #:in))
+    #:nil #:== #:~= #:= #\> #:>= #:<= #:local #:dots #:break #:do #:in
+    #:and #:or))
 
 (define (token/type t)
   (cond

module/language/lua/standard/math.scm

@@ -21,14 +21,14 @@
 (define-module (language lua standard math)
   #:use-module (language lua runtime))
 
-;; TODO: math.modf
+;; TODO: math.frexp
-;; TODO: math.deg,rad,frexp,random not tested
 
 ;; NOTE: as opposed to lua, math.sqrt accepts negative arguments, as
 ;; guile's numeric tower is capable of representing complex numbers
 
 (define huge +inf.0)
 (define *nan* (nan))
+;; We define some constants here to more closely match Lua's behavior
 (define pi 3.14159265358979323846)
 (define radians_per_degree (/ pi 180.0))
 
@@ -91,6 +91,24 @@
 (define (atan2 x y)
   (atan (/ x y)))
 
+(define (deg x)
+  (/ x radians_per_degree))
+
+(define (ldexp x exp)
+  (cond ((= exp 0) x)
+        ((= exp *nan*) *nan*)
+        ((= exp +inf.0) +inf.0)
+        ((= exp -inf.0) -inf.0)
+        (else (* x (expt 2 exp)))))
+
+(define log2
+  (let ((log2 (log 2)))
+    (lambda (x)
+      (/ (log x) log2))))
+
+(define (rad x)
+  (* x radians_per_degree))
+
 ;; copy the global random state for this module so we don't mutate it
 (define randomstate (copy-random-state *random-state*))
 
@@ -105,32 +123,3 @@
         ((and m) (+ 1 ((@ (guile) random) m)))
         ((and m n) (+ m ((@ (guile) random) n)))
         (else (error #:RANDOM "should not happen"))))
-
-(define (deg x)
-  (/ x radians_per_degree))
-
-(define (rad x)
-  (* x radians_per_degree))
-
-(define (ldexp x exp)
-  (cond ((= exp 0) x)
-        ((= exp *nan*) *nan*)
-        ((= exp +inf.0) +inf.0)
-        ((= exp -inf.0) -inf.0)
-        (else (* x (expt 2 exp)))))
-
-(define log2
-  (let ((log2 (log 2)))
-    (lambda (x)
-      (/ (log x) log2))))
-
-(define (frexp x)
-  (if (zero? x)
-      0.0
-      (let* ((l2 (log2 x))
-             (e (floor (log2 x)))
-             (e (if (= l2 e)
-                    (inexact->exact e)
-                    (+ (inexact->exact e) 1)))
-             (f (/ x (expt 2 e))))
-        f)))

test-suite/tests/lua-eval-3.test

@@ -0,0 +1,49 @@
+;;;; lua-eval-2.test --- basic tests for builtin lua constructs, act III  -*- mode: scheme -*-
+;;;;
+;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-lua)
+  #:use-module (ice-9 format)
+  #:use-module (language tree-il)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-8)
+  #:use-module (system base compile)
+  #:use-module (test-suite lib)
+
+  #:use-module (language lua parser)
+
+  )
+
+(with-test-prefix "lua-eval"
+  (define (from-string string)
+    (compile ((make-parser (open-input-string string)))
+             #:from 'lua
+             #:to 'value))
+  (letrec-syntax
+    ((test
+      (syntax-rules ()
+        ((_ string expect)
+         (pass-if (format #f "~S => ~S" string expect) (equal? (from-string string) expect)))
+        ((_ string)
+         (test string #t)))))
+
+    ;; make sure logical expressions don't evaluate expressions twice
+    ;;; y will equal 2 in case of extra eval
+    (test "y = 0 function tmp() y = y + 1 return true end assert(tmp() or tmp()) return y == 1")
+    ;;; y will equal 4 in case of extra eval
+    (test "y = 0 function tmp() y = y + 2 return false end; function tmp2() y = y + 1 return true end; print(tmp() and tmp2()) print(y) return y == 2")
+  ))