mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

Implemented some important list built-ins.

Browse source 
* module/language/elisp/runtime.scm: Updated/added convenience macros.
* module/language/elisp/runtime/function-slot.scm: Implement list built-ins.
* module/language/elisp/runtime/macro-slot.scm: Implement list built-ins.
* test-suite/tests/elisp-compiler.test: Test the implemented built-ins.
This commit is contained in:
Daniel Kraft 2009-07-18 20:10:24 +02:00
parent 7d1a978289
commit f614ca12cd
4 changed files with 235 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/language/elisp/runtime.scm
View file

@ -20,8 +20,8 @@
;;; Code:
(define-module (language elisp runtime)
#:export (void nil-value t-value elisp-bool macro-error)
#:export-syntax (built-in-func built-in-macro))
#:export (void nil-value t-value elisp-bool runtime-error macro-error)
#:export-syntax (built-in-func built-in-macro prim))
; This module provides runtime support for the Elisp front-end.
@ -39,11 +39,13 @@
; Report an error during macro compilation, that means some special compilation
; (syntax) error.
; (syntax) error; or report a simple runtime-error from a built-in function.
(define (macro-error msg . args)
(apply error msg args))
(define runtime-error macro-error)
; Convert a scheme boolean to Elisp.
@ -67,3 +69,12 @@
(syntax-rules ()
((_ name value)
(define-public name value))))
; Call a guile-primitive that may be rebound for elisp and thus needs absolute
; addressing.
(define-syntax prim
(syntax-rules ()
((_ sym args ...)
((@ (guile) sym) args ...))))

149
module/language/elisp/runtime/function-slot.scm
View file

@ -40,8 +40,7 @@
(built-in-func floatp (lambda (num)
(elisp-bool (and (real? num)
(or (inexact? num)
((@ (guile) not)
(integer? num)))))))
(prim not (integer? num)))))))
(built-in-func integerp (lambda (num)
(elisp-bool (and (exact? num)
@ -53,35 +52,34 @@
(built-in-func wholenump (lambda (num)
(elisp-bool (and (exact? num)
(integer? num)
((@ (guile) >=) num 0)))))
(prim >= num 0)))))
(built-in-func zerop (lambda (num)
(elisp-bool ((@ (guile) =) num 0))))
(elisp-bool (prim = num 0))))
; Number comparisons.
(built-in-func = (lambda (num1 num2)
(elisp-bool ((@ (guile) =) num1 num2))))
(elisp-bool (prim = num1 num2))))
(built-in-func /= (lambda (num1 num2)
(elisp-bool ((@ (guile) not) ((@ (guile) =) num1 num2)))))
(elisp-bool (prim not (prim = num1 num2)))))
(built-in-func < (lambda (num1 num2)
(elisp-bool ((@ (guile) <) num1 num2))))
(elisp-bool (prim < num1 num2))))
(built-in-func <= (lambda (num1 num2)
(elisp-bool ((@ (guile) <=) num1 num2))))
(elisp-bool (prim <= num1 num2))))
(built-in-func > (lambda (num1 num2)
(elisp-bool ((@ (guile) >) num1 num2))))
(elisp-bool (prim > num1 num2))))
(built-in-func >= (lambda (num1 num2)
(elisp-bool ((@ (guile) >=) num1 num2))))
(elisp-bool (prim >= num1 num2))))
(built-in-func max (lambda (. nums)
((@ (guile) apply) (@ (guile) max) nums)))
(prim apply (@ (guile) max) nums)))
(built-in-func min (lambda (. nums)
((@ (guile) apply) (@ (guile) min) nums)))
(prim apply (@ (guile) min) nums)))
(built-in-func abs (lambda (num)
((@ (guile) abs) num)))
(built-in-func abs (@ (guile) abs))
; Number conversion.
@ -114,6 +112,129 @@
(built-in-func fround (@ (guile) round))
; List predicates.
(built-in-func consp
(lambda (el)
(elisp-bool (pair? el))))
(built-in-func atomp
(lambda (el)
(elisp-bool (prim not (pair? el)))))
(built-in-func listp
(lambda (el)
(elisp-bool (or (pair? el) (null? el)))))
(built-in-func nlistp
(lambda (el)
(elisp-bool (and (prim not (pair? el))
(prim not (null? el))))))
(built-in-func null
(lambda (el)
(elisp-bool (null? el))))
; Accessing list elements.
(built-in-func car
(lambda (el)
(if (null? el)
nil-value
(prim car el))))
(built-in-func cdr
(lambda (el)
(if (null? el)
nil-value
(prim cdr el))))
(built-in-func car-safe
(lambda (el)
(if (pair? el)
(prim car el)
nil-value)))
(built-in-func cdr-safe
(lambda (el)
(if (pair? el)
(prim cdr el)
nil-value)))
(built-in-func nth
(lambda (n lst)
(if (negative? n)
(prim car lst)
(let iterate ((i n)
(tail lst))
(cond
((null? tail) nil-value)
((zero? i) (prim car tail))
(else (iterate (prim 1- i) (prim cdr tail))))))))
(built-in-func nthcdr
(lambda (n lst)
(if (negative? n)
lst
(let iterate ((i n)
(tail lst))
(cond
((null? tail) nil-value)
((zero? i) tail)
(else (iterate (prim 1- i) (prim cdr tail))))))))
; Building lists.
(built-in-func cons (@ (guile) cons))
(built-in-func list (@ (guile) list))
(built-in-func make-list
(lambda (len obj)
(prim make-list len obj)))
(built-in-func append (@ (guile) append))
(built-in-func reverse (@ (guile) reverse))
(built-in-func copy-tree (@ (guile) copy-tree))
(built-in-func number-sequence
(lambda (from . rest)
(if (prim > (prim length rest) 2)
(runtime-error "too many arguments for number-sequence"
(prim cdddr rest))
(if (null? rest)
`(,from)
(let ((to (prim car rest))
(sep (if (or (null? (prim cdr rest))
(eq? nil-value (prim cadr rest)))
1
(prim cadr rest))))
(cond
((or (eq? nil-value to) (prim = to from)) `(,from))
((and (zero? sep) (prim not (prim = from to)))
(runtime-error "infinite list in number-sequence"))
((prim < (prim * to sep) (prim * from sep)) '())
(else
(let iterate ((i (prim +
from
(prim * sep
(prim quotient
(prim abs (prim - to from))
(prim abs sep)))))
(result '()))
(if (prim = i from)
(prim cons i result)
(iterate (prim - i sep) (prim cons i result)))))))))))
; Changing lists.
(built-in-func setcar
(lambda (cell val)
(prim set-car! cell val)
val))
(built-in-func setcdr
(lambda (cell val)
(prim set-cdr! cell val)
val))
; Miscellaneous.
(built-in-func not (lambda (x)

12
module/language/elisp/runtime/macro-slot.scm
View file

@ -62,3 +62,15 @@
,@(if (= (length args) 3)
(list (caddr args))
'()))))))
; Pop off the first element from a list or push one to it.
(built-in-macro pop
(lambda (list-name)
`(prog1 (car ,list-name)
(setq ,list-name (cdr ,list-name)))))
(built-in-macro push
(lambda (new-el list-name)
`(setq ,list-name (cons ,new-el ,list-name))))