mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-18 18:40:22 +02:00
reindent
* module/language/elisp/bindings.scm: * module/language/elisp/compile-tree-il.scm: * module/language/elisp/lexer.scm: * module/language/elisp/parser.scm: * module/language/elisp/runtime.scm: * module/language/elisp/runtime/function-slot.scm: * module/language/elisp/runtime/macro-slot.scm: * module/language/elisp/spec.scm: Reindent.
This commit is contained in:
Brian Templeton
parent
27b9476a8d
commit
ae20bb4eee
8 changed files with 1030 additions and 808 deletions
|
|
@ -29,68 +29,85 @@
|
|||
|
||||
;;; Equivalence and equalness predicates.
|
||||
|
||||
(built-in-func eq (lambda (a b)
|
||||
(elisp-bool (eq? a b))))
|
||||
(built-in-func eq
|
||||
(lambda (a b)
|
||||
(elisp-bool (eq? a b))))
|
||||
|
||||
(built-in-func equal (lambda (a b)
|
||||
(elisp-bool (equal? a b))))
|
||||
(built-in-func equal
|
||||
(lambda (a b)
|
||||
(elisp-bool (equal? a b))))
|
||||
|
||||
;;; Number predicates.
|
||||
|
||||
(built-in-func floatp (lambda (num)
|
||||
(elisp-bool (and (real? num)
|
||||
(or (inexact? num)
|
||||
(prim not (integer? num)))))))
|
||||
(built-in-func floatp
|
||||
(lambda (num)
|
||||
(elisp-bool (and (real? num)
|
||||
(or (inexact? num)
|
||||
(prim not (integer? num)))))))
|
||||
|
||||
(built-in-func integerp (lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)))))
|
||||
(built-in-func integerp
|
||||
(lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)))))
|
||||
|
||||
(built-in-func numberp (lambda (num)
|
||||
(elisp-bool (real? num))))
|
||||
(built-in-func numberp
|
||||
(lambda (num)
|
||||
(elisp-bool (real? num))))
|
||||
|
||||
(built-in-func wholenump (lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)
|
||||
(prim >= num 0)))))
|
||||
(built-in-func wholenump
|
||||
(lambda (num)
|
||||
(elisp-bool (and (exact? num)
|
||||
(integer? num)
|
||||
(prim >= num 0)))))
|
||||
|
||||
(built-in-func zerop (lambda (num)
|
||||
(elisp-bool (prim = num 0))))
|
||||
(built-in-func zerop
|
||||
(lambda (num)
|
||||
(elisp-bool (prim = num 0))))
|
||||
|
||||
;;; Number comparisons.
|
||||
|
||||
(built-in-func = (lambda (num1 num2)
|
||||
(elisp-bool (prim = num1 num2))))
|
||||
(built-in-func =
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim = num1 num2))))
|
||||
|
||||
(built-in-func /= (lambda (num1 num2)
|
||||
(elisp-bool (prim not (prim = num1 num2)))))
|
||||
(built-in-func /=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim not (prim = num1 num2)))))
|
||||
|
||||
(built-in-func < (lambda (num1 num2)
|
||||
(elisp-bool (prim < num1 num2))))
|
||||
(built-in-func <
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim < num1 num2))))
|
||||
|
||||
(built-in-func <= (lambda (num1 num2)
|
||||
(elisp-bool (prim <= num1 num2))))
|
||||
(built-in-func <=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim <= num1 num2))))
|
||||
|
||||
(built-in-func > (lambda (num1 num2)
|
||||
(elisp-bool (prim > num1 num2))))
|
||||
(built-in-func >
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim > num1 num2))))
|
||||
|
||||
(built-in-func >= (lambda (num1 num2)
|
||||
(elisp-bool (prim >= num1 num2))))
|
||||
(built-in-func >=
|
||||
(lambda (num1 num2)
|
||||
(elisp-bool (prim >= num1 num2))))
|
||||
|
||||
(built-in-func max (lambda (. nums)
|
||||
(prim apply (@ (guile) max) nums)))
|
||||
(built-in-func max
|
||||
(lambda (. nums)
|
||||
(prim apply (@ (guile) max) nums)))
|
||||
|
||||
(built-in-func min (lambda (. nums)
|
||||
(prim apply (@ (guile) min) nums)))
|
||||
(built-in-func min
|
||||
(lambda (. nums)
|
||||
(prim apply (@ (guile) min) nums)))
|
||||
|
||||
(built-in-func abs (@ (guile) abs))
|
||||
(built-in-func abs
|
||||
(@ (guile) abs))
|
||||
|
||||
;;; Number conversion.
|
||||
|
||||
(built-in-func float (lambda (num)
|
||||
(if (exact? num)
|
||||
(exact->inexact num)
|
||||
num)))
|
||||
(built-in-func float
|
||||
(lambda (num)
|
||||
(if (exact? num)
|
||||
(exact->inexact num)
|
||||
num)))
|
||||
|
||||
;;; TODO: truncate, floor, ceiling, round.
|
||||
|
||||
|
|
@ -149,48 +166,48 @@
|
|||
(built-in-func car
|
||||
(lambda (el)
|
||||
(if (null? el)
|
||||
nil-value
|
||||
(prim car el))))
|
||||
nil-value
|
||||
(prim car el))))
|
||||
|
||||
(built-in-func cdr
|
||||
(lambda (el)
|
||||
(if (null? el)
|
||||
nil-value
|
||||
(prim cdr el))))
|
||||
nil-value
|
||||
(prim cdr el))))
|
||||
|
||||
(built-in-func car-safe
|
||||
(lambda (el)
|
||||
(if (pair? el)
|
||||
(prim car el)
|
||||
nil-value)))
|
||||
(prim car el)
|
||||
nil-value)))
|
||||
|
||||
(built-in-func cdr-safe
|
||||
(lambda (el)
|
||||
(if (pair? el)
|
||||
(prim cdr el)
|
||||
nil-value)))
|
||||
(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))))))))
|
||||
(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))))))))
|
||||
lst
|
||||
(let iterate ((i n)
|
||||
(tail lst))
|
||||
(cond
|
||||
((null? tail) nil-value)
|
||||
((zero? i) tail)
|
||||
(else (iterate (prim 1- i) (prim cdr tail))))))))
|
||||
|
||||
(built-in-func length (@ (guile) length))
|
||||
|
||||
|
|
@ -213,31 +230,36 @@
|
|||
(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)))))))))))
|
||||
(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.
|
||||
|
||||
|
|
@ -282,12 +304,16 @@
|
|||
(built-in-func boundp
|
||||
(lambda (sym)
|
||||
(elisp-bool (prim not
|
||||
(eq? void (reference-variable value-slot-module sym))))))
|
||||
(eq? void
|
||||
(reference-variable value-slot-module
|
||||
sym))))))
|
||||
|
||||
(built-in-func fboundp
|
||||
(lambda (sym)
|
||||
(elisp-bool (prim not
|
||||
(eq? void (reference-variable function-slot-module sym))))))
|
||||
(eq? void
|
||||
(reference-variable function-slot-module
|
||||
sym))))))
|
||||
|
||||
;;; Function calls. These must take care of special cases, like using
|
||||
;;; symbols or raw lambda-lists as functions!
|
||||
|
|
@ -295,15 +321,17 @@
|
|||
(built-in-func apply
|
||||
(lambda (func . args)
|
||||
(let ((real-func (cond
|
||||
((symbol? func)
|
||||
(reference-variable-with-check function-slot-module
|
||||
func))
|
||||
((list? func)
|
||||
(if (and (prim not (null? func))
|
||||
(eq? (prim car func) 'lambda))
|
||||
(compile func #:from 'elisp #:to 'value)
|
||||
(runtime-error "list is not a function" func)))
|
||||
(else func))))
|
||||
((symbol? func)
|
||||
(reference-variable-with-check
|
||||
function-slot-module
|
||||
func))
|
||||
((list? func)
|
||||
(if (and (prim not (null? func))
|
||||
(eq? (prim car func) 'lambda))
|
||||
(compile func #:from 'elisp #:to 'value)
|
||||
(runtime-error "list is not a function"
|
||||
func)))
|
||||
(else func))))
|
||||
(prim apply (@ (guile) apply) real-func args))))
|
||||
|
||||
(built-in-func funcall
|
||||
|
|
|
|||
|
|
@ -62,23 +62,23 @@
|
|||
(lambda (. clauses)
|
||||
(let iterate ((tail clauses))
|
||||
(if (null? tail)
|
||||
'nil
|
||||
(let ((cur (car tail))
|
||||
(rest (iterate (cdr tail))))
|
||||
(prim cond
|
||||
((prim or (not (list? cur)) (null? cur))
|
||||
(macro-error "invalid clause in cond" cur))
|
||||
((null? (cdr cur))
|
||||
(let ((var (gensym)))
|
||||
`(without-void-checks (,var)
|
||||
(lexical-let ((,var ,(car cur)))
|
||||
(if ,var
|
||||
,var
|
||||
,rest)))))
|
||||
(else
|
||||
`(if ,(car cur)
|
||||
(progn ,@(cdr cur))
|
||||
,rest))))))))
|
||||
'nil
|
||||
(let ((cur (car tail))
|
||||
(rest (iterate (cdr tail))))
|
||||
(prim cond
|
||||
((prim or (not (list? cur)) (null? cur))
|
||||
(macro-error "invalid clause in cond" cur))
|
||||
((null? (cdr cur))
|
||||
(let ((var (gensym)))
|
||||
`(without-void-checks (,var)
|
||||
(lexical-let ((,var ,(car cur)))
|
||||
(if ,var
|
||||
,var
|
||||
,rest)))))
|
||||
(else
|
||||
`(if ,(car cur)
|
||||
(progn ,@(cdr cur))
|
||||
,rest))))))))
|
||||
|
||||
;;; The and and or forms can also be easily defined with macros.
|
||||
|
||||
|
|
@ -104,54 +104,56 @@
|
|||
x
|
||||
(let ((var (gensym)))
|
||||
`(without-void-checks
|
||||
(,var)
|
||||
(lexical-let ((,var ,x))
|
||||
(if ,var
|
||||
,var
|
||||
,(iterate (car tail) (cdr tail)))))))))))
|
||||
(,var)
|
||||
(lexical-let ((,var ,x))
|
||||
(if ,var
|
||||
,var
|
||||
,(iterate (car tail) (cdr tail)))))))))))
|
||||
|
||||
;;; Define the dotimes and dolist iteration macros.
|
||||
|
||||
(built-in-macro dotimes
|
||||
(lambda (args . body)
|
||||
(if (prim or (not (list? args))
|
||||
(< (length args) 2)
|
||||
(> (length args) 3))
|
||||
(macro-error "invalid dotimes arguments" args)
|
||||
(let ((var (car args))
|
||||
(count (cadr args)))
|
||||
(if (not (symbol? var))
|
||||
(macro-error "expected symbol as dotimes variable"))
|
||||
`(let ((,var 0))
|
||||
(while ((guile-primitive <) ,var ,count)
|
||||
,@body
|
||||
(setq ,var ((guile-primitive 1+) ,var)))
|
||||
,@(if (= (length args) 3)
|
||||
(list (caddr args))
|
||||
'()))))))
|
||||
(if (prim or
|
||||
(not (list? args))
|
||||
(< (length args) 2)
|
||||
(> (length args) 3))
|
||||
(macro-error "invalid dotimes arguments" args)
|
||||
(let ((var (car args))
|
||||
(count (cadr args)))
|
||||
(if (not (symbol? var))
|
||||
(macro-error "expected symbol as dotimes variable"))
|
||||
`(let ((,var 0))
|
||||
(while ((guile-primitive <) ,var ,count)
|
||||
,@body
|
||||
(setq ,var ((guile-primitive 1+) ,var)))
|
||||
,@(if (= (length args) 3)
|
||||
(list (caddr args))
|
||||
'()))))))
|
||||
|
||||
(built-in-macro dolist
|
||||
(lambda (args . body)
|
||||
(if (prim or (not (list? args))
|
||||
(< (length args) 2)
|
||||
(> (length args) 3))
|
||||
(macro-error "invalid dolist arguments" args)
|
||||
(let ((var (car args))
|
||||
(iter-list (cadr args))
|
||||
(tailvar (gensym)))
|
||||
(if (not (symbol? var))
|
||||
(macro-error "expected symbol as dolist variable")
|
||||
`(let (,var)
|
||||
(without-void-checks (,tailvar)
|
||||
(lexical-let ((,tailvar ,iter-list))
|
||||
(while ((guile-primitive not)
|
||||
((guile-primitive null?) ,tailvar))
|
||||
(setq ,var ((guile-primitive car) ,tailvar))
|
||||
,@body
|
||||
(setq ,tailvar ((guile-primitive cdr) ,tailvar)))
|
||||
,@(if (= (length args) 3)
|
||||
(list (caddr args))
|
||||
'())))))))))
|
||||
(if (prim or
|
||||
(not (list? args))
|
||||
(< (length args) 2)
|
||||
(> (length args) 3))
|
||||
(macro-error "invalid dolist arguments" args)
|
||||
(let ((var (car args))
|
||||
(iter-list (cadr args))
|
||||
(tailvar (gensym)))
|
||||
(if (not (symbol? var))
|
||||
(macro-error "expected symbol as dolist variable")
|
||||
`(let (,var)
|
||||
(without-void-checks (,tailvar)
|
||||
(lexical-let ((,tailvar ,iter-list))
|
||||
(while ((guile-primitive not)
|
||||
((guile-primitive null?) ,tailvar))
|
||||
(setq ,var ((guile-primitive car) ,tailvar))
|
||||
,@body
|
||||
(setq ,tailvar ((guile-primitive cdr) ,tailvar)))
|
||||
,@(if (= (length args) 3)
|
||||
(list (caddr args))
|
||||
'())))))))))
|
||||
|
||||
;;; Exception handling. unwind-protect and catch are implemented as
|
||||
;;; macros (throw is a built-in function).
|
||||
|
|
@ -166,22 +168,23 @@
|
|||
(built-in-macro catch
|
||||
(lambda (tag . body)
|
||||
(if (null? body)
|
||||
(macro-error "catch with empty body"))
|
||||
(macro-error "catch with empty body"))
|
||||
(let ((tagsym (gensym)))
|
||||
`(lexical-let ((,tagsym ,tag))
|
||||
((guile-primitive catch)
|
||||
#t
|
||||
(lambda () ,@body)
|
||||
,(let* ((dummy-key (gensym))
|
||||
(elisp-key (gensym))
|
||||
(value (gensym))
|
||||
(arglist `(,dummy-key ,elisp-key ,value)))
|
||||
`(with-always-lexical ,arglist
|
||||
(lambda ,arglist
|
||||
(if (eq ,elisp-key ,tagsym)
|
||||
#t
|
||||
(lambda () ,@body)
|
||||
,(let* ((dummy-key (gensym))
|
||||
(elisp-key (gensym))
|
||||
(value (gensym))
|
||||
(arglist `(,dummy-key ,elisp-key ,value)))
|
||||
`(with-always-lexical
|
||||
,arglist
|
||||
(lambda ,arglist
|
||||
(if (eq ,elisp-key ,tagsym)
|
||||
,value
|
||||
((guile-primitive throw) ,dummy-key ,elisp-key
|
||||
,value))))))))))
|
||||
,value))))))))))
|
||||
|
||||
;;; unwind-protect is just some weaker construct as dynamic-wind, so
|
||||
;;; straight-forward to implement.
|
||||
|
|
@ -189,11 +192,11 @@
|
|||
(built-in-macro unwind-protect
|
||||
(lambda (body . clean-ups)
|
||||
(if (null? clean-ups)
|
||||
(macro-error "unwind-protect without cleanup code"))
|
||||
(macro-error "unwind-protect without cleanup code"))
|
||||
`((guile-primitive dynamic-wind)
|
||||
(lambda () nil)
|
||||
(lambda () ,body)
|
||||
(lambda () ,@clean-ups))))
|
||||
(lambda () nil)
|
||||
(lambda () ,body)
|
||||
(lambda () ,@clean-ups))))
|
||||
|
||||
;;; Pop off the first element from a list or push one to it.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue