mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-03 13:20:26 +02:00
becaec9a4e
* 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.
125 lines
3.6 KiB
Scheme
125 lines
3.6 KiB
Scheme
;;; Guile Lua --- math standard library
|
|
|
|
;;; 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
|
|
|
|
;;; Code:
|
|
|
|
(define-module (language lua standard math)
|
|
#:use-module (language lua runtime))
|
|
|
|
;; 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))
|
|
|
|
(letrec-syntax
|
|
((wrap-builtins
|
|
(syntax-rules (rename rename2 variable-arity)
|
|
;; we must know the arity of the wrapped procedure because lua ignores superfluous arguments whereas it is an error in scheme
|
|
|
|
;; simple wrap with new name and 1 argument
|
|
((_ () (rename guile-name lua-name))
|
|
(define (lua-name a . _)
|
|
((@ (guile) guile-name) a)))
|
|
|
|
((_ () (rename2 guile-name lua-name))
|
|
(define (lua-name a b . _)
|
|
((@ (guile) guile-name) a b)))
|
|
|
|
;; simple wrap with 2 arguments
|
|
((_ () (2 name))
|
|
(define (name a b . _)
|
|
((@ (guile) name) a b)))
|
|
|
|
;; simple wrap with variable arguments
|
|
((_ () (variable-arity name))
|
|
(define (name . _)
|
|
(apply (@ (guile) name) _)))
|
|
|
|
;; simple wrap with 1 argument
|
|
((_ () name)
|
|
(define (name a . _)
|
|
((@ (guile) name) a)))
|
|
|
|
;; 1) take all input and pass it to subtransformers
|
|
((_ subform ...)
|
|
(begin
|
|
(wrap-builtins () subform)
|
|
...)))))
|
|
(wrap-builtins
|
|
abs
|
|
acos
|
|
asin
|
|
atan
|
|
(rename ceiling ceil)
|
|
cos
|
|
cosh
|
|
exp
|
|
(rename2 remainder modf)
|
|
floor
|
|
log
|
|
log10
|
|
sin
|
|
sinh
|
|
sqrt
|
|
(variable-arity max)
|
|
(variable-arity min)
|
|
(rename expt pow)
|
|
tan
|
|
tanh))
|
|
|
|
(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*))
|
|
|
|
(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"))))
|