mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-18 02:00:20 +02:00
whitespace changes
* 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: Ensure that all top-level forms and comments are separated by exactly one newline. Remove blank lines in most procedure bodies. Delete trailing whitespace.
This commit is contained in:
Brian Templeton
parent
802b47bdc6
commit
372b11fc73
8 changed files with 75 additions and 119 deletions
|
|
@ -36,21 +36,18 @@
|
||||||
; with-dynamic-binding routines to associate symbols to different bindings
|
; with-dynamic-binding routines to associate symbols to different bindings
|
||||||
; over a dynamic extent.
|
; over a dynamic extent.
|
||||||
|
|
||||||
|
|
||||||
; Record type used to hold the data necessary.
|
; Record type used to hold the data necessary.
|
||||||
|
|
||||||
(define bindings-type
|
(define bindings-type
|
||||||
(make-record-type 'bindings
|
(make-record-type 'bindings
|
||||||
'(needed-globals lexical-bindings)))
|
'(needed-globals lexical-bindings)))
|
||||||
|
|
||||||
|
|
||||||
; Construct an 'empty' instance of the bindings data structure to be used
|
; Construct an 'empty' instance of the bindings data structure to be used
|
||||||
; at the start of a fresh compilation.
|
; at the start of a fresh compilation.
|
||||||
|
|
||||||
(define (make-bindings)
|
(define (make-bindings)
|
||||||
((record-constructor bindings-type) '() (make-hash-table)))
|
((record-constructor bindings-type) '() (make-hash-table)))
|
||||||
|
|
||||||
|
|
||||||
; Mark that a given symbol is needed as global in the specified slot-module.
|
; Mark that a given symbol is needed as global in the specified slot-module.
|
||||||
|
|
||||||
(define (mark-global-needed! bindings sym module)
|
(define (mark-global-needed! bindings sym module)
|
||||||
|
|
@ -62,7 +59,6 @@
|
||||||
(new-needed (assoc-set! old-needed module new-in-module)))
|
(new-needed (assoc-set! old-needed module new-in-module)))
|
||||||
((record-modifier bindings-type 'needed-globals) bindings new-needed)))
|
((record-modifier bindings-type 'needed-globals) bindings new-needed)))
|
||||||
|
|
||||||
|
|
||||||
; Cycle through all globals needed in order to generate the code for their
|
; Cycle through all globals needed in order to generate the code for their
|
||||||
; creation or some other analysis.
|
; creation or some other analysis.
|
||||||
|
|
||||||
|
|
@ -85,7 +81,6 @@
|
||||||
(cons (proc module (car sym-tail))
|
(cons (proc module (car sym-tail))
|
||||||
sym-result))))))))))
|
sym-result))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Get the current lexical binding (gensym it should refer to in the current
|
; Get the current lexical binding (gensym it should refer to in the current
|
||||||
; scope) for a symbol or #f if it is dynamically bound.
|
; scope) for a symbol or #f if it is dynamically bound.
|
||||||
|
|
||||||
|
|
@ -96,7 +91,6 @@
|
||||||
(fluid-ref slot)
|
(fluid-ref slot)
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
|
||||||
; Establish a binding or mark a symbol as dynamically bound for the extent of
|
; Establish a binding or mark a symbol as dynamically bound for the extent of
|
||||||
; calling proc.
|
; calling proc.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,12 +6,12 @@
|
||||||
;; it under the terms of the GNU General Public License as published by
|
;; it under the terms of the GNU General Public License as published by
|
||||||
;; the Free Software Foundation; either version 3, or (at your option)
|
;; the Free Software Foundation; either version 3, or (at your option)
|
||||||
;; any later version.
|
;; any later version.
|
||||||
;;
|
;;
|
||||||
;; This program is distributed in the hope that it will be useful,
|
;; This program is distributed in the hope that it will be useful,
|
||||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;; GNU General Public License for more details.
|
;; GNU General Public License for more details.
|
||||||
;;
|
;;
|
||||||
;; You should have received a copy of the GNU General Public License
|
;; You should have received a copy of the GNU General Public License
|
||||||
;; along with this program; see the file COPYING. If not, write to
|
;; along with this program; see the file COPYING. If not, write to
|
||||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||||
|
|
@ -27,21 +27,22 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:export (compile-tree-il))
|
#:export (compile-tree-il))
|
||||||
|
|
||||||
|
|
||||||
; Certain common parameters (like the bindings data structure or compiler
|
; Certain common parameters (like the bindings data structure or compiler
|
||||||
; options) are not always passed around but accessed using fluids to simulate
|
; options) are not always passed around but accessed using fluids to simulate
|
||||||
; dynamic binding (hey, this is about elisp).
|
; dynamic binding (hey, this is about elisp).
|
||||||
|
|
||||||
; The bindings data structure to keep track of symbol binding related data.
|
; The bindings data structure to keep track of symbol binding related data.
|
||||||
|
|
||||||
(define bindings-data (make-fluid))
|
(define bindings-data (make-fluid))
|
||||||
|
|
||||||
; Store for which symbols (or all/none) void checks are disabled.
|
; Store for which symbols (or all/none) void checks are disabled.
|
||||||
|
|
||||||
(define disable-void-check (make-fluid))
|
(define disable-void-check (make-fluid))
|
||||||
|
|
||||||
; Store which symbols (or all/none) should always be bound lexically, even
|
; Store which symbols (or all/none) should always be bound lexically, even
|
||||||
; with ordinary let and as lambda arguments.
|
; with ordinary let and as lambda arguments.
|
||||||
(define always-lexical (make-fluid))
|
|
||||||
|
|
||||||
|
(define always-lexical (make-fluid))
|
||||||
|
|
||||||
; Find the source properties of some parsed expression if there are any
|
; Find the source properties of some parsed expression if there are any
|
||||||
; associated with it.
|
; associated with it.
|
||||||
|
|
@ -52,20 +53,21 @@
|
||||||
(and (not (null? props))
|
(and (not (null? props))
|
||||||
props))))
|
props))))
|
||||||
|
|
||||||
|
|
||||||
; Values to use for Elisp's nil and t.
|
; Values to use for Elisp's nil and t.
|
||||||
|
|
||||||
(define (nil-value loc) (make-const loc (@ (language elisp runtime) nil-value)))
|
(define (nil-value loc) (make-const loc (@ (language elisp runtime) nil-value)))
|
||||||
(define (t-value loc) (make-const loc (@ (language elisp runtime) t-value)))
|
|
||||||
|
|
||||||
|
(define (t-value loc) (make-const loc (@ (language elisp runtime) t-value)))
|
||||||
|
|
||||||
; Modules that contain the value and function slot bindings.
|
; Modules that contain the value and function slot bindings.
|
||||||
|
|
||||||
(define runtime '(language elisp runtime))
|
(define runtime '(language elisp runtime))
|
||||||
(define macro-slot '(language elisp runtime macro-slot))
|
|
||||||
(define value-slot (@ (language elisp runtime) value-slot-module))
|
|
||||||
(define function-slot (@ (language elisp runtime) function-slot-module))
|
|
||||||
|
|
||||||
|
(define macro-slot '(language elisp runtime macro-slot))
|
||||||
|
|
||||||
|
(define value-slot (@ (language elisp runtime) value-slot-module))
|
||||||
|
|
||||||
|
(define function-slot (@ (language elisp runtime) function-slot-module))
|
||||||
|
|
||||||
; The backquoting works the same as quasiquotes in Scheme, but the forms are
|
; The backquoting works the same as quasiquotes in Scheme, but the forms are
|
||||||
; named differently; to make easy adaptions, we define these predicates checking
|
; named differently; to make easy adaptions, we define these predicates checking
|
||||||
|
|
@ -80,13 +82,11 @@
|
||||||
(define (unquote-splicing? sym)
|
(define (unquote-splicing? sym)
|
||||||
(and (symbol? sym) (eq? sym '\,@)))
|
(and (symbol? sym) (eq? sym '\,@)))
|
||||||
|
|
||||||
|
|
||||||
; Build a call to a primitive procedure nicely.
|
; Build a call to a primitive procedure nicely.
|
||||||
|
|
||||||
(define (call-primitive loc sym . args)
|
(define (call-primitive loc sym . args)
|
||||||
(make-application loc (make-primitive-ref loc sym) args))
|
(make-application loc (make-primitive-ref loc sym) args))
|
||||||
|
|
||||||
|
|
||||||
; Error reporting routine for syntax/compilation problems or build code for
|
; Error reporting routine for syntax/compilation problems or build code for
|
||||||
; a runtime-error output.
|
; a runtime-error output.
|
||||||
|
|
||||||
|
|
@ -97,7 +97,6 @@
|
||||||
(make-application loc (make-primitive-ref loc 'error)
|
(make-application loc (make-primitive-ref loc 'error)
|
||||||
(cons (make-const loc msg) args)))
|
(cons (make-const loc msg) args)))
|
||||||
|
|
||||||
|
|
||||||
; Generate code to ensure a global symbol is there for further use of a given
|
; Generate code to ensure a global symbol is there for further use of a given
|
||||||
; symbol. In general during the compilation, those needed are only tracked with
|
; symbol. In general during the compilation, those needed are only tracked with
|
||||||
; the bindings data structure. Afterwards, however, for all those needed
|
; the bindings data structure. Afterwards, however, for all those needed
|
||||||
|
|
@ -108,7 +107,6 @@
|
||||||
(list (make-const loc module)
|
(list (make-const loc module)
|
||||||
(make-const loc sym))))
|
(make-const loc sym))))
|
||||||
|
|
||||||
|
|
||||||
; See if we should do a void-check for a given variable. That means, check
|
; See if we should do a void-check for a given variable. That means, check
|
||||||
; that this check is not disabled via the compiler options for this symbol.
|
; that this check is not disabled via the compiler options for this symbol.
|
||||||
; Disabling of void check is only done for the value-slot module!
|
; Disabling of void check is only done for the value-slot module!
|
||||||
|
|
@ -119,7 +117,6 @@
|
||||||
(and (not (eq? disabled 'all))
|
(and (not (eq? disabled 'all))
|
||||||
(not (memq sym disabled))))))
|
(not (memq sym disabled))))))
|
||||||
|
|
||||||
|
|
||||||
; Build a construct that establishes dynamic bindings for certain variables.
|
; Build a construct that establishes dynamic bindings for certain variables.
|
||||||
; We may want to choose between binding with fluids and with-fluids* and
|
; We may want to choose between binding with fluids and with-fluids* and
|
||||||
; using just ordinary module symbols and setting/reverting their values with
|
; using just ordinary module symbols and setting/reverting their values with
|
||||||
|
|
@ -135,7 +132,6 @@
|
||||||
(make-lambda loc '()
|
(make-lambda loc '()
|
||||||
(make-lambda-case #f '() #f #f #f '() '() body #f))))
|
(make-lambda-case #f '() #f #f #f '() '() body #f))))
|
||||||
|
|
||||||
|
|
||||||
; Handle access to a variable (reference/setting) correctly depending on
|
; Handle access to a variable (reference/setting) correctly depending on
|
||||||
; whether it is currently lexically or dynamically bound.
|
; whether it is currently lexically or dynamically bound.
|
||||||
; lexical access is done only for references to the value-slot module!
|
; lexical access is done only for references to the value-slot module!
|
||||||
|
|
@ -146,7 +142,6 @@
|
||||||
(handle-lexical lexical)
|
(handle-lexical lexical)
|
||||||
(handle-dynamic))))
|
(handle-dynamic))))
|
||||||
|
|
||||||
|
|
||||||
; Generate code to reference a variable.
|
; Generate code to reference a variable.
|
||||||
; For references in the value-slot module, we may want to generate a lexical
|
; For references in the value-slot module, we may want to generate a lexical
|
||||||
; reference instead if the variable has a lexical binding.
|
; reference instead if the variable has a lexical binding.
|
||||||
|
|
@ -160,7 +155,6 @@
|
||||||
(call-primitive loc 'fluid-ref
|
(call-primitive loc 'fluid-ref
|
||||||
(make-module-ref loc module sym #t)))))
|
(make-module-ref loc module sym #t)))))
|
||||||
|
|
||||||
|
|
||||||
; Reference a variable and error if the value is void.
|
; Reference a variable and error if the value is void.
|
||||||
|
|
||||||
(define (reference-with-check loc sym module)
|
(define (reference-with-check loc sym module)
|
||||||
|
|
@ -175,7 +169,6 @@
|
||||||
(make-lexical-ref loc 'value var))))
|
(make-lexical-ref loc 'value var))))
|
||||||
(reference-variable loc sym module)))
|
(reference-variable loc sym module)))
|
||||||
|
|
||||||
|
|
||||||
; Generate code to set a variable.
|
; Generate code to set a variable.
|
||||||
; Just as with reference-variable, in case of a reference to value-slot,
|
; Just as with reference-variable, in case of a reference to value-slot,
|
||||||
; we want to generate a lexical set when the variable has a lexical binding.
|
; we want to generate a lexical set when the variable has a lexical binding.
|
||||||
|
|
@ -190,7 +183,6 @@
|
||||||
(make-module-ref loc module sym #t)
|
(make-module-ref loc module sym #t)
|
||||||
value))))
|
value))))
|
||||||
|
|
||||||
|
|
||||||
; Process the bindings part of a let or let* expression; that is, check for
|
; Process the bindings part of a let or let* expression; that is, check for
|
||||||
; correctness and bring it to the form ((sym1 . val1) (sym2 . val2) ...).
|
; correctness and bring it to the form ((sym1 . val1) (sym2 . val2) ...).
|
||||||
|
|
||||||
|
|
@ -206,7 +198,6 @@
|
||||||
(cons (car b) (cadr b))))))
|
(cons (car b) (cadr b))))))
|
||||||
bindings))
|
bindings))
|
||||||
|
|
||||||
|
|
||||||
; Split the let bindings into a list to be done lexically and one dynamically.
|
; Split the let bindings into a list to be done lexically and one dynamically.
|
||||||
; A symbol will be bound lexically if and only if:
|
; A symbol will be bound lexically if and only if:
|
||||||
; We're processing a lexical-let (i.e. module is 'lexical), OR
|
; We're processing a lexical-let (i.e. module is 'lexical), OR
|
||||||
|
|
@ -231,7 +222,6 @@
|
||||||
(iterate (cdr tail) (cons (car tail) lexical) dynamic)
|
(iterate (cdr tail) (cons (car tail) lexical) dynamic)
|
||||||
(iterate (cdr tail) lexical (cons (car tail) dynamic))))))
|
(iterate (cdr tail) lexical (cons (car tail) dynamic))))))
|
||||||
|
|
||||||
|
|
||||||
; Compile let and let* expressions. The code here is used both for let/let*
|
; Compile let and let* expressions. The code here is used both for let/let*
|
||||||
; and flet/flet*, just with a different bindings module.
|
; and flet/flet*, just with a different bindings module.
|
||||||
;
|
;
|
||||||
|
|
@ -244,6 +234,7 @@
|
||||||
; among the bindings, we first do a let for all of them to evaluate all
|
; among the bindings, we first do a let for all of them to evaluate all
|
||||||
; values before any bindings take place, and then call let-dynamic for the
|
; values before any bindings take place, and then call let-dynamic for the
|
||||||
; variables to bind dynamically.
|
; variables to bind dynamically.
|
||||||
|
|
||||||
(define (generate-let loc module bindings body)
|
(define (generate-let loc module bindings body)
|
||||||
(let ((bind (process-let-bindings loc bindings)))
|
(let ((bind (process-let-bindings loc bindings)))
|
||||||
(call-with-values
|
(call-with-values
|
||||||
|
|
@ -278,9 +269,9 @@
|
||||||
dynamic-syms)
|
dynamic-syms)
|
||||||
(make-body)))))))))))))
|
(make-body)))))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Let* is compiled to a cascaded set of "small lets" for each binding in turn
|
; Let* is compiled to a cascaded set of "small lets" for each binding in turn
|
||||||
; so that each one already sees the preceding bindings.
|
; so that each one already sees the preceding bindings.
|
||||||
|
|
||||||
(define (generate-let* loc module bindings body)
|
(define (generate-let* loc module bindings body)
|
||||||
(let ((bind (process-let-bindings loc bindings)))
|
(let ((bind (process-let-bindings loc bindings)))
|
||||||
(begin
|
(begin
|
||||||
|
|
@ -304,7 +295,6 @@
|
||||||
`(,(caar tail)) module `(,value)
|
`(,(caar tail)) module `(,value)
|
||||||
(iterate (cdr tail))))))))))
|
(iterate (cdr tail))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Split the argument list of a lambda expression into required, optional and
|
; Split the argument list of a lambda expression into required, optional and
|
||||||
; rest arguments and also check it is actually valid.
|
; rest arguments and also check it is actually valid.
|
||||||
; Additionally, we create a list of all "local variables" (that is, required,
|
; Additionally, we create a list of all "local variables" (that is, required,
|
||||||
|
|
@ -325,7 +315,6 @@
|
||||||
(lexical '())
|
(lexical '())
|
||||||
(dynamic '()))
|
(dynamic '()))
|
||||||
(cond
|
(cond
|
||||||
|
|
||||||
((null? tail)
|
((null? tail)
|
||||||
(let ((final-required (reverse required))
|
(let ((final-required (reverse required))
|
||||||
(final-optional (reverse optional))
|
(final-optional (reverse optional))
|
||||||
|
|
@ -333,11 +322,9 @@
|
||||||
(final-dynamic (reverse dynamic)))
|
(final-dynamic (reverse dynamic)))
|
||||||
(values final-required final-optional #f
|
(values final-required final-optional #f
|
||||||
final-lexical final-dynamic)))
|
final-lexical final-dynamic)))
|
||||||
|
|
||||||
((and (eq? mode 'required)
|
((and (eq? mode 'required)
|
||||||
(eq? (car tail) '&optional))
|
(eq? (car tail) '&optional))
|
||||||
(iterate (cdr tail) 'optional required optional lexical dynamic))
|
(iterate (cdr tail) 'optional required optional lexical dynamic))
|
||||||
|
|
||||||
((eq? (car tail) '&rest)
|
((eq? (car tail) '&rest)
|
||||||
(if (or (null? (cdr tail))
|
(if (or (null? (cdr tail))
|
||||||
(not (null? (cddr tail))))
|
(not (null? (cddr tail))))
|
||||||
|
|
@ -354,7 +341,6 @@
|
||||||
(cons rest dynamic)))))
|
(cons rest dynamic)))))
|
||||||
(values final-required final-optional rest
|
(values final-required final-optional rest
|
||||||
final-lexical final-dynamic))))
|
final-lexical final-dynamic))))
|
||||||
|
|
||||||
(else
|
(else
|
||||||
(if (not (symbol? (car tail)))
|
(if (not (symbol? (car tail)))
|
||||||
(report-error loc "expected symbol in argument list, got" (car tail))
|
(report-error loc "expected symbol in argument list, got" (car tail))
|
||||||
|
|
@ -376,7 +362,6 @@
|
||||||
(else
|
(else
|
||||||
(error "invalid mode in split-lambda-arguments" mode)))))))))
|
(error "invalid mode in split-lambda-arguments" mode)))))))))
|
||||||
|
|
||||||
|
|
||||||
; Compile a lambda expression. Things get a little complicated because TreeIL
|
; Compile a lambda expression. Things get a little complicated because TreeIL
|
||||||
; does not allow optional arguments but only one rest argument, and also the
|
; does not allow optional arguments but only one rest argument, and also the
|
||||||
; rest argument should be nil instead of '() for no values given. Because of
|
; rest argument should be nil instead of '() for no values given. Because of
|
||||||
|
|
@ -486,6 +471,7 @@
|
||||||
|
|
||||||
; Build the code to handle setting of optional arguments that are present
|
; Build the code to handle setting of optional arguments that are present
|
||||||
; and updating the rest list.
|
; and updating the rest list.
|
||||||
|
|
||||||
(define (process-optionals loc optional rest-name rest-sym)
|
(define (process-optionals loc optional rest-name rest-sym)
|
||||||
(let iterate ((tail optional))
|
(let iterate ((tail optional))
|
||||||
(if (null? tail)
|
(if (null? tail)
|
||||||
|
|
@ -503,6 +489,7 @@
|
||||||
(iterate (cdr tail))))))))
|
(iterate (cdr tail))))))))
|
||||||
|
|
||||||
; This builds the code to set the rest variable to nil if it is empty.
|
; This builds the code to set the rest variable to nil if it is empty.
|
||||||
|
|
||||||
(define (process-rest loc rest rest-name rest-sym)
|
(define (process-rest loc rest rest-name rest-sym)
|
||||||
(let ((rest-empty (call-primitive loc 'null?
|
(let ((rest-empty (call-primitive loc 'null?
|
||||||
(make-lexical-ref loc rest-name rest-sym))))
|
(make-lexical-ref loc rest-name rest-sym))))
|
||||||
|
|
@ -518,7 +505,6 @@
|
||||||
(runtime-error loc "too many arguments and no rest argument")))
|
(runtime-error loc "too many arguments and no rest argument")))
|
||||||
(else (make-void loc)))))
|
(else (make-void loc)))))
|
||||||
|
|
||||||
|
|
||||||
; Handle the common part of defconst and defvar, that is, checking for a correct
|
; Handle the common part of defconst and defvar, that is, checking for a correct
|
||||||
; doc string and arguments as well as maybe in the future handling the docstring
|
; doc string and arguments as well as maybe in the future handling the docstring
|
||||||
; somehow.
|
; somehow.
|
||||||
|
|
@ -533,7 +519,6 @@
|
||||||
; TODO: Handle doc string if present.
|
; TODO: Handle doc string if present.
|
||||||
(else #t)))
|
(else #t)))
|
||||||
|
|
||||||
|
|
||||||
; Handle macro bindings.
|
; Handle macro bindings.
|
||||||
|
|
||||||
(define (is-macro? sym)
|
(define (is-macro? sym)
|
||||||
|
|
@ -550,7 +535,6 @@
|
||||||
(define (get-macro sym)
|
(define (get-macro sym)
|
||||||
(module-ref (resolve-module macro-slot) sym))
|
(module-ref (resolve-module macro-slot) sym))
|
||||||
|
|
||||||
|
|
||||||
; See if a (backquoted) expression contains any unquotes.
|
; See if a (backquoted) expression contains any unquotes.
|
||||||
|
|
||||||
(define (contains-unquotes? expr)
|
(define (contains-unquotes? expr)
|
||||||
|
|
@ -561,15 +545,15 @@
|
||||||
(contains-unquotes? (cdr expr))))
|
(contains-unquotes? (cdr expr))))
|
||||||
#f))
|
#f))
|
||||||
|
|
||||||
|
|
||||||
; Process a backquoted expression by building up the needed cons/append calls.
|
; Process a backquoted expression by building up the needed cons/append calls.
|
||||||
; For splicing, it is assumed that the expression spliced in evaluates to a
|
; For splicing, it is assumed that the expression spliced in evaluates to a
|
||||||
; list. The emacs manual does not really state either it has to or what to do
|
; list. The emacs manual does not really state either it has to or what to do
|
||||||
; if it does not, but Scheme explicitly forbids it and this seems reasonable
|
; if it does not, but Scheme explicitly forbids it and this seems reasonable
|
||||||
; also for elisp.
|
; also for elisp.
|
||||||
|
|
||||||
(define (unquote-cell? expr)
|
(define (unquote-cell? expr)
|
||||||
(and (list? expr) (= (length expr) 2) (unquote? (car expr))))
|
(and (list? expr) (= (length expr) 2) (unquote? (car expr))))
|
||||||
|
|
||||||
(define (unquote-splicing-cell? expr)
|
(define (unquote-splicing-cell? expr)
|
||||||
(and (list? expr) (= (length expr) 2) (unquote-splicing? (car expr))))
|
(and (list? expr) (= (length expr) 2) (unquote-splicing? (car expr))))
|
||||||
|
|
||||||
|
|
@ -595,7 +579,6 @@
|
||||||
(report-error loc "non-pair expression contains unquotes" expr))
|
(report-error loc "non-pair expression contains unquotes" expr))
|
||||||
(make-const loc expr)))
|
(make-const loc expr)))
|
||||||
|
|
||||||
|
|
||||||
; Temporarily update a list of symbols that are handled specially (disabled
|
; Temporarily update a list of symbols that are handled specially (disabled
|
||||||
; void check or always lexical) for compiling body.
|
; void check or always lexical) for compiling body.
|
||||||
; We need to handle special cases for already all / set to all and the like.
|
; We need to handle special cases for already all / set to all and the like.
|
||||||
|
|
@ -617,7 +600,6 @@
|
||||||
(with-fluids ((fluid new))
|
(with-fluids ((fluid new))
|
||||||
(make-body))))))
|
(make-body))))))
|
||||||
|
|
||||||
|
|
||||||
; Compile a symbol expression. This is a variable reference or maybe some
|
; Compile a symbol expression. This is a variable reference or maybe some
|
||||||
; special value like nil.
|
; special value like nil.
|
||||||
|
|
||||||
|
|
@ -627,12 +609,10 @@
|
||||||
((t) (t-value loc))
|
((t) (t-value loc))
|
||||||
(else (reference-with-check loc sym value-slot))))
|
(else (reference-with-check loc sym value-slot))))
|
||||||
|
|
||||||
|
|
||||||
; Compile a pair-expression (that is, any structure-like construct).
|
; Compile a pair-expression (that is, any structure-like construct).
|
||||||
|
|
||||||
(define (compile-pair loc expr)
|
(define (compile-pair loc expr)
|
||||||
(pmatch expr
|
(pmatch expr
|
||||||
|
|
||||||
((progn . ,forms)
|
((progn . ,forms)
|
||||||
(make-sequence loc (map compile-expr forms)))
|
(make-sequence loc (map compile-expr forms)))
|
||||||
|
|
||||||
|
|
@ -640,10 +620,12 @@
|
||||||
(make-conditional loc (compile-expr condition)
|
(make-conditional loc (compile-expr condition)
|
||||||
(compile-expr ifclause)
|
(compile-expr ifclause)
|
||||||
(nil-value loc)))
|
(nil-value loc)))
|
||||||
|
|
||||||
((if ,condition ,ifclause ,elseclause)
|
((if ,condition ,ifclause ,elseclause)
|
||||||
(make-conditional loc (compile-expr condition)
|
(make-conditional loc (compile-expr condition)
|
||||||
(compile-expr ifclause)
|
(compile-expr ifclause)
|
||||||
(compile-expr elseclause)))
|
(compile-expr elseclause)))
|
||||||
|
|
||||||
((if ,condition ,ifclause . ,elses)
|
((if ,condition ,ifclause . ,elses)
|
||||||
(make-conditional loc (compile-expr condition)
|
(make-conditional loc (compile-expr condition)
|
||||||
(compile-expr ifclause)
|
(compile-expr ifclause)
|
||||||
|
|
@ -659,6 +641,7 @@
|
||||||
(make-const loc sym)))))
|
(make-const loc sym)))))
|
||||||
|
|
||||||
((defvar ,sym) (make-const loc sym))
|
((defvar ,sym) (make-const loc sym))
|
||||||
|
|
||||||
((defvar ,sym ,value . ,doc)
|
((defvar ,sym ,value . ,doc)
|
||||||
(if (handle-var-def loc sym doc)
|
(if (handle-var-def loc sym doc)
|
||||||
(make-sequence loc
|
(make-sequence loc
|
||||||
|
|
@ -674,6 +657,7 @@
|
||||||
; Build a set form for possibly multiple values. The code is not formulated
|
; Build a set form for possibly multiple values. The code is not formulated
|
||||||
; tail recursive because it is clearer this way and large lists of symbol
|
; tail recursive because it is clearer this way and large lists of symbol
|
||||||
; expression pairs are very unlikely.
|
; expression pairs are very unlikely.
|
||||||
|
|
||||||
((setq . ,args) (guard (not (null? args)))
|
((setq . ,args) (guard (not (null? args)))
|
||||||
(make-sequence loc
|
(make-sequence loc
|
||||||
(let iterate ((tail args))
|
(let iterate ((tail args))
|
||||||
|
|
@ -702,10 +686,12 @@
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
(generate-let loc value-slot bindings body))
|
(generate-let loc value-slot bindings body))
|
||||||
|
|
||||||
((lexical-let ,bindings . ,body) (guard (and (list? bindings)
|
((lexical-let ,bindings . ,body) (guard (and (list? bindings)
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
(generate-let loc 'lexical bindings body))
|
(generate-let loc 'lexical bindings body))
|
||||||
|
|
||||||
((flet ,bindings . ,body) (guard (and (list? bindings)
|
((flet ,bindings . ,body) (guard (and (list? bindings)
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
|
|
@ -715,10 +701,12 @@
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
(generate-let* loc value-slot bindings body))
|
(generate-let* loc value-slot bindings body))
|
||||||
|
|
||||||
((lexical-let* ,bindings . ,body) (guard (and (list? bindings)
|
((lexical-let* ,bindings . ,body) (guard (and (list? bindings)
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
(generate-let* loc 'lexical bindings body))
|
(generate-let* loc 'lexical bindings body))
|
||||||
|
|
||||||
((flet* ,bindings . ,body) (guard (and (list? bindings)
|
((flet* ,bindings . ,body) (guard (and (list? bindings)
|
||||||
(not (null? bindings))
|
(not (null? bindings))
|
||||||
(not (null? body))))
|
(not (null? body))))
|
||||||
|
|
@ -737,11 +725,13 @@
|
||||||
; elisp as a way to access data within
|
; elisp as a way to access data within
|
||||||
; the Guile universe. The module and symbol referenced are static values,
|
; the Guile universe. The module and symbol referenced are static values,
|
||||||
; just like (@ module symbol) does!
|
; just like (@ module symbol) does!
|
||||||
|
|
||||||
((guile-ref ,module ,sym) (guard (and (list? module) (symbol? sym)))
|
((guile-ref ,module ,sym) (guard (and (list? module) (symbol? sym)))
|
||||||
(make-module-ref loc module sym #t))
|
(make-module-ref loc module sym #t))
|
||||||
|
|
||||||
; guile-primitive allows to create primitive references, which are still
|
; guile-primitive allows to create primitive references, which are still
|
||||||
; a little faster.
|
; a little faster.
|
||||||
|
|
||||||
((guile-primitive ,sym) (guard (symbol? sym))
|
((guile-primitive ,sym) (guard (symbol? sym))
|
||||||
(make-primitive-ref loc sym))
|
(make-primitive-ref loc sym))
|
||||||
|
|
||||||
|
|
@ -755,6 +745,7 @@
|
||||||
;
|
;
|
||||||
; As letrec is not directly accessible from elisp, while is implemented here
|
; As letrec is not directly accessible from elisp, while is implemented here
|
||||||
; instead of with a macro.
|
; instead of with a macro.
|
||||||
|
|
||||||
((while ,condition . ,body)
|
((while ,condition . ,body)
|
||||||
(let* ((itersym (gensym))
|
(let* ((itersym (gensym))
|
||||||
(compiled-body (map compile-expr body))
|
(compiled-body (map compile-expr body))
|
||||||
|
|
@ -775,14 +766,17 @@
|
||||||
|
|
||||||
; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression
|
; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression
|
||||||
; that should be compiled.
|
; that should be compiled.
|
||||||
|
|
||||||
((lambda ,args . ,body)
|
((lambda ,args . ,body)
|
||||||
(compile-lambda loc args body))
|
(compile-lambda loc args body))
|
||||||
|
|
||||||
((function (lambda ,args . ,body))
|
((function (lambda ,args . ,body))
|
||||||
(compile-lambda loc args body))
|
(compile-lambda loc args body))
|
||||||
|
|
||||||
; Build a lambda and also assign it to the function cell of some symbol.
|
; Build a lambda and also assign it to the function cell of some symbol.
|
||||||
; This is no macro as we might want to honour the docstring at some time;
|
; This is no macro as we might want to honour the docstring at some time;
|
||||||
; just as with defvar/defconst.
|
; just as with defvar/defconst.
|
||||||
|
|
||||||
((defun ,name ,args . ,body)
|
((defun ,name ,args . ,body)
|
||||||
(if (not (symbol? name))
|
(if (not (symbol? name))
|
||||||
(report-error loc "expected symbol as function name" name)
|
(report-error loc "expected symbol as function name" name)
|
||||||
|
|
@ -793,6 +787,7 @@
|
||||||
|
|
||||||
; Define a macro (this is done directly at compile-time!).
|
; Define a macro (this is done directly at compile-time!).
|
||||||
; FIXME: Recursive macros don't work!
|
; FIXME: Recursive macros don't work!
|
||||||
|
|
||||||
((defmacro ,name ,args . ,body)
|
((defmacro ,name ,args . ,body)
|
||||||
(if (not (symbol? name))
|
(if (not (symbol? name))
|
||||||
(report-error loc "expected symbol as macro name" name)
|
(report-error loc "expected symbol as macro name" name)
|
||||||
|
|
@ -803,14 +798,17 @@
|
||||||
(make-const loc name))))
|
(make-const loc name))))
|
||||||
|
|
||||||
; XXX: Maybe we could implement backquotes in macros, too.
|
; XXX: Maybe we could implement backquotes in macros, too.
|
||||||
|
|
||||||
((,backq ,val) (guard (backquote? backq))
|
((,backq ,val) (guard (backquote? backq))
|
||||||
(process-backquote loc val))
|
(process-backquote loc val))
|
||||||
|
|
||||||
; XXX: Why do we need 'quote here instead of quote?
|
; XXX: Why do we need 'quote here instead of quote?
|
||||||
|
|
||||||
(('quote ,val)
|
(('quote ,val)
|
||||||
(make-const loc val))
|
(make-const loc val))
|
||||||
|
|
||||||
; Macro calls are simply expanded and recursively compiled.
|
; Macro calls are simply expanded and recursively compiled.
|
||||||
|
|
||||||
((,macro . ,args) (guard (and (symbol? macro) (is-macro? macro)))
|
((,macro . ,args) (guard (and (symbol? macro) (is-macro? macro)))
|
||||||
(let ((expander (get-macro macro)))
|
(let ((expander (get-macro macro)))
|
||||||
(compile-expr (apply expander args))))
|
(compile-expr (apply expander args))))
|
||||||
|
|
@ -819,6 +817,7 @@
|
||||||
; take the function value of a symbol if it is one. It seems that functions
|
; take the function value of a symbol if it is one. It seems that functions
|
||||||
; in form of uncompiled lists are not supported in this syntax, so we don't
|
; in form of uncompiled lists are not supported in this syntax, so we don't
|
||||||
; have to care for them.
|
; have to care for them.
|
||||||
|
|
||||||
((,func . ,args)
|
((,func . ,args)
|
||||||
(make-application loc
|
(make-application loc
|
||||||
(if (symbol? func)
|
(if (symbol? func)
|
||||||
|
|
@ -829,7 +828,6 @@
|
||||||
(else
|
(else
|
||||||
(report-error loc "unrecognized elisp" expr))))
|
(report-error loc "unrecognized elisp" expr))))
|
||||||
|
|
||||||
|
|
||||||
; Compile a single expression to TreeIL.
|
; Compile a single expression to TreeIL.
|
||||||
|
|
||||||
(define (compile-expr expr)
|
(define (compile-expr expr)
|
||||||
|
|
@ -841,7 +839,6 @@
|
||||||
(compile-pair loc expr))
|
(compile-pair loc expr))
|
||||||
(else (make-const loc expr)))))
|
(else (make-const loc expr)))))
|
||||||
|
|
||||||
|
|
||||||
; Process the compiler options.
|
; Process the compiler options.
|
||||||
; FIXME: Why is '(()) passed as options by the REPL?
|
; FIXME: Why is '(()) passed as options by the REPL?
|
||||||
|
|
||||||
|
|
@ -867,7 +864,6 @@
|
||||||
(report-error #f "Invalid value for #:always-lexical" value)))
|
(report-error #f "Invalid value for #:always-lexical" value)))
|
||||||
(else (report-error #f "Invalid compiler option" key)))))))
|
(else (report-error #f "Invalid compiler option" key)))))))
|
||||||
|
|
||||||
|
|
||||||
; Entry point for compilation to TreeIL.
|
; Entry point for compilation to TreeIL.
|
||||||
; This creates the bindings data structure, and after compiling the main
|
; This creates the bindings data structure, and after compiling the main
|
||||||
; expression we need to make sure all globals for symbols used during the
|
; expression we need to make sure all globals for symbols used during the
|
||||||
|
|
|
||||||
|
|
@ -34,20 +34,17 @@
|
||||||
|
|
||||||
; TODO: #@count comments
|
; TODO: #@count comments
|
||||||
|
|
||||||
|
|
||||||
; Report an error from the lexer (that is, invalid input given).
|
; Report an error from the lexer (that is, invalid input given).
|
||||||
|
|
||||||
(define (lexer-error port msg . args)
|
(define (lexer-error port msg . args)
|
||||||
(apply error msg args))
|
(apply error msg args))
|
||||||
|
|
||||||
|
|
||||||
; In a character, set a given bit. This is just some bit-wise or'ing on the
|
; In a character, set a given bit. This is just some bit-wise or'ing on the
|
||||||
; characters integer code and converting back to character.
|
; characters integer code and converting back to character.
|
||||||
|
|
||||||
(define (set-char-bit chr bit)
|
(define (set-char-bit chr bit)
|
||||||
(logior chr (ash 1 bit)))
|
(logior chr (ash 1 bit)))
|
||||||
|
|
||||||
|
|
||||||
; Check if a character equals some other. This is just like char=? except that
|
; Check if a character equals some other. This is just like char=? except that
|
||||||
; the tested one could be EOF in which case it simply isn't equal.
|
; the tested one could be EOF in which case it simply isn't equal.
|
||||||
|
|
||||||
|
|
@ -55,7 +52,6 @@
|
||||||
(and (not (eof-object? tested))
|
(and (not (eof-object? tested))
|
||||||
(char=? tested should-be)))
|
(char=? tested should-be)))
|
||||||
|
|
||||||
|
|
||||||
; For a character (as integer code), find the real character it represents or
|
; For a character (as integer code), find the real character it represents or
|
||||||
; #\nul if out of range. This is used to work with Scheme character functions
|
; #\nul if out of range. This is used to work with Scheme character functions
|
||||||
; like char-numeric?.
|
; like char-numeric?.
|
||||||
|
|
@ -65,7 +61,6 @@
|
||||||
(integer->char chr)
|
(integer->char chr)
|
||||||
#\nul))
|
#\nul))
|
||||||
|
|
||||||
|
|
||||||
; Return the control modified version of a character. This is not just setting
|
; Return the control modified version of a character. This is not just setting
|
||||||
; a modifier bit, because ASCII conrol characters must be handled as such, and
|
; a modifier bit, because ASCII conrol characters must be handled as such, and
|
||||||
; in elisp C-? is the delete character for historical reasons.
|
; in elisp C-? is the delete character for historical reasons.
|
||||||
|
|
@ -80,7 +75,6 @@
|
||||||
((#\@) 0)
|
((#\@) 0)
|
||||||
(else (set-char-bit chr 26))))))
|
(else (set-char-bit chr 26))))))
|
||||||
|
|
||||||
|
|
||||||
; Parse a charcode given in some base, basically octal or hexadecimal are
|
; Parse a charcode given in some base, basically octal or hexadecimal are
|
||||||
; needed. A requested number of digits can be given (#f means it does
|
; needed. A requested number of digits can be given (#f means it does
|
||||||
; not matter and arbitrary many are allowed), and additionally early
|
; not matter and arbitrary many are allowed), and additionally early
|
||||||
|
|
@ -113,7 +107,6 @@
|
||||||
(lexer-error port "invalid digit in escape-code" base cur))
|
(lexer-error port "invalid digit in escape-code" base cur))
|
||||||
(iterate (+ (* result base) value) (1+ procdigs)))))))
|
(iterate (+ (* result base) value) (1+ procdigs)))))))
|
||||||
|
|
||||||
|
|
||||||
; Read a character and process escape-sequences when necessary. The special
|
; Read a character and process escape-sequences when necessary. The special
|
||||||
; in-string argument defines if this character is part of a string literal or
|
; in-string argument defines if this character is part of a string literal or
|
||||||
; a single character literal, the difference being that in strings the
|
; a single character literal, the difference being that in strings the
|
||||||
|
|
@ -129,13 +122,11 @@
|
||||||
(#\S . 25) (#\M . ,(if in-string 7 27))))
|
(#\S . 25) (#\M . ,(if in-string 7 27))))
|
||||||
(cur (read-char port)))
|
(cur (read-char port)))
|
||||||
(if (char=? cur #\\)
|
(if (char=? cur #\\)
|
||||||
|
|
||||||
; Handle an escape-sequence.
|
; Handle an escape-sequence.
|
||||||
(let* ((escaped (read-char port))
|
(let* ((escaped (read-char port))
|
||||||
(esc-code (assq-ref basic-escape-codes escaped))
|
(esc-code (assq-ref basic-escape-codes escaped))
|
||||||
(meta (assq-ref meta-bits escaped)))
|
(meta (assq-ref meta-bits escaped)))
|
||||||
(cond
|
(cond
|
||||||
|
|
||||||
; Meta-check must be before esc-code check because \s- must be
|
; Meta-check must be before esc-code check because \s- must be
|
||||||
; recognized as the super-meta modifier if a - follows.
|
; recognized as the super-meta modifier if a - follows.
|
||||||
; If not, it will be caught as \s -> space escape code.
|
; If not, it will be caught as \s -> space escape code.
|
||||||
|
|
@ -143,16 +134,13 @@
|
||||||
(if (not (char=? (read-char port) #\-))
|
(if (not (char=? (read-char port) #\-))
|
||||||
(error "expected - after control sequence"))
|
(error "expected - after control sequence"))
|
||||||
(set-char-bit (get-character port in-string) meta))
|
(set-char-bit (get-character port in-string) meta))
|
||||||
|
|
||||||
; One of the basic control character escape names?
|
; One of the basic control character escape names?
|
||||||
(esc-code esc-code)
|
(esc-code esc-code)
|
||||||
|
|
||||||
; Handle \ddd octal code if it is one.
|
; Handle \ddd octal code if it is one.
|
||||||
((and (char>=? escaped #\0) (char<? escaped #\8))
|
((and (char>=? escaped #\0) (char<? escaped #\8))
|
||||||
(begin
|
(begin
|
||||||
(unread-char escaped port)
|
(unread-char escaped port)
|
||||||
(charcode-escape port 8 3 #t)))
|
(charcode-escape port 8 3 #t)))
|
||||||
|
|
||||||
; Check for some escape-codes directly or otherwise
|
; Check for some escape-codes directly or otherwise
|
||||||
; use the escaped character literally.
|
; use the escaped character literally.
|
||||||
(else
|
(else
|
||||||
|
|
@ -169,12 +157,10 @@
|
||||||
((#\u) (charcode-escape port 16 4 #f))
|
((#\u) (charcode-escape port 16 4 #f))
|
||||||
((#\U) (charcode-escape port 16 8 #f))
|
((#\U) (charcode-escape port 16 8 #f))
|
||||||
(else (char->integer escaped))))))
|
(else (char->integer escaped))))))
|
||||||
|
|
||||||
; No escape-sequence, just the literal character.
|
; No escape-sequence, just the literal character.
|
||||||
; But remember to get the code instead!
|
; But remember to get the code instead!
|
||||||
(char->integer cur))))
|
(char->integer cur))))
|
||||||
|
|
||||||
|
|
||||||
; Read a symbol or number from a port until something follows that marks the
|
; Read a symbol or number from a port until something follows that marks the
|
||||||
; start of a new token (like whitespace or parentheses). The data read is
|
; start of a new token (like whitespace or parentheses). The data read is
|
||||||
; returned as a string for further conversion to the correct type, but we also
|
; returned as a string for further conversion to the correct type, but we also
|
||||||
|
|
@ -184,11 +170,13 @@
|
||||||
; if it is possibly an integer or a float.
|
; if it is possibly an integer or a float.
|
||||||
|
|
||||||
(define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
|
(define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
|
||||||
|
|
||||||
(define float-regex
|
(define float-regex
|
||||||
(make-regexp "^[+-]?([0-9]+\\.?[0-9]*|[0-9]*\\.?[0-9]+)(e[+-]?[0-9]+)?$"))
|
(make-regexp "^[+-]?([0-9]+\\.?[0-9]*|[0-9]*\\.?[0-9]+)(e[+-]?[0-9]+)?$"))
|
||||||
|
|
||||||
; A dot is also allowed literally, only a single dort alone is parsed as the
|
; A dot is also allowed literally, only a single dort alone is parsed as the
|
||||||
; 'dot' terminal for dotted lists.
|
; 'dot' terminal for dotted lists.
|
||||||
|
|
||||||
(define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
|
(define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
|
||||||
|
|
||||||
(define (get-symbol-or-number port)
|
(define (get-symbol-or-number port)
|
||||||
|
|
@ -220,7 +208,6 @@
|
||||||
(unread-char c port)
|
(unread-char c port)
|
||||||
(finish))))))
|
(finish))))))
|
||||||
|
|
||||||
|
|
||||||
; Parse a circular structure marker without the leading # (which was already
|
; Parse a circular structure marker without the leading # (which was already
|
||||||
; read and recognized), that is, a number as identifier and then either
|
; read and recognized), that is, a number as identifier and then either
|
||||||
; = or #.
|
; = or #.
|
||||||
|
|
@ -239,7 +226,6 @@
|
||||||
((#\#) `(circular-ref . ,id))
|
((#\#) `(circular-ref . ,id))
|
||||||
((#\=) `(circular-def . ,id))
|
((#\=) `(circular-def . ,id))
|
||||||
(else (lexer-error port "invalid circular marker character" type))))))
|
(else (lexer-error port "invalid circular marker character" type))))))
|
||||||
|
|
||||||
|
|
||||||
; Main lexer routine, which is given a port and does look for the next token.
|
; Main lexer routine, which is given a port and does look for the next token.
|
||||||
|
|
||||||
|
|
@ -257,23 +243,18 @@
|
||||||
; and actually point to the very character to be read.
|
; and actually point to the very character to be read.
|
||||||
(c (read-char port)))
|
(c (read-char port)))
|
||||||
(cond
|
(cond
|
||||||
|
|
||||||
; End of input must be specially marked to the parser.
|
; End of input must be specially marked to the parser.
|
||||||
((eof-object? c) '*eoi*)
|
((eof-object? c) '*eoi*)
|
||||||
|
|
||||||
; Whitespace, just skip it.
|
; Whitespace, just skip it.
|
||||||
((char-whitespace? c) (lex port))
|
((char-whitespace? c) (lex port))
|
||||||
|
|
||||||
; The dot is only the one for dotted lists if followed by
|
; The dot is only the one for dotted lists if followed by
|
||||||
; whitespace. Otherwise it is considered part of a number of symbol.
|
; whitespace. Otherwise it is considered part of a number of symbol.
|
||||||
((and (char=? c #\.)
|
((and (char=? c #\.)
|
||||||
(char-whitespace? (peek-char port)))
|
(char-whitespace? (peek-char port)))
|
||||||
(return 'dot #f))
|
(return 'dot #f))
|
||||||
|
|
||||||
; Continue checking for literal character values.
|
; Continue checking for literal character values.
|
||||||
(else
|
(else
|
||||||
(case c
|
(case c
|
||||||
|
|
||||||
; A line comment, skip until end-of-line is found.
|
; A line comment, skip until end-of-line is found.
|
||||||
((#\;)
|
((#\;)
|
||||||
(let iterate ()
|
(let iterate ()
|
||||||
|
|
@ -281,11 +262,9 @@
|
||||||
(if (or (eof-object? cur) (char=? cur #\newline))
|
(if (or (eof-object? cur) (char=? cur #\newline))
|
||||||
(lex port)
|
(lex port)
|
||||||
(iterate)))))
|
(iterate)))))
|
||||||
|
|
||||||
; A character literal.
|
; A character literal.
|
||||||
((#\?)
|
((#\?)
|
||||||
(return 'character (get-character port #f)))
|
(return 'character (get-character port #f)))
|
||||||
|
|
||||||
; A literal string. This is mainly a sequence of characters just
|
; A literal string. This is mainly a sequence of characters just
|
||||||
; as in the character literals, the only difference is that escaped
|
; as in the character literals, the only difference is that escaped
|
||||||
; newline and space are to be completely ignored and that meta-escapes
|
; newline and space are to be completely ignored and that meta-escapes
|
||||||
|
|
@ -307,12 +286,10 @@
|
||||||
(iterate (cons (integer->char (get-character port #t))
|
(iterate (cons (integer->char (get-character port #t))
|
||||||
result-chars))))))
|
result-chars))))))
|
||||||
(else (iterate (cons cur result-chars)))))))
|
(else (iterate (cons cur result-chars)))))))
|
||||||
|
|
||||||
; Circular markers (either reference or definition).
|
; Circular markers (either reference or definition).
|
||||||
((#\#)
|
((#\#)
|
||||||
(let ((mark (get-circular-marker port)))
|
(let ((mark (get-circular-marker port)))
|
||||||
(return (car mark) (cdr mark))))
|
(return (car mark) (cdr mark))))
|
||||||
|
|
||||||
; Parentheses and other special-meaning single characters.
|
; Parentheses and other special-meaning single characters.
|
||||||
((#\() (return 'paren-open #f))
|
((#\() (return 'paren-open #f))
|
||||||
((#\)) (return 'paren-close #f))
|
((#\)) (return 'paren-close #f))
|
||||||
|
|
@ -320,7 +297,6 @@
|
||||||
((#\]) (return 'square-close #f))
|
((#\]) (return 'square-close #f))
|
||||||
((#\') (return 'quote #f))
|
((#\') (return 'quote #f))
|
||||||
((#\`) (return 'backquote #f))
|
((#\`) (return 'backquote #f))
|
||||||
|
|
||||||
; Unquote and unquote-splicing.
|
; Unquote and unquote-splicing.
|
||||||
((#\,)
|
((#\,)
|
||||||
(if (is-char? (peek-char port) #\@)
|
(if (is-char? (peek-char port) #\@)
|
||||||
|
|
@ -328,7 +304,6 @@
|
||||||
(error "expected @ in unquote-splicing")
|
(error "expected @ in unquote-splicing")
|
||||||
(return 'unquote-splicing #f))
|
(return 'unquote-splicing #f))
|
||||||
(return 'unquote #f)))
|
(return 'unquote #f)))
|
||||||
|
|
||||||
; Remaining are numbers and symbols. Process input until next
|
; Remaining are numbers and symbols. Process input until next
|
||||||
; whitespace is found, and see if it looks like a number
|
; whitespace is found, and see if it looks like a number
|
||||||
; (float/integer) or symbol and return accordingly.
|
; (float/integer) or symbol and return accordingly.
|
||||||
|
|
@ -369,7 +344,6 @@
|
||||||
num)))
|
num)))
|
||||||
(else (error "wrong number/symbol type" type)))))))))))
|
(else (error "wrong number/symbol type" type)))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Build a lexer thunk for a port. This is the exported routine which can be
|
; Build a lexer thunk for a port. This is the exported routine which can be
|
||||||
; used to create a lexer for the parser to use.
|
; used to create a lexer for the parser to use.
|
||||||
|
|
||||||
|
|
@ -377,7 +351,6 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(lex port)))
|
(lex port)))
|
||||||
|
|
||||||
|
|
||||||
; Build a special lexer that will only read enough for one expression and then
|
; Build a special lexer that will only read enough for one expression and then
|
||||||
; always return end-of-input.
|
; always return end-of-input.
|
||||||
; If we find one of the quotation stuff, one more expression is needed in any
|
; If we find one of the quotation stuff, one more expression is needed in any
|
||||||
|
|
|
||||||
|
|
@ -28,14 +28,12 @@
|
||||||
; lexer ((text parse-lalr) seems not to allow access to the original lexer
|
; lexer ((text parse-lalr) seems not to allow access to the original lexer
|
||||||
; token-pair) and is easy enough anyways.
|
; token-pair) and is easy enough anyways.
|
||||||
|
|
||||||
|
|
||||||
; Report a parse error. The first argument is some current lexer token
|
; Report a parse error. The first argument is some current lexer token
|
||||||
; where source information is available should it be useful.
|
; where source information is available should it be useful.
|
||||||
|
|
||||||
(define (parse-error token msg . args)
|
(define (parse-error token msg . args)
|
||||||
(apply error msg args))
|
(apply error msg args))
|
||||||
|
|
||||||
|
|
||||||
; For parsing circular structures, we keep track of definitions in a
|
; For parsing circular structures, we keep track of definitions in a
|
||||||
; hash-map that maps the id's to their values.
|
; hash-map that maps the id's to their values.
|
||||||
; When defining a new id, though, we immediatly fill the slot with a promise
|
; When defining a new id, though, we immediatly fill the slot with a promise
|
||||||
|
|
@ -64,6 +62,7 @@
|
||||||
; Returned is a closure that, when invoked, will set the final value.
|
; Returned is a closure that, when invoked, will set the final value.
|
||||||
; This means both the variable the promise will return and the hash-table
|
; This means both the variable the promise will return and the hash-table
|
||||||
; slot so we don't generate promises any longer.
|
; slot so we don't generate promises any longer.
|
||||||
|
|
||||||
(define (circular-define! token)
|
(define (circular-define! token)
|
||||||
(if (not (eq? (car token) 'circular-def))
|
(if (not (eq? (car token) 'circular-def))
|
||||||
(error "invalid token for circular-define!" token))
|
(error "invalid token for circular-define!" token))
|
||||||
|
|
@ -80,6 +79,7 @@
|
||||||
; this may lead to infinite recursion with a circular structure, and
|
; this may lead to infinite recursion with a circular structure, and
|
||||||
; additionally this value was already processed when it was defined.
|
; additionally this value was already processed when it was defined.
|
||||||
; All deep data structures that can be parsed must be handled here!
|
; All deep data structures that can be parsed must be handled here!
|
||||||
|
|
||||||
(define (force-promises! data)
|
(define (force-promises! data)
|
||||||
(cond
|
(cond
|
||||||
((pair? data)
|
((pair? data)
|
||||||
|
|
@ -102,7 +102,6 @@
|
||||||
; Else nothing needs to be done.
|
; Else nothing needs to be done.
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
; We need peek-functionality for the next lexer token, this is done with some
|
; We need peek-functionality for the next lexer token, this is done with some
|
||||||
; single token look-ahead storage. This is handled by a closure which allows
|
; single token look-ahead storage. This is handled by a closure which allows
|
||||||
; getting or peeking the next token.
|
; getting or peeking the next token.
|
||||||
|
|
@ -128,7 +127,6 @@
|
||||||
result))
|
result))
|
||||||
(else (error "invalid lexer-buffer action" action))))))))
|
(else (error "invalid lexer-buffer action" action))))))))
|
||||||
|
|
||||||
|
|
||||||
; Get the contents of a list, where the opening parentheses has already been
|
; Get the contents of a list, where the opening parentheses has already been
|
||||||
; found. The same code is used for vectors and lists, where lists allow the
|
; found. The same code is used for vectors and lists, where lists allow the
|
||||||
; dotted tail syntax and vectors not; additionally, the closing parenthesis
|
; dotted tail syntax and vectors not; additionally, the closing parenthesis
|
||||||
|
|
@ -159,8 +157,6 @@
|
||||||
(tail (get-list lex allow-dot close-square)))
|
(tail (get-list lex allow-dot close-square)))
|
||||||
(cons head tail))))))
|
(cons head tail))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
; Parse a single expression from a lexer-buffer. This is the main routine in
|
; Parse a single expression from a lexer-buffer. This is the main routine in
|
||||||
; our recursive-descent parser.
|
; our recursive-descent parser.
|
||||||
|
|
||||||
|
|
@ -197,7 +193,6 @@
|
||||||
(else
|
(else
|
||||||
(parse-error token "expected expression, got" token)))))
|
(parse-error token "expected expression, got" token)))))
|
||||||
|
|
||||||
|
|
||||||
; Define the reader function based on this; build a lexer, a lexer-buffer,
|
; Define the reader function based on this; build a lexer, a lexer-buffer,
|
||||||
; and then parse a single expression to return.
|
; and then parse a single expression to return.
|
||||||
; We also define a circular-definitions data structure to use.
|
; We also define a circular-definitions data structure to use.
|
||||||
|
|
|
||||||
|
|
@ -22,36 +22,31 @@
|
||||||
#:export (void
|
#:export (void
|
||||||
nil-value t-value
|
nil-value t-value
|
||||||
value-slot-module function-slot-module
|
value-slot-module function-slot-module
|
||||||
|
|
||||||
elisp-bool
|
elisp-bool
|
||||||
|
|
||||||
ensure-fluid! reference-variable reference-variable-with-check
|
ensure-fluid! reference-variable reference-variable-with-check
|
||||||
set-variable!
|
set-variable!
|
||||||
|
|
||||||
runtime-error macro-error)
|
runtime-error macro-error)
|
||||||
#:export-syntax (built-in-func built-in-macro prim))
|
#:export-syntax (built-in-func built-in-macro prim))
|
||||||
|
|
||||||
; This module provides runtime support for the Elisp front-end.
|
; This module provides runtime support for the Elisp front-end.
|
||||||
|
|
||||||
|
|
||||||
; The reserved value to mean (when eq?) void.
|
; The reserved value to mean (when eq?) void.
|
||||||
|
|
||||||
(define void (list 42))
|
(define void (list 42))
|
||||||
|
|
||||||
|
|
||||||
; Values for t and nil. (FIXME remove this abstraction)
|
; Values for t and nil. (FIXME remove this abstraction)
|
||||||
|
|
||||||
(define nil-value #nil)
|
(define nil-value #nil)
|
||||||
(define t-value #t)
|
|
||||||
|
|
||||||
|
(define t-value #t)
|
||||||
|
|
||||||
; Modules for the binding slots.
|
; Modules for the binding slots.
|
||||||
; Note: Naming those value-slot and/or function-slot clashes with the
|
; Note: Naming those value-slot and/or function-slot clashes with the
|
||||||
; submodules of these names!
|
; submodules of these names!
|
||||||
|
|
||||||
(define value-slot-module '(language elisp runtime value-slot))
|
(define value-slot-module '(language elisp runtime value-slot))
|
||||||
(define function-slot-module '(language elisp runtime function-slot))
|
|
||||||
|
|
||||||
|
(define function-slot-module '(language elisp runtime function-slot))
|
||||||
|
|
||||||
; Report an error during macro compilation, that means some special compilation
|
; Report an error during macro compilation, that means some special compilation
|
||||||
; (syntax) error; or report a simple runtime-error from a built-in function.
|
; (syntax) error; or report a simple runtime-error from a built-in function.
|
||||||
|
|
@ -61,7 +56,6 @@
|
||||||
|
|
||||||
(define runtime-error macro-error)
|
(define runtime-error macro-error)
|
||||||
|
|
||||||
|
|
||||||
; Convert a scheme boolean to Elisp.
|
; Convert a scheme boolean to Elisp.
|
||||||
|
|
||||||
(define (elisp-bool b)
|
(define (elisp-bool b)
|
||||||
|
|
@ -69,7 +63,6 @@
|
||||||
t-value
|
t-value
|
||||||
nil-value))
|
nil-value))
|
||||||
|
|
||||||
|
|
||||||
; Routines for access to elisp dynamically bound symbols.
|
; Routines for access to elisp dynamically bound symbols.
|
||||||
; This is used for runtime access using functions like symbol-value or set,
|
; This is used for runtime access using functions like symbol-value or set,
|
||||||
; where the symbol accessed might not be known at compile-time.
|
; where the symbol accessed might not be known at compile-time.
|
||||||
|
|
@ -101,7 +94,6 @@
|
||||||
(fluid-set! (module-ref resolved sym) value)
|
(fluid-set! (module-ref resolved sym) value)
|
||||||
value))
|
value))
|
||||||
|
|
||||||
|
|
||||||
; Define a predefined function or predefined macro for use in the function-slot
|
; Define a predefined function or predefined macro for use in the function-slot
|
||||||
; and macro-slot modules, respectively.
|
; and macro-slot modules, respectively.
|
||||||
|
|
||||||
|
|
@ -117,7 +109,6 @@
|
||||||
((_ name value)
|
((_ name value)
|
||||||
(define-public name value))))
|
(define-public name value))))
|
||||||
|
|
||||||
|
|
||||||
; Call a guile-primitive that may be rebound for elisp and thus needs absolute
|
; Call a guile-primitive that may be rebound for elisp and thus needs absolute
|
||||||
; addressing.
|
; addressing.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -25,7 +25,6 @@
|
||||||
; This module contains the function-slots of elisp symbols. Elisp built-in
|
; This module contains the function-slots of elisp symbols. Elisp built-in
|
||||||
; functions are implemented as predefined function bindings here.
|
; functions are implemented as predefined function bindings here.
|
||||||
|
|
||||||
|
|
||||||
; Equivalence and equalness predicates.
|
; Equivalence and equalness predicates.
|
||||||
|
|
||||||
(built-in-func eq (lambda (a b)
|
(built-in-func eq (lambda (a b)
|
||||||
|
|
@ -34,7 +33,6 @@
|
||||||
(built-in-func equal (lambda (a b)
|
(built-in-func equal (lambda (a b)
|
||||||
(elisp-bool (equal? a b))))
|
(elisp-bool (equal? a b))))
|
||||||
|
|
||||||
|
|
||||||
; Number predicates.
|
; Number predicates.
|
||||||
|
|
||||||
(built-in-func floatp (lambda (num)
|
(built-in-func floatp (lambda (num)
|
||||||
|
|
@ -57,31 +55,34 @@
|
||||||
(built-in-func zerop (lambda (num)
|
(built-in-func zerop (lambda (num)
|
||||||
(elisp-bool (prim = num 0))))
|
(elisp-bool (prim = num 0))))
|
||||||
|
|
||||||
|
|
||||||
; Number comparisons.
|
; Number comparisons.
|
||||||
|
|
||||||
(built-in-func = (lambda (num1 num2)
|
(built-in-func = (lambda (num1 num2)
|
||||||
(elisp-bool (prim = num1 num2))))
|
(elisp-bool (prim = num1 num2))))
|
||||||
|
|
||||||
(built-in-func /= (lambda (num1 num2)
|
(built-in-func /= (lambda (num1 num2)
|
||||||
(elisp-bool (prim not (prim = num1 num2)))))
|
(elisp-bool (prim not (prim = num1 num2)))))
|
||||||
|
|
||||||
(built-in-func < (lambda (num1 num2)
|
(built-in-func < (lambda (num1 num2)
|
||||||
(elisp-bool (prim < num1 num2))))
|
(elisp-bool (prim < num1 num2))))
|
||||||
|
|
||||||
(built-in-func <= (lambda (num1 num2)
|
(built-in-func <= (lambda (num1 num2)
|
||||||
(elisp-bool (prim <= num1 num2))))
|
(elisp-bool (prim <= num1 num2))))
|
||||||
|
|
||||||
(built-in-func > (lambda (num1 num2)
|
(built-in-func > (lambda (num1 num2)
|
||||||
(elisp-bool (prim > num1 num2))))
|
(elisp-bool (prim > num1 num2))))
|
||||||
|
|
||||||
(built-in-func >= (lambda (num1 num2)
|
(built-in-func >= (lambda (num1 num2)
|
||||||
(elisp-bool (prim >= num1 num2))))
|
(elisp-bool (prim >= num1 num2))))
|
||||||
|
|
||||||
(built-in-func max (lambda (. nums)
|
(built-in-func max (lambda (. nums)
|
||||||
(prim apply (@ (guile) max) nums)))
|
(prim apply (@ (guile) max) nums)))
|
||||||
|
|
||||||
(built-in-func min (lambda (. nums)
|
(built-in-func min (lambda (. nums)
|
||||||
(prim apply (@ (guile) min) nums)))
|
(prim apply (@ (guile) min) nums)))
|
||||||
|
|
||||||
(built-in-func abs (@ (guile) abs))
|
(built-in-func abs (@ (guile) abs))
|
||||||
|
|
||||||
|
|
||||||
; Number conversion.
|
; Number conversion.
|
||||||
|
|
||||||
(built-in-func float (lambda (num)
|
(built-in-func float (lambda (num)
|
||||||
|
|
@ -91,32 +92,38 @@
|
||||||
|
|
||||||
; TODO: truncate, floor, ceiling, round.
|
; TODO: truncate, floor, ceiling, round.
|
||||||
|
|
||||||
|
|
||||||
; Arithmetic functions.
|
; Arithmetic functions.
|
||||||
|
|
||||||
(built-in-func 1+ (@ (guile) 1+))
|
(built-in-func 1+ (@ (guile) 1+))
|
||||||
|
|
||||||
(built-in-func 1- (@ (guile) 1-))
|
(built-in-func 1- (@ (guile) 1-))
|
||||||
|
|
||||||
(built-in-func + (@ (guile) +))
|
(built-in-func + (@ (guile) +))
|
||||||
|
|
||||||
(built-in-func - (@ (guile) -))
|
(built-in-func - (@ (guile) -))
|
||||||
|
|
||||||
(built-in-func * (@ (guile) *))
|
(built-in-func * (@ (guile) *))
|
||||||
|
|
||||||
(built-in-func % (@ (guile) modulo))
|
(built-in-func % (@ (guile) modulo))
|
||||||
|
|
||||||
; TODO: / with correct integer/real behaviour, mod (for floating-piont values).
|
; TODO: / with correct integer/real behaviour, mod (for floating-piont values).
|
||||||
|
|
||||||
|
|
||||||
; Floating-point rounding operations.
|
; Floating-point rounding operations.
|
||||||
|
|
||||||
(built-in-func ffloor (@ (guile) floor))
|
(built-in-func ffloor (@ (guile) floor))
|
||||||
(built-in-func fceiling (@ (guile) ceiling))
|
|
||||||
(built-in-func ftruncate (@ (guile) truncate))
|
|
||||||
(built-in-func fround (@ (guile) round))
|
|
||||||
|
|
||||||
|
(built-in-func fceiling (@ (guile) ceiling))
|
||||||
|
|
||||||
|
(built-in-func ftruncate (@ (guile) truncate))
|
||||||
|
|
||||||
|
(built-in-func fround (@ (guile) round))
|
||||||
|
|
||||||
; List predicates.
|
; List predicates.
|
||||||
|
|
||||||
(built-in-func consp
|
(built-in-func consp
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(elisp-bool (pair? el))))
|
(elisp-bool (pair? el))))
|
||||||
|
|
||||||
(built-in-func atomp
|
(built-in-func atomp
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(elisp-bool (prim not (pair? el)))))
|
(elisp-bool (prim not (pair? el)))))
|
||||||
|
|
@ -124,6 +131,7 @@
|
||||||
(built-in-func listp
|
(built-in-func listp
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(elisp-bool (or (pair? el) (null? el)))))
|
(elisp-bool (or (pair? el) (null? el)))))
|
||||||
|
|
||||||
(built-in-func nlistp
|
(built-in-func nlistp
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(elisp-bool (and (prim not (pair? el))
|
(elisp-bool (and (prim not (pair? el))
|
||||||
|
|
@ -133,7 +141,6 @@
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(elisp-bool (null? el))))
|
(elisp-bool (null? el))))
|
||||||
|
|
||||||
|
|
||||||
; Accessing list elements.
|
; Accessing list elements.
|
||||||
|
|
||||||
(built-in-func car
|
(built-in-func car
|
||||||
|
|
@ -141,6 +148,7 @@
|
||||||
(if (null? el)
|
(if (null? el)
|
||||||
nil-value
|
nil-value
|
||||||
(prim car el))))
|
(prim car el))))
|
||||||
|
|
||||||
(built-in-func cdr
|
(built-in-func cdr
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(if (null? el)
|
(if (null? el)
|
||||||
|
|
@ -152,6 +160,7 @@
|
||||||
(if (pair? el)
|
(if (pair? el)
|
||||||
(prim car el)
|
(prim car el)
|
||||||
nil-value)))
|
nil-value)))
|
||||||
|
|
||||||
(built-in-func cdr-safe
|
(built-in-func cdr-safe
|
||||||
(lambda (el)
|
(lambda (el)
|
||||||
(if (pair? el)
|
(if (pair? el)
|
||||||
|
|
@ -168,6 +177,7 @@
|
||||||
((null? tail) nil-value)
|
((null? tail) nil-value)
|
||||||
((zero? i) (prim car tail))
|
((zero? i) (prim car tail))
|
||||||
(else (iterate (prim 1- i) (prim cdr tail))))))))
|
(else (iterate (prim 1- i) (prim cdr tail))))))))
|
||||||
|
|
||||||
(built-in-func nthcdr
|
(built-in-func nthcdr
|
||||||
(lambda (n lst)
|
(lambda (n lst)
|
||||||
(if (negative? n)
|
(if (negative? n)
|
||||||
|
|
@ -181,17 +191,20 @@
|
||||||
|
|
||||||
(built-in-func length (@ (guile) length))
|
(built-in-func length (@ (guile) length))
|
||||||
|
|
||||||
|
|
||||||
; Building lists.
|
; Building lists.
|
||||||
|
|
||||||
(built-in-func cons (@ (guile) cons))
|
(built-in-func cons (@ (guile) cons))
|
||||||
|
|
||||||
(built-in-func list (@ (guile) list))
|
(built-in-func list (@ (guile) list))
|
||||||
|
|
||||||
(built-in-func make-list
|
(built-in-func make-list
|
||||||
(lambda (len obj)
|
(lambda (len obj)
|
||||||
(prim make-list len obj)))
|
(prim make-list len obj)))
|
||||||
|
|
||||||
(built-in-func append (@ (guile) append))
|
(built-in-func append (@ (guile) append))
|
||||||
|
|
||||||
(built-in-func reverse (@ (guile) reverse))
|
(built-in-func reverse (@ (guile) reverse))
|
||||||
|
|
||||||
(built-in-func copy-tree (@ (guile) copy-tree))
|
(built-in-func copy-tree (@ (guile) copy-tree))
|
||||||
|
|
||||||
(built-in-func number-sequence
|
(built-in-func number-sequence
|
||||||
|
|
@ -223,7 +236,6 @@
|
||||||
(prim cons i result)
|
(prim cons i result)
|
||||||
(iterate (prim - i sep) (prim cons i result)))))))))))
|
(iterate (prim - i sep) (prim cons i result)))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Changing lists.
|
; Changing lists.
|
||||||
|
|
||||||
(built-in-func setcar
|
(built-in-func setcar
|
||||||
|
|
@ -236,12 +248,12 @@
|
||||||
(prim set-cdr! cell val)
|
(prim set-cdr! cell val)
|
||||||
val))
|
val))
|
||||||
|
|
||||||
|
|
||||||
; Accessing symbol bindings for symbols known only at runtime.
|
; Accessing symbol bindings for symbols known only at runtime.
|
||||||
|
|
||||||
(built-in-func symbol-value
|
(built-in-func symbol-value
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(reference-variable-with-check value-slot-module sym)))
|
(reference-variable-with-check value-slot-module sym)))
|
||||||
|
|
||||||
(built-in-func symbol-function
|
(built-in-func symbol-function
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(reference-variable-with-check function-slot-module sym)))
|
(reference-variable-with-check function-slot-module sym)))
|
||||||
|
|
@ -249,6 +261,7 @@
|
||||||
(built-in-func set
|
(built-in-func set
|
||||||
(lambda (sym value)
|
(lambda (sym value)
|
||||||
(set-variable! value-slot-module sym value)))
|
(set-variable! value-slot-module sym value)))
|
||||||
|
|
||||||
(built-in-func fset
|
(built-in-func fset
|
||||||
(lambda (sym value)
|
(lambda (sym value)
|
||||||
(set-variable! function-slot-module sym value)))
|
(set-variable! function-slot-module sym value)))
|
||||||
|
|
@ -257,6 +270,7 @@
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(set-variable! value-slot-module sym void)
|
(set-variable! value-slot-module sym void)
|
||||||
sym))
|
sym))
|
||||||
|
|
||||||
(built-in-func fmakunbound
|
(built-in-func fmakunbound
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(set-variable! function-slot-module sym void)
|
(set-variable! function-slot-module sym void)
|
||||||
|
|
@ -266,12 +280,12 @@
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(elisp-bool (prim not
|
(elisp-bool (prim not
|
||||||
(eq? void (reference-variable value-slot-module sym))))))
|
(eq? void (reference-variable value-slot-module sym))))))
|
||||||
|
|
||||||
(built-in-func fboundp
|
(built-in-func fboundp
|
||||||
(lambda (sym)
|
(lambda (sym)
|
||||||
(elisp-bool (prim not
|
(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
|
; Function calls. These must take care of special cases, like using symbols
|
||||||
; or raw lambda-lists as functions!
|
; or raw lambda-lists as functions!
|
||||||
|
|
||||||
|
|
@ -294,14 +308,12 @@
|
||||||
(lambda (func . args)
|
(lambda (func . args)
|
||||||
(myapply func args))))
|
(myapply func args))))
|
||||||
|
|
||||||
|
|
||||||
; Throw can be implemented as built-in function.
|
; Throw can be implemented as built-in function.
|
||||||
|
|
||||||
(built-in-func throw
|
(built-in-func throw
|
||||||
(lambda (tag value)
|
(lambda (tag value)
|
||||||
(prim throw 'elisp-exception tag value)))
|
(prim throw 'elisp-exception tag value)))
|
||||||
|
|
||||||
|
|
||||||
; Miscellaneous.
|
; Miscellaneous.
|
||||||
|
|
||||||
(built-in-func not
|
(built-in-func not
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,6 @@
|
||||||
; course, so not really in runtime. But I think it fits well to the others
|
; course, so not really in runtime. But I think it fits well to the others
|
||||||
; here.
|
; here.
|
||||||
|
|
||||||
|
|
||||||
; The prog1 and prog2 constructs can easily be defined as macros using progn
|
; The prog1 and prog2 constructs can easily be defined as macros using progn
|
||||||
; and some lexical-let's to save the intermediate value to return at the end.
|
; and some lexical-let's to save the intermediate value to return at the end.
|
||||||
|
|
||||||
|
|
@ -42,7 +41,6 @@
|
||||||
(lambda (form1 form2 . rest)
|
(lambda (form1 form2 . rest)
|
||||||
`(progn ,form1 (prog1 ,form2 ,@rest))))
|
`(progn ,form1 (prog1 ,form2 ,@rest))))
|
||||||
|
|
||||||
|
|
||||||
; Define the conditionals when and unless as macros.
|
; Define the conditionals when and unless as macros.
|
||||||
|
|
||||||
(built-in-macro when
|
(built-in-macro when
|
||||||
|
|
@ -53,7 +51,6 @@
|
||||||
(lambda (condition . elses)
|
(lambda (condition . elses)
|
||||||
`(if ,condition nil (progn ,@elses))))
|
`(if ,condition nil (progn ,@elses))))
|
||||||
|
|
||||||
|
|
||||||
; Impement the cond form as nested if's. A special case is a (condition)
|
; Impement the cond form as nested if's. A special case is a (condition)
|
||||||
; subform, in which case we need to return the condition itself if it is true
|
; subform, in which case we need to return the condition itself if it is true
|
||||||
; and thus save it in a local variable before testing it.
|
; and thus save it in a local variable before testing it.
|
||||||
|
|
@ -80,7 +77,6 @@
|
||||||
(progn ,@(cdr cur))
|
(progn ,@(cdr cur))
|
||||||
,rest))))))))
|
,rest))))))))
|
||||||
|
|
||||||
|
|
||||||
; The and and or forms can also be easily defined with macros.
|
; The and and or forms can also be easily defined with macros.
|
||||||
|
|
||||||
(built-in-macro and
|
(built-in-macro and
|
||||||
|
|
@ -111,7 +107,6 @@
|
||||||
,var
|
,var
|
||||||
,(iterate (car tail) (cdr tail)))))))))))
|
,(iterate (car tail) (cdr tail)))))))))))
|
||||||
|
|
||||||
|
|
||||||
; Define the dotimes and dolist iteration macros.
|
; Define the dotimes and dolist iteration macros.
|
||||||
|
|
||||||
(built-in-macro dotimes
|
(built-in-macro dotimes
|
||||||
|
|
@ -155,7 +150,6 @@
|
||||||
(list (caddr args))
|
(list (caddr args))
|
||||||
'())))))))))
|
'())))))))))
|
||||||
|
|
||||||
|
|
||||||
; Exception handling. unwind-protect and catch are implemented as macros (throw
|
; Exception handling. unwind-protect and catch are implemented as macros (throw
|
||||||
; is a built-in function).
|
; is a built-in function).
|
||||||
|
|
||||||
|
|
@ -165,6 +159,7 @@
|
||||||
; for matches using eq (eq?). We handle this by using always #t as key
|
; for matches using eq (eq?). We handle this by using always #t as key
|
||||||
; for the Guile primitives and check for matches inside the handler; if
|
; for the Guile primitives and check for matches inside the handler; if
|
||||||
; the elisp keys are not eq?, we rethrow the exception.
|
; the elisp keys are not eq?, we rethrow the exception.
|
||||||
|
|
||||||
(built-in-macro catch
|
(built-in-macro catch
|
||||||
(lambda (tag . body)
|
(lambda (tag . body)
|
||||||
(if (null? body)
|
(if (null? body)
|
||||||
|
|
@ -185,8 +180,9 @@
|
||||||
((guile-primitive throw) ,dummy-key ,elisp-key
|
((guile-primitive throw) ,dummy-key ,elisp-key
|
||||||
,value))))))))))
|
,value))))))))))
|
||||||
|
|
||||||
; unwind-protect is just some weaker construct as dynamic-wind, so
|
; unwind-protect is just some weaker construct as dynamic-wind, so
|
||||||
; straight-forward to implement.
|
; straight-forward to implement.
|
||||||
|
|
||||||
(built-in-macro unwind-protect
|
(built-in-macro unwind-protect
|
||||||
(lambda (body . clean-ups)
|
(lambda (body . clean-ups)
|
||||||
(if (null? clean-ups)
|
(if (null? clean-ups)
|
||||||
|
|
@ -196,7 +192,6 @@
|
||||||
(lambda () ,body)
|
(lambda () ,body)
|
||||||
(lambda () ,@clean-ups))))
|
(lambda () ,@clean-ups))))
|
||||||
|
|
||||||
|
|
||||||
; Pop off the first element from a list or push one to it.
|
; Pop off the first element from a list or push one to it.
|
||||||
|
|
||||||
(built-in-macro pop
|
(built-in-macro pop
|
||||||
|
|
|
||||||
|
|
@ -6,12 +6,12 @@
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
;;;; License as published by the Free Software Foundation; either
|
;;;; License as published by the Free Software Foundation; either
|
||||||
;;;; version 3 of the License, or (at your option) any later version.
|
;;;; version 3 of the License, or (at your option) any later version.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is distributed in the hope that it will be useful,
|
;;;; This library is distributed in the hope that it will be useful,
|
||||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||||
;;;; Lesser General Public License for more details.
|
;;;; Lesser General Public License for more details.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; You should have received a copy of the GNU Lesser General Public
|
;;;; You should have received a copy of the GNU Lesser General Public
|
||||||
;;;; License along with this library; if not, write to the Free Software
|
;;;; License along with this library; if not, write to the Free Software
|
||||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue