diff --git a/module/language/elisp/README b/module/language/elisp/README index dbcac2388..4431bbdb0 100644 --- a/module/language/elisp/README +++ b/module/language/elisp/README @@ -29,3 +29,4 @@ Especially still missing: * advice? * defsubst and inlining * real quoting + * need fluids for function bindings? diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm index c29de1e84..235341989 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -30,16 +30,20 @@ (built-in-func floatp (lambda (num) (elisp-bool (and (real? num) - (not (integer? num)))))) + (or (inexact? num) + ((@ (guile) not) + (integer? num))))))) (built-in-func integerp (lambda (num) - (elisp-bool (integer? num)))) + (elisp-bool (and (exact? num) + (integer? num))))) (built-in-func numberp (lambda (num) (elisp-bool (real? num)))) (built-in-func wholenump (lambda (num) - (elisp-bool (and (integer? num) + (elisp-bool (and (exact? num) + (integer? num) ((@ (guile) >=) num 0))))) (built-in-func zerop (lambda (num) @@ -99,3 +103,9 @@ (built-in-func fceiling (@ (guile) ceiling)) (built-in-func ftruncate (@ (guile) truncate)) (built-in-func fround (@ (guile) round)) + + +; Miscellaneous. + +(built-in-func not (lambda (x) + (if x nil-value t-value))) diff --git a/test-suite/tests/elisp-compiler.test b/test-suite/tests/elisp-compiler.test index db604f308..fdb677195 100644 --- a/test-suite/tests/elisp-compiler.test +++ b/test-suite/tests/elisp-compiler.test @@ -84,7 +84,10 @@ (pass-if-equal "empty or" nil-value (or)) (pass-if-equal "failing or" nil-value (or nil nil nil)) - (pass-if-equal "succeeding or" 1 (or nil 1 nil 2 nil 3))) + (pass-if-equal "succeeding or" 1 (or nil 1 nil 2 nil 3)) + + (pass-if-equal "not true" nil-value (not 1)) + (pass-if-equal "not false" t-value (not nil))) (with-test-prefix/compile "Iteration" @@ -206,3 +209,46 @@ (foo)) (and (= 43 (bar 42)) (zerop a))))) + + +; Test the built-ins. +; =================== + +(with-test-prefix/compile "Number Built-Ins" + + (pass-if "floatp" + (and (floatp 1.0) (not (floatp 1)) (not (floatp 'a)))) + (pass-if "integerp" + (and (integerp 42) (integerp -2) (not (integerp 1.0)))) + (pass-if "numberp" + (and (numberp 1.0) (numberp -2) (not (numberp 'a)))) + (pass-if "wholenump" + (and (wholenump 0) (not (wholenump -2)) (not (wholenump 1.0)))) + (pass-if "zerop" + (and (zerop 0) (zerop 0.0) (not (zerop 1)))) + + (pass-if "comparisons" + (and (= 1 1.0) (/= 0 1) + (< 1 2) (> 2 1) (>= 1 1) (<= 1 1) + (not (< 1 1)) (not (<= 2 1)))) + + (pass-if "max and min" + (and (= (max -5 2 4.0 1) 4.0) (= (min -5 2 4.0 1) -5) + (= (max 1) 1) (= (min 1) 1))) + (pass-if "abs" + (and (= (abs 1.0) 1.0) (= (abs -5) 5))) + + (pass-if "float" + (and (= (float 1) 1) (= (float 5.5) 5.5) + (floatp (float 1)))) + + (pass-if-equal "basic arithmetic operators" -8.5 + (+ (1+ 0) (1- 0) (- 5.5) (* 2 -2) (- 2 1))) + (pass-if "modulo" + (= (% 5 3) 2)) + + (pass-if "floating point rounding" + (and (= (ffloor 1.7) 1.0) (= (ffloor -1.2) -2.0) (= (ffloor 1.0) 1.0) + (= (fceiling 1.2) 2.0) (= (fceiling -1.7) -1.0) (= (fceiling 1.0) 1.0) + (= (ftruncate 1.6) 1.0) (= (ftruncate -1.7) -1.0) + (= (fround 1.2) 1.0) (= (fround 1.7) 2.0) (= (fround -1.7) -2.0))))