diff options
author | Phil <theseaisinhere+git@gmail.com> | 2011-04-21 18:05:48 -0500 |
---|---|---|
committer | Ian Price <ianprice90@googlemail.com> | 2013-09-09 17:01:24 +0100 |
commit | becaec9a4e7042a98c2dfa5fd3af9d7c30f71f44 (patch) | |
tree | 94f4ed7ffe76db22904f085ea9c3717e43875962 | |
parent | 8c91ae59f97200208962d845dbe972ad7c3cda3c (diff) | |
download | guile-becaec9a4e7042a98c2dfa5fd3af9d7c30f71f44.tar.gz |
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.
-rw-r--r-- | module/language/lua/compile-tree-il.scm | 28 | ||||
-rw-r--r-- | module/language/lua/notes.org | 31 | ||||
-rw-r--r-- | module/language/lua/parser.scm | 9 | ||||
-rw-r--r-- | module/language/lua/standard/math.scm | 49 | ||||
-rw-r--r-- | test-suite/tests/lua-eval-3.test | 49 |
5 files changed, 123 insertions, 43 deletions
diff --git a/module/language/lua/compile-tree-il.scm b/module/language/lua/compile-tree-il.scm index 1cbd31882..dcd2956cc 100644 --- a/module/language/lua/compile-tree-il.scm +++ b/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)))) @@ -210,7 +209,7 @@ dropped silently" ;; FIXME: use abort instead of throw (make-application src (make-module-ref src '(guile) 'throw #t) (list (make-const src 'lua-break)))) - + ;; FIXME: use prompt and abort instead of throw and catch ((ast-list-for-loop src names gs-names exps body) (let* ((gs-iterator (gensym "iterator")) @@ -260,7 +259,7 @@ dropped silently" ;; initialize variables and start loop (begin (apply (primitive call-with-values) - (lambda () + (lambda () (lambda-case (,no-arguments ,(unparse-tree-il @@ -305,7 +304,7 @@ dropped silently" (gs-loop (gensym "loop")) (while-condition `(if (apply (primitive >) (lexical step ,gs-step) (const 0)) - (if (apply (primitive <=) + (if (apply (primitive <=) (lexical variable ,gs-variable) (lexical limit ,gs-limit)) (apply (lexical loop ,gs-loop)) @@ -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) (make-conditional src left left right)) - ;; FIXME: double-evaluation - ((#:and) (make-conditional src left right left)) + ((#:or) + (let ((tmp (gensym "or-tmp"))) + (make-let src '(or-tmp) (list tmp) (list 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 diff --git a/module/language/lua/notes.org b/module/language/lua/notes.org new file mode 100644 index 000000000..49f6b12fe --- /dev/null +++ b/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 diff --git a/module/language/lua/parser.scm b/module/language/lua/parser.scm index 1a04f89da..52cf5a381 100644 --- a/module/language/lua/parser.scm +++ b/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 @@ -252,11 +253,11 @@ "Given a variable's NAME, look up its binding." (and e (or (assq-ref (environment-bindings e) name) (environment-lookup-aux name (environment-parent e))))) - + (define (environment-lookup-gensym name) "Given a variable's NAME, look up its gensym" (and=> (environment-lookup-aux name) binding-gensym)) - + (define (environment-lookup-type name) "Given a variable's NAME, look up its global" (and=> (environment-lookup-aux name) binding-type)) @@ -675,7 +676,7 @@ *void-literal*))))))) (enforce-next! #:end) x)))) - + ;; repeat-statement -> REPEAT chunk UNTIL expression (define (repeat-statement) (let ((src (get-source-info))) diff --git a/module/language/lua/standard/math.scm b/module/language/lua/standard/math.scm index 91ccd174f..dd2bbbce2 100644 --- a/module/language/lua/standard/math.scm +++ b/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.deg,rad,frexp,random not tested +;; TODO: math.frexp ;; 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,27 +91,9 @@ (define (atan2 x y) (atan (/ x y))) -;; copy the global random state for this module so we don't mutate it -(define randomstate (copy-random-state *random-state*)) - -(define (randomseed seed . _) - (set! randomstate (seed->random-state seed))) - -(define* (random #:optional m n #:rest _) - ;; this can be a little confusing because guile's random number - ;; generator only allows [0, N) but we need [0,1), [1,m] and [m,n] - (cond ((and (not m) (not n)) ((@ (guile) random) 1.0)) - ;; this is really [1,M) - ((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*) @@ -124,13 +106,20 @@ (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))) +(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*)) + +(define (randomseed seed . _) + (set! randomstate (seed->random-state seed))) + +(define* (random #:optional m n #:rest _) + ;; this can be a little confusing because guile's random number + ;; generator only allows [0, N) but we need [0,1), [1,m] and [m,n] + (cond ((and (not m) (not n)) ((@ (guile) random) 1.0)) + ;; this is really [1,M) + ((and m) (+ 1 ((@ (guile) random) m))) + ((and m n) (+ m ((@ (guile) random) n))) + (else (error #:RANDOM "should not happen")))) diff --git a/test-suite/tests/lua-eval-3.test b/test-suite/tests/lua-eval-3.test new file mode 100644 index 000000000..881389c32 --- /dev/null +++ b/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") + )) |