mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

reformat comments

Browse source 
* 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/runtime/value-slot.scm: Reformat comments.
This commit is contained in:
Brian Templeton 2010-06-07 16:38:00 -04:00
parent 372b11fc73
commit 27b9476a8d
8 changed files with 478 additions and 450 deletions
Download patch file Download diff file Expand all files Collapse all files

61
module/language/elisp/bindings.scm
View file

@ -2,19 +2,20 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -24,31 +25,33 @@
with-lexical-bindings with-dynamic-bindings
get-lexical-binding))
; This module defines routines to handle analysis of symbol bindings used
; during elisp compilation. This data allows to collect the symbols, for
; which globals need to be created, or mark certain symbols as lexically bound.
;;; This module defines routines to handle analysis of symbol bindings
;;; used during elisp compilation. This data allows to collect the
;;; symbols, for which globals need to be created, or mark certain
;;; symbols as lexically bound.
;;;
;;; Needed globals are stored in an association-list that stores a list
;;; of symbols for each module they are needed in.
;;;
;;; The lexical bindings of symbols are stored in a hash-table that
;;; associates symbols to fluids; those fluids are used in the
;;; with-lexical-binding and with-dynamic-binding routines to associate
;;; symbols to different bindings over a dynamic extent.
; Needed globals are stored in an association-list that stores a list of symbols
; for each module they are needed in.
; The lexical bindings of symbols are stored in a hash-table that associates
; symbols to fluids; those fluids are used in the with-lexical-binding and
; with-dynamic-binding routines to associate symbols to different bindings
; over a dynamic extent.
; Record type used to hold the data necessary.
;;; Record type used to hold the data necessary.
(define bindings-type
(make-record-type 'bindings
'(needed-globals lexical-bindings)))
; Construct an 'empty' instance of the bindings data structure to be used
; at the start of a fresh compilation.
;;; Construct an 'empty' instance of the bindings data structure to be
;;; used at the start of a fresh compilation.
(define (make-bindings)
((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)
(let* ((old-needed ((record-accessor bindings-type 'needed-globals) bindings))
@ -59,8 +62,8 @@
(new-needed (assoc-set! old-needed module new-in-module)))
((record-modifier bindings-type 'needed-globals) bindings new-needed)))
; Cycle through all globals needed in order to generate the code for their
; creation or some other analysis.
;;; Cycle through all globals needed in order to generate the code for
;;; their creation or some other analysis.
(define (map-globals-needed bindings proc)
(let ((needed ((record-accessor bindings-type 'needed-globals) bindings)))
@ -81,8 +84,8 @@
(cons (proc module (car sym-tail))
sym-result))))))))))
; Get the current lexical binding (gensym it should refer to in the current
; scope) for a symbol or #f if it is dynamically bound.
;;; Get the current lexical binding (gensym it should refer to in the
;;; current scope) for a symbol or #f if it is dynamically bound.
(define (get-lexical-binding bindings sym)
(let* ((lex ((record-accessor bindings-type 'lexical-bindings) bindings))
@ -91,8 +94,8 @@
(fluid-ref slot)
#f)))
; Establish a binding or mark a symbol as dynamically bound for the extent of
; calling proc.
;;; Establish a binding or mark a symbol as dynamically bound for the
;;; extent of calling proc.
(define (with-symbol-bindings bindings syms targets proc)
(if (or (not (list? syms))

361
module/language/elisp/compile-tree-il.scm
View file

@ -1,21 +1,21 @@
;;; Guile Emacs Lisp
;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
;;; MA 02111-1307, USA.
;;; Code:
@ -27,25 +27,26 @@
#:use-module (srfi srfi-1)
#:export (compile-tree-il))
; Certain common parameters (like the bindings data structure or compiler
; options) are not always passed around but accessed using fluids to simulate
; dynamic binding (hey, this is about elisp).
;;; Certain common parameters (like the bindings data structure or
;;; compiler options) are not always passed around but accessed using
;;; fluids to simulate 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))
; 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))
; Store which symbols (or all/none) should always be bound lexically, even
; with ordinary let and as lambda arguments.
;;; Store which symbols (or all/none) should always be bound lexically,
;;; even with ordinary let and as lambda arguments.
(define always-lexical (make-fluid))
; Find the source properties of some parsed expression if there are any
; associated with it.
;;; Find the source properties of some parsed expression if there are
;;; any associated with it.
(define (location x)
(and (pair? x)
@ -53,13 +54,13 @@
(and (not (null? 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 (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))
@ -69,9 +70,10 @@
(define function-slot (@ (language elisp runtime) function-slot-module))
; The backquoting works the same as quasiquotes in Scheme, but the forms are
; named differently; to make easy adaptions, we define these predicates checking
; for a symbol being the car of an unquote/unquote-splicing/backquote form.
;;; The backquoting works the same as quasiquotes in Scheme, but the
;;; forms are named differently; to make easy adaptions, we define these
;;; predicates checking for a symbol being the car of an
;;; unquote/unquote-splicing/backquote form.
(define (backquote? sym)
(and (symbol? sym) (eq? sym '\`)))
@ -82,13 +84,13 @@
(define (unquote-splicing? 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)
(make-application loc (make-primitive-ref loc sym) args))
; Error reporting routine for syntax/compilation problems or build code for
; a runtime-error output.
;;; Error reporting routine for syntax/compilation problems or build
;;; code for a runtime-error output.
(define (report-error loc . args)
(apply error args))
@ -97,19 +99,21 @@
(make-application loc (make-primitive-ref loc 'error)
(cons (make-const loc msg) args)))
; 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
; the bindings data structure. Afterwards, however, for all those needed
; symbols the globals are really generated with this routine.
;;; 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 the bindings data structure. Afterwards, however,
;;; for all those needed symbols the globals are really generated with
;;; this routine.
(define (generate-ensure-global loc sym module)
(make-application loc (make-module-ref loc runtime 'ensure-fluid! #t)
(list (make-const loc module)
(make-const loc sym))))
; 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.
; Disabling of void check is only done for the value-slot module!
;;; 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. Disabling of void check is only done for the value-slot
;;; module!
(define (want-void-check? sym module)
(let ((disabled (fluid-ref disable-void-check)))
@ -117,10 +121,10 @@
(and (not (eq? disabled 'all))
(not (memq sym disabled))))))
; Build a construct that establishes dynamic bindings for certain variables.
; We may want to choose between binding with fluids and with-fluids* and
; using just ordinary module symbols and setting/reverting their values with
; a dynamic-wind.
;;; Build a construct that establishes dynamic bindings for certain
;;; variables. We may want to choose between binding with fluids and
;;; with-fluids* and using just ordinary module symbols and
;;; setting/reverting their values with a dynamic-wind.
(define (let-dynamic loc syms module vals body)
(call-primitive loc 'with-fluids*
@ -132,9 +136,9 @@
(make-lambda loc '()
(make-lambda-case #f '() #f #f #f '() '() body #f))))
; Handle access to a variable (reference/setting) correctly depending on
; whether it is currently lexically or dynamically bound.
; lexical access is done only for references to the value-slot module!
;;; Handle access to a variable (reference/setting) correctly depending
;;; on whether it is currently lexically or dynamically bound. lexical
;;; access is done only for references to the value-slot module!
(define (access-variable loc sym module handle-lexical handle-dynamic)
(let ((lexical (get-lexical-binding (fluid-ref bindings-data) sym)))
@ -142,9 +146,9 @@
(handle-lexical lexical)
(handle-dynamic))))
; Generate code to reference a variable.
; For references in the value-slot module, we may want to generate a lexical
; reference instead if the variable has a lexical binding.
;;; Generate code to reference a variable. For references in the
;;; value-slot module, we may want to generate a lexical reference
;;; instead if the variable has a lexical binding.
(define (reference-variable loc sym module)
(access-variable loc sym module
@ -155,7 +159,7 @@
(call-primitive loc 'fluid-ref
(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)
(if (want-void-check? sym module)
@ -169,9 +173,9 @@
(make-lexical-ref loc 'value var))))
(reference-variable loc sym module)))
; Generate code to set a variable.
; 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.
;;; Generate code to set a variable. 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.
(define (set-variable! loc sym module value)
(access-variable loc sym module
@ -183,8 +187,9 @@
(make-module-ref loc module sym #t)
value))))
; 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) ...).
;;; 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) ...).
(define (process-let-bindings loc bindings)
(map (lambda (b)
@ -198,11 +203,11 @@
(cons (car b) (cadr b))))))
bindings))
; Split the let bindings into a list to be done lexically and one dynamically.
; 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 value-slot binding AND
; the symbol is already lexically bound or it is always lexical.
;;; Split the let bindings into a list to be done lexically and one
;;; dynamically. 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 value-slot binding AND the symbol is already lexically
;;; bound or it is always lexical.
(define (bind-lexically? sym module)
(or (eq? module 'lexical)
@ -222,18 +227,18 @@
(iterate (cdr tail) (cons (car tail) lexical) dynamic)
(iterate (cdr tail) lexical (cons (car tail) dynamic))))))
; Compile let and let* expressions. The code here is used both for let/let*
; and flet/flet*, just with a different bindings module.
;
; A special module value 'lexical means that we're doing a lexical-let instead
; and the bindings should not be saved to globals at all but be done with the
; lexical framework instead.
;;; Compile let and let* expressions. The code here is used both for
;;; let/let* and flet/flet*, just with a different bindings module.
;;;
;;; A special module value 'lexical means that we're doing a lexical-let
;;; instead and the bindings should not be saved to globals at all but
;;; be done with the lexical framework instead.
; Let is done with a single call to let-dynamic binding them locally to new
; values all "at once". If there is at least one variable to bind lexically
; 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
; variables to bind dynamically.
;;; Let is done with a single call to let-dynamic binding them locally
;;; to new values all "at once". If there is at least one variable to
;;; bind lexically 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 variables to bind dynamically.
(define (generate-let loc module bindings body)
(let ((bind (process-let-bindings loc bindings)))
@ -269,8 +274,8 @@
dynamic-syms)
(make-body)))))))))))))
; Let* is compiled to a cascaded set of "small lets" for each binding in turn
; so that each one already sees the preceding bindings.
;;; Let* is compiled to a cascaded set of "small lets" for each binding
;;; in turn so that each one already sees the preceding bindings.
(define (generate-let* loc module bindings body)
(let ((bind (process-let-bindings loc bindings)))
@ -295,12 +300,12 @@
`(,(caar tail)) module `(,value)
(iterate (cdr tail))))))))))
; Split the argument list of a lambda expression into required, optional and
; rest arguments and also check it is actually valid.
; Additionally, we create a list of all "local variables" (that is, required,
; optional and rest arguments together) and also this one split into those to
; be bound lexically and dynamically.
; Returned is as multiple values: required optional rest lexical dynamic
;;; Split the argument list of a lambda expression into required,
;;; optional and rest arguments and also check it is actually valid.
;;; Additionally, we create a list of all "local variables" (that is,
;;; required, optional and rest arguments together) and also this one
;;; split into those to be bound lexically and dynamically. Returned is
;;; as multiple values: required optional rest lexical dynamic
(define (bind-arg-lexical? arg)
(let ((always (fluid-ref always-lexical)))
@ -362,36 +367,37 @@
(else
(error "invalid mode in split-lambda-arguments" mode)))))))))
; Compile a lambda expression. Things get a little complicated because TreeIL
; 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
; this, we have to do a little preprocessing to get everything done before the
; real body is called.
;
; (lambda (a &optional b &rest c) body) should become:
; (lambda (a_ . rest_)
; (with-fluids* (list a b c) (list a_ nil nil)
; (lambda ()
; (if (not (null? rest_))
; (begin
; (fluid-set! b (car rest_))
; (set! rest_ (cdr rest_))
; (if (not (null? rest_))
; (fluid-set! c rest_))))
; body)))
;
; This is formulated very imperatively, but I think in this case that is quite
; clear and better than creating a lot of nested let's.
;
; Another thing we have to be aware of is that lambda arguments are usually
; dynamically bound, even when a lexical binding is in tact for a symbol.
; For symbols that are marked as 'always lexical' however, we bind them here
; lexically, too -- and thus we get them out of the let-dynamic call and
; register a lexical binding for them (the lexical target variable is already
; there, namely the real lambda argument from TreeIL).
; For optional arguments that are lexically bound we need to create the lexical
; bindings though with an additional let, as those arguments are not part of the
; ordinary argument list.
;;; Compile a lambda expression. Things get a little complicated because
;;; TreeIL 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 this, we have to do a little preprocessing
;;; to get everything done before the real body is called.
;;;
;;; (lambda (a &optional b &rest c) body) should become:
;;; (lambda (a_ . rest_)
;;; (with-fluids* (list a b c) (list a_ nil nil)
;;; (lambda ()
;;; (if (not (null? rest_))
;;; (begin
;;; (fluid-set! b (car rest_))
;;; (set! rest_ (cdr rest_))
;;; (if (not (null? rest_))
;;; (fluid-set! c rest_))))
;;; body)))
;;;
;;; This is formulated very imperatively, but I think in this case that
;;; is quite clear and better than creating a lot of nested let's.
;;;
;;; Another thing we have to be aware of is that lambda arguments are
;;; usually dynamically bound, even when a lexical binding is in tact
;;; for a symbol. For symbols that are marked as 'always lexical'
;;; however, we bind them here lexically, too -- and thus we get them
;;; out of the let-dynamic call and register a lexical binding for them
;;; (the lexical target variable is already there, namely the real
;;; lambda argument from TreeIL). For optional arguments that are
;;; lexically bound we need to create the lexical bindings though with
;;; an additional let, as those arguments are not part of the ordinary
;;; argument list.
(define (compile-lambda loc args body)
(if (not (list? args))
@ -469,8 +475,8 @@
full-body)))
#f))))))))))
; Build the code to handle setting of optional arguments that are present
; and updating the rest list.
;;; Build the code to handle setting of optional arguments that are
;;; present and updating the rest list.
(define (process-optionals loc optional rest-name rest-sym)
(let iterate ((tail optional))
@ -488,7 +494,7 @@
(make-lexical-ref loc rest-name rest-sym)))
(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)
(let ((rest-empty (call-primitive loc 'null?
@ -505,9 +511,9 @@
(runtime-error loc "too many arguments and no rest argument")))
(else (make-void loc)))))
; 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
; somehow.
;;; 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 somehow.
(define (handle-var-def loc sym doc)
(cond
@ -516,10 +522,10 @@
((and (not (null? doc)) (not (string? (car doc))))
(report-error loc "expected string as third argument of defvar, got"
(car doc)))
; TODO: Handle doc string if present.
;; TODO: Handle doc string if present.
(else #t)))
; Handle macro bindings.
;;; Handle macro bindings.
(define (is-macro? sym)
(module-defined? (resolve-interface macro-slot) sym))
@ -535,7 +541,7 @@
(define (get-macro 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)
(if (pair? expr)
@ -545,11 +551,11 @@
(contains-unquotes? (cdr expr))))
#f))
; 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
; 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
; also for elisp.
;;; 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 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 also for elisp.
(define (unquote-cell? expr)
(and (list? expr) (= (length expr) 2) (unquote? (car expr))))
@ -579,9 +585,9 @@
(report-error loc "non-pair expression contains unquotes" expr))
(make-const loc expr)))
; Temporarily update a list of symbols that are handled specially (disabled
; void check or always lexical) for compiling body.
; We need to handle special cases for already all / set to all and the like.
;;; Temporarily update a list of symbols that are handled specially
;;; (disabled void check or always lexical) for compiling body. We need
;;; to handle special cases for already all / set to all and the like.
(define (with-added-symbols loc fluid syms body)
(if (null? body)
@ -600,8 +606,8 @@
(with-fluids ((fluid new))
(make-body))))))
; Compile a symbol expression. This is a variable reference or maybe some
; special value like nil.
;;; Compile a symbol expression. This is a variable reference or maybe
;;; some special value like nil.
(define (compile-symbol loc sym)
(case sym
@ -609,7 +615,7 @@
((t) (t-value loc))
(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)
(pmatch expr
@ -631,8 +637,9 @@
(compile-expr ifclause)
(make-sequence loc (map compile-expr elses))))
; defconst and defvar are kept here in the compiler (rather than doing them
; as macros) for if we may want to handle the docstring somehow.
;; defconst and defvar are kept here in the compiler (rather than
;; doing them as macros) for if we may want to handle the docstring
;; somehow.
((defconst ,sym ,value . ,doc)
(if (handle-var-def loc sym doc)
@ -654,9 +661,9 @@
(make-void loc))
(make-const loc sym)))))
; 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
; expression pairs are very unlikely.
;; 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 expression pairs are very unlikely.
((setq . ,args) (guard (not (null? args)))
(make-sequence loc
@ -679,8 +686,8 @@
(cons (set-variable! loc sym value-slot val)
(iterate (cdr tailtail)))))))))))
; All lets (let, flet, lexical-let and let* forms) are done using the
; generate-let/generate-let* methods.
;; All lets (let, flet, lexical-let and let* forms) are done using
;; the generate-let/generate-let* methods.
((let ,bindings . ,body) (guard (and (list? bindings)
(not (null? bindings))
@ -712,8 +719,8 @@
(not (null? body))))
(generate-let* loc function-slot bindings body))
; Temporarily disable void checks or set symbols as always lexical only
; for the lexical scope of a construct.
;; Temporarily disable void checks or set symbols as always lexical
;; only for the lexical scope of a construct.
((without-void-checks ,syms . ,body)
(with-added-symbols loc disable-void-check syms body))
@ -721,30 +728,32 @@
((with-always-lexical ,syms . ,body)
(with-added-symbols loc always-lexical syms body))
; guile-ref allows building TreeIL's module references from within
; elisp as a way to access data within
; the Guile universe. The module and symbol referenced are static values,
; just like (@ module symbol) does!
;; guile-ref allows building TreeIL's module references from within
;; elisp as a way to access data within the Guile universe. The
;; module and symbol referenced are static values, just like (@
;; module symbol) does!
((guile-ref ,module ,sym) (guard (and (list? module) (symbol? sym)))
(make-module-ref loc module sym #t))
; guile-primitive allows to create primitive references, which are still
; a little faster.
;; guile-primitive allows to create primitive references, which are
;; still a little faster.
((guile-primitive ,sym) (guard (symbol? sym))
(make-primitive-ref loc sym))
; A while construct is transformed into a tail-recursive loop like this:
; (letrec ((iterate (lambda ()
; (if condition
; (begin body
; (iterate))
; #nil))))
; (iterate))
;
; As letrec is not directly accessible from elisp, while is implemented here
; instead of with a macro.
;; A while construct is transformed into a tail-recursive loop like
;; this:
;;
;; (letrec ((iterate (lambda ()
;; (if condition
;; (begin body
;; (iterate))
;; #nil))))
;; (iterate))
;;
;; As letrec is not directly accessible from elisp, while is
;; implemented here instead of with a macro.
((while ,condition . ,body)
(let* ((itersym (gensym))
@ -764,8 +773,8 @@
(make-letrec loc #f '(iterate) (list itersym) (list iter-thunk)
iter-call)))
; Either (lambda ...) or (function (lambda ...)) denotes a lambda-expression
; that should be compiled.
;; Either (lambda ...) or (function (lambda ...)) denotes a
;; lambda-expression that should be compiled.
((lambda ,args . ,body)
(compile-lambda loc args body))
@ -773,9 +782,9 @@
((function (lambda ,args . ,body))
(compile-lambda loc args body))
; 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;
; just as with defvar/defconst.
;; 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; just as with defvar/defconst.
((defun ,name ,args . ,body)
(if (not (symbol? name))
@ -785,8 +794,8 @@
(compile-lambda loc args body))
(make-const loc name)))))
; Define a macro (this is done directly at compile-time!).
; FIXME: Recursive macros don't work!
;; Define a macro (this is done directly at compile-time!). FIXME:
;; Recursive macros don't work!
((defmacro ,name ,args . ,body)
(if (not (symbol? name))
@ -797,26 +806,26 @@
(define-macro! loc name object)
(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))
(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)
(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)))
(let ((expander (get-macro macro)))
(compile-expr (apply expander args))))
; Function calls using (function args) standard notation; here, we have to
; 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
; have to care for them.
;; Function calls using (function args) standard notation; here, we
;; have to 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 have to care for them.
((,func . ,args)
(make-application loc
@ -828,7 +837,7 @@
(else
(report-error loc "unrecognized elisp" expr))))
; Compile a single expression to TreeIL.
;;; Compile a single expression to TreeIL.
(define (compile-expr expr)
(let ((loc (location expr)))
@ -839,8 +848,8 @@
(compile-pair loc expr))
(else (make-const loc expr)))))
; Process the compiler options.
; FIXME: Why is '(()) passed as options by the REPL?
;;; Process the compiler options. FIXME: Why is '(()) passed as options
;;; by the REPL?
(define (valid-symbol-list-arg? value)
(or (eq? value 'all)
@ -864,10 +873,10 @@
(report-error #f "Invalid value for #:always-lexical" value)))
(else (report-error #f "Invalid compiler option" key)))))))
; Entry point for compilation to TreeIL.
; This creates the bindings data structure, and after compiling the main
; expression we need to make sure all globals for symbols used during the
; compilation are created using the generate-ensure-global function.
;;; Entry point for compilation to TreeIL. This creates the bindings
;;; data structure, and after compiling the main expression we need to
;;; make sure all globals for symbols used during the compilation are
;;; created using the generate-ensure-global function.
(define (compile-tree-il expr env opts)
(values

206
module/language/elisp/lexer.scm
View file

@ -2,19 +2,20 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -22,49 +23,51 @@
#:use-module (ice-9 regex)
#:export (get-lexer get-lexer/1))
; This is the lexical analyzer for the elisp reader. It is hand-written
; instead of using some generator. I think this is the best solution
; because of all that fancy escape sequence handling and the like.
;;; This is the lexical analyzer for the elisp reader. It is
;;; hand-written instead of using some generator. I think this is the
;;; best solution because of all that fancy escape sequence handling and
;;; the like.
;;;
;;; Characters are handled internally as integers representing their
;;; code value. This is necessary because elisp allows a lot of fancy
;;; modifiers that set certain high-range bits and the resulting values
;;; would not fit into a real Scheme character range. Additionally,
;;; elisp wants characters as integers, so we just do the right thing...
;;;
;;; TODO: #@count comments
; Characters are handled internally as integers representing their
; code value. This is necessary because elisp allows a lot of fancy modifiers
; that set certain high-range bits and the resulting values would not fit
; into a real Scheme character range. Additionally, elisp wants characters
; as integers, so we just do the right thing...
; 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)
(apply error msg args))
; 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.
;;; 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.
(define (set-char-bit chr bit)
(logior chr (ash 1 bit)))
; 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.
;;; 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.
(define (is-char? tested should-be)
(and (not (eof-object? tested))
(char=? tested should-be)))
; 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
; like char-numeric?.
;;; 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 like char-numeric?.
(define (real-character chr)
(if (< chr 256)
(integer->char chr)
#\nul))
; 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
; in elisp C-? is the delete character for historical reasons.
; Otherwise, we set bit 26.
;;; 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 in elisp C-? is the delete character for
;;; historical reasons. Otherwise, we set bit 26.
(define (add-control chr)
(let ((real (real-character chr)))
@ -75,12 +78,12 @@
((#\@) 0)
(else (set-char-bit chr 26))))))
; 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
; not matter and arbitrary many are allowed), and additionally early
; return allowed (if fewer valid digits are found).
; These options are all we need to handle the \u, \U, \x and \ddd (octal digits)
; escape sequences.
;;; 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 not matter and arbitrary many are allowed), and additionally
;;; early return allowed (if fewer valid digits are found). These
;;; options are all we need to handle the \u, \U, \x and \ddd (octal
;;; digits) escape sequences.
(define (charcode-escape port base digits early-return)
(let iterate ((result 0)
@ -107,10 +110,11 @@
(lexer-error port "invalid digit in escape-code" base cur))
(iterate (+ (* result base) value) (1+ procdigs)))))))
; 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
; a single character literal, the difference being that in strings the
; meta modifier sets bit 7, while it is bit 27 for characters.
;;; 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 a single character literal, the difference being
;;; that in strings the meta modifier sets bit 7, while it is bit 27 for
;;; characters.
(define basic-escape-codes
'((#\a . 7) (#\b . 8) (#\t . 9)
@ -122,27 +126,27 @@
(#\S . 25) (#\M . ,(if in-string 7 27))))
(cur (read-char port)))
(if (char=? cur #\\)
; Handle an escape-sequence.
;; Handle an escape-sequence.
(let* ((escaped (read-char port))
(esc-code (assq-ref basic-escape-codes escaped))
(meta (assq-ref meta-bits escaped)))
(cond
; Meta-check must be before esc-code check because \s- must be
; recognized as the super-meta modifier if a - follows.
; If not, it will be caught as \s -> space escape code.
;; Meta-check must be before esc-code check because \s- must
;; be recognized as the super-meta modifier if a - follows. If
;; not, it will be caught as \s -> space escape code.
((and meta (is-char? (peek-char port) #\-))
(if (not (char=? (read-char port) #\-))
(error "expected - after control sequence"))
(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)
; Handle \ddd octal code if it is one.
;; Handle \ddd octal code if it is one.
((and (char>=? escaped #\0) (char<? escaped #\8))
(begin
(unread-char escaped port)
(charcode-escape port 8 3 #t)))
; Check for some escape-codes directly or otherwise
; use the escaped character literally.
;; Check for some escape-codes directly or otherwise use the
;; escaped character literally.
(else
(case escaped
((#\^) (add-control (get-character port in-string)))
@ -157,25 +161,26 @@
((#\u) (charcode-escape port 16 4 #f))
((#\U) (charcode-escape port 16 8 #f))
(else (char->integer escaped))))))
; No escape-sequence, just the literal character.
; But remember to get the code instead!
;; No escape-sequence, just the literal character. But remember to
;; get the code instead!
(char->integer cur))))
; 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
; returned as a string for further conversion to the correct type, but we also
; return what this is (integer/float/symbol).
; If any escaped character is found, it must be a symbol. Otherwise we
; at the end check the result-string against regular expressions to determine
; if it is possibly an integer or a float.
;;; 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 returned as a string for further conversion to the
;;; correct type, but we also return what this is
;;; (integer/float/symbol). If any escaped character is found, it must
;;; be a symbol. Otherwise we at the end check the result-string against
;;; regular expressions to determine if it is possibly an integer or a
;;; float.
(define integer-regex (make-regexp "^[+-]?[0-9]+\\.?$"))
(define float-regex
(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
; 'dot' terminal for dotted lists.
;;; A dot is also allowed literally, only a single dort alone is parsed
;;; as the 'dot' terminal for dotted lists.
(define no-escape-punctuation (string->char-set "-+=*/_~!@$%^&:<>{}?."))
@ -208,9 +213,9 @@
(unread-char c port)
(finish))))))
; Parse a circular structure marker without the leading # (which was already
; read and recognized), that is, a number as identifier and then either
; = or #.
;;; Parse a circular structure marker without the leading # (which was
;;; already read and recognized), that is, a number as identifier and
;;; then either = or #.
(define (get-circular-marker port)
(call-with-values
@ -227,7 +232,8 @@
((#\=) `(circular-def . ,id))
(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.
(define (lex port)
(let ((return (let ((file (if (file-port? port) (port-filename port) #f))
@ -239,36 +245,37 @@
(set-source-property! obj 'line line)
(set-source-property! obj 'column column)
obj))))
; Read afterwards so the source-properties are correct above
; and actually point to the very character to be read.
;; Read afterwards so the source-properties are correct above
;; and actually point to the very character to be read.
(c (read-char port)))
(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*)
; Whitespace, just skip it.
;; Whitespace, just skip it.
((char-whitespace? c) (lex port))
; The dot is only the one for dotted lists if followed by
; whitespace. Otherwise it is considered part of a number of symbol.
;; The dot is only the one for dotted lists if followed by
;; whitespace. Otherwise it is considered part of a number of
;; symbol.
((and (char=? c #\.)
(char-whitespace? (peek-char port)))
(return 'dot #f))
; Continue checking for literal character values.
;; Continue checking for literal character values.
(else
(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 ((cur (read-char port)))
(if (or (eof-object? cur) (char=? cur #\newline))
(lex port)
(iterate)))))
; A character literal.
;; A character literal.
((#\?)
(return 'character (get-character port #f)))
; A literal string. This is mainly a sequence of characters just
; as in the character literals, the only difference is that escaped
; newline and space are to be completely ignored and that meta-escapes
; set bit 7 rather than bit 27.
;; A literal string. This is mainly a sequence of characters
;; just as in the character literals, the only difference is
;; that escaped newline and space are to be completely ignored
;; and that meta-escapes set bit 7 rather than bit 27.
((#\")
(let iterate ((result-chars '()))
(let ((cur (read-char port)))
@ -286,27 +293,27 @@
(iterate (cons (integer->char (get-character port #t))
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)))
(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-close #f))
((#\[) (return 'square-open #f))
((#\]) (return 'square-close #f))
((#\') (return 'quote #f))
((#\`) (return 'backquote #f))
; Unquote and unquote-splicing.
;; Unquote and unquote-splicing.
((#\,)
(if (is-char? (peek-char port) #\@)
(if (not (char=? (read-char port) #\@))
(error "expected @ in unquote-splicing")
(return 'unquote-splicing #f))
(return 'unquote #f)))
; Remaining are numbers and symbols. Process input until next
; whitespace is found, and see if it looks like a number
; (float/integer) or symbol and return accordingly.
;; Remaining are numbers and symbols. Process input until next
;; whitespace is found, and see if it looks like a number
;; (float/integer) or symbol and return accordingly.
(else
(unread-char c port)
(call-with-values
@ -315,23 +322,23 @@
(lambda (type str)
(case type
((symbol)
; str could be empty if the first character is already
; something not allowed in a symbol (and not escaped)!
; Take care about that, it is an error because that character
; should have been handled elsewhere or is invalid in the
; input.
;; str could be empty if the first character is
;; already something not allowed in a symbol (and not
;; escaped)! Take care about that, it is an error
;; because that character should have been handled
;; elsewhere or is invalid in the input.
(if (zero? (string-length str))
(begin
; Take it out so the REPL might not get into an
; infinite loop with further reading attempts.
;; Take it out so the REPL might not get into an
;; infinite loop with further reading attempts.
(read-char port)
(error "invalid character in input" c))
(return 'symbol (string->symbol str))))
((integer)
; In elisp, something like "1." is an integer, while
; string->number returns an inexact real. Thus we
; need a conversion here, but it should always result in
; an integer!
;; In elisp, something like "1." is an integer, while
;; string->number returns an inexact real. Thus we
;; need a conversion here, but it should always
;; result in an integer!
(return 'integer
(let ((num (inexact->exact (string->number str))))
(if (not (integer? num))
@ -344,17 +351,16 @@
num)))
(else (error "wrong number/symbol type" type)))))))))))
; 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.
;;; 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.
(define (get-lexer port)
(lambda ()
(lex port)))
; Build a special lexer that will only read enough for one expression and then
; always return end-of-input.
; If we find one of the quotation stuff, one more expression is needed in any
; case.
;;; Build a special lexer that will only read enough for one expression
;;; and then always return end-of-input. If we find one of the quotation
;;; stuff, one more expression is needed in any case.
(define (get-lexer/1 port)
(let ((lex (get-lexer port))

108
module/language/elisp/parser.scm
View file

@ -2,19 +2,20 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -22,28 +23,28 @@
#:use-module (language elisp lexer)
#:export (read-elisp))
; The parser (reader) for elisp expressions.
; Is is hand-written (just as the lexer is) instead of using some parser
; generator because this allows easier transfer of source properties from the
; lexer ((text parse-lalr) seems not to allow access to the original lexer
; token-pair) and is easy enough anyways.
;;; The parser (reader) for elisp expressions. Is is hand-written (just
;;; as the lexer is) instead of using some parser generator because this
;;; allows easier transfer of source properties from the lexer ((text
;;; parse-lalr) seems not to allow access to the original lexer
;;; token-pair) and is easy enough anyways.
; Report a parse error. The first argument is some current lexer token
; where source information is available should it be useful.
;;; Report a parse error. The first argument is some current lexer token
;;; where source information is available should it be useful.
(define (parse-error token msg . args)
(apply error msg args))
; For parsing circular structures, we keep track of definitions in a
; hash-map that maps the id's to their values.
; When defining a new id, though, we immediatly fill the slot with a promise
; before parsing and setting the real value, because it must already be
; available at that time in case of a circular reference. The promise refers
; to a local variable that will be set when the real value is available through
; a closure. After parsing the expression is completed, we work through it
; again and force all promises we find.
; The definitions themselves are stored in a fluid and their scope is one
; call to read-elisp (but not only the currently parsed expression!).
;;; For parsing circular structures, we keep track of definitions in a
;;; hash-map that maps the id's to their values. When defining a new id,
;;; though, we immediatly fill the slot with a promise before parsing
;;; and setting the real value, because it must already be available at
;;; that time in case of a circular reference. The promise refers to a
;;; local variable that will be set when the real value is available
;;; through a closure. After parsing the expression is completed, we
;;; work through it again and force all promises we find. The
;;; definitions themselves are stored in a fluid and their scope is one
;;; call to read-elisp (but not only the currently parsed expression!).
(define circular-definitions (make-fluid))
@ -59,9 +60,9 @@
value
(parse-error token "undefined circular reference" id))))
; 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
; slot so we don't generate promises any longer.
;;; 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 slot so we don't generate promises any longer.
(define (circular-define! token)
(if (not (eq? (car token) 'circular-def))
@ -74,11 +75,12 @@
(set! value real-value)
(hashq-set! table id real-value))))
; Work through a parsed data structure and force the promises there.
; After a promise is forced, the resulting value must not be recursed on;
; this may lead to infinite recursion with a circular structure, and
; additionally this value was already processed when it was defined.
; All deep data structures that can be parsed must be handled here!
;;; Work through a parsed data structure and force the promises there.
;;; After a promise is forced, the resulting value must not be recursed
;;; on; this may lead to infinite recursion with a circular structure,
;;; and additionally this value was already processed when it was
;;; defined. All deep data structures that can be parsed must be handled
;;; here!
(define (force-promises! data)
(cond
@ -99,15 +101,15 @@
(vector-set! data i (force el))
(force-promises! el))
(iterate (1+ i)))))))
; 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
; single token look-ahead storage. This is handled by a closure which allows
; getting or peeking the next token.
; When one expression is fully parsed, we don't want a look-ahead stored here
; because it would miss from future parsing. This is verified by the finish
; action.
;;; 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 getting or peeking the next token. When one
;;; expression is fully parsed, we don't want a look-ahead stored here
;;; because it would miss from future parsing. This is verified by the
;;; finish action.
(define (make-lexer-buffer lex)
(let ((look-ahead #f))
@ -127,12 +129,12 @@
result))
(else (error "invalid lexer-buffer action" action))))))))
; 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
; dotted tail syntax and vectors not; additionally, the closing parenthesis
; must of course match.
; The implementation here is not tail-recursive, but I think it is clearer
; and simpler this way.
;;; 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 dotted tail syntax and vectors not;
;;; additionally, the closing parenthesis must of course match. The
;;; implementation here is not tail-recursive, but I think it is clearer
;;; and simpler this way.
(define (get-list lex allow-dot close-square)
(let* ((next (lex 'peek))
@ -152,13 +154,13 @@
(parse-error next "expected exactly one element after dot"))
(car tail))))
(else
; Do both parses in exactly this sequence!
;; Do both parses in exactly this sequence!
(let* ((head (get-expression lex))
(tail (get-list lex allow-dot close-square)))
(cons head tail))))))
; Parse a single expression from a lexer-buffer. This is the main routine in
; our recursive-descent parser.
;;; Parse a single expression from a lexer-buffer. This is the main
;;; routine in our recursive-descent parser.
(define quotation-symbols '((quote . quote)
(backquote . \`)
@ -184,7 +186,7 @@
((circular-ref)
(circular-ref token))
((circular-def)
; The order of definitions is important!
;; The order of definitions is important!
(let* ((setter (circular-define! token))
(expr (get-expression lex)))
(setter expr)
@ -193,9 +195,9 @@
(else
(parse-error token "expected expression, got" token)))))
; Define the reader function based on this; build a lexer, a lexer-buffer,
; and then parse a single expression to return.
; We also define a circular-definitions data structure to use.
;;; Define the reader function based on this; build a lexer, a
;;; lexer-buffer, and then parse a single expression to return. We also
;;; define a circular-definitions data structure to use.
(define (read-elisp port)
(with-fluids ((circular-definitions (make-circular-definitions)))

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

@ -2,19 +2,20 @@
;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -28,45 +29,45 @@
runtime-error macro-error)
#: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))
; Values for t and nil. (FIXME remove this abstraction)
;;; Values for t and nil. (FIXME remove this abstraction)
(define nil-value #nil)
(define t-value #t)
; Modules for the binding slots.
; Note: Naming those value-slot and/or function-slot clashes with the
; submodules of these names!
;;; Modules for the binding slots. Note: Naming those value-slot and/or
;;; function-slot clashes with the submodules of these names!
(define value-slot-module '(language elisp runtime value-slot))
(define function-slot-module '(language elisp runtime function-slot))
; Report an error during macro compilation, that means some special compilation
; (syntax) error; or report a simple runtime-error from a built-in function.
;;; Report an error during macro compilation, that means some special
;;; compilation (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.
;;; Convert a scheme boolean to Elisp.
(define (elisp-bool b)
(if b
t-value
nil-value))
; Routines for access to elisp dynamically bound symbols.
; This is used for runtime access using functions like symbol-value or set,
; where the symbol accessed might not be known at compile-time.
; These always access the dynamic binding and can not be used for the lexical!
;;; Routines for access to elisp dynamically bound symbols. This is used
;;; for runtime access using functions like symbol-value or set, where
;;; the symbol accessed might not be known at compile-time. These always
;;; access the dynamic binding and can not be used for the lexical!
(define (ensure-fluid! module sym)
(let ((intf (resolve-interface module))
@ -94,8 +95,8 @@
(fluid-set! (module-ref resolved sym) value)
value))
; Define a predefined function or predefined macro for use in the function-slot
; and macro-slot modules, respectively.
;;; Define a predefined function or predefined macro for use in the
;;; function-slot and macro-slot modules, respectively.
(define-syntax built-in-func
(syntax-rules ()
@ -109,8 +110,8 @@
((_ name value)
(define-public name value))))
; Call a guile-primitive that may be rebound for elisp and thus needs absolute
; addressing.
;;; Call a guile-primitive that may be rebound for elisp and thus needs
;;; absolute addressing.
(define-syntax prim
(syntax-rules ()

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

@ -2,19 +2,20 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
@ -22,10 +23,11 @@
#:use-module (language elisp runtime)
#:use-module (system base compile))
; This module contains the function-slots of elisp symbols. Elisp built-in
; functions are implemented as predefined function bindings here.
;;; This module contains the function-slots of elisp symbols. Elisp
;;; built-in functions are implemented as predefined function bindings
;;; here.
; Equivalence and equalness predicates.
;;; Equivalence and equalness predicates.
(built-in-func eq (lambda (a b)
(elisp-bool (eq? a b))))
@ -33,7 +35,7 @@
(built-in-func equal (lambda (a b)
(elisp-bool (equal? a b))))
; Number predicates.
;;; Number predicates.
(built-in-func floatp (lambda (num)
(elisp-bool (and (real? num)
@ -55,7 +57,7 @@
(built-in-func zerop (lambda (num)
(elisp-bool (prim = num 0))))
; Number comparisons.
;;; Number comparisons.
(built-in-func = (lambda (num1 num2)
(elisp-bool (prim = num1 num2))))
@ -83,16 +85,16 @@
(built-in-func abs (@ (guile) abs))
; Number conversion.
;;; Number conversion.
(built-in-func float (lambda (num)
(if (exact? num)
(exact->inexact num)
num)))
; TODO: truncate, floor, ceiling, round.
;;; TODO: truncate, floor, ceiling, round.
; Arithmetic functions.
;;; Arithmetic functions.
(built-in-func 1+ (@ (guile) 1+))
@ -106,9 +108,10 @@
(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))
@ -118,7 +121,7 @@
(built-in-func fround (@ (guile) round))
; List predicates.
;;; List predicates.
(built-in-func consp
(lambda (el)
@ -141,7 +144,7 @@
(lambda (el)
(elisp-bool (null? el))))
; Accessing list elements.
;;; Accessing list elements.
(built-in-func car
(lambda (el)
@ -191,7 +194,7 @@
(built-in-func length (@ (guile) length))
; Building lists.
;;; Building lists.
(built-in-func cons (@ (guile) cons))
@ -236,7 +239,7 @@
(prim cons i result)
(iterate (prim - i sep) (prim cons i result)))))))))))
; Changing lists.
;;; Changing lists.
(built-in-func setcar
(lambda (cell val)
@ -248,7 +251,7 @@
(prim set-cdr! cell 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
(lambda (sym)
@ -286,8 +289,8 @@
(elisp-bool (prim not
(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!
;;; Function calls. These must take care of special cases, like using
;;; symbols or raw lambda-lists as functions!
(built-in-func apply
(lambda (func . args)
@ -308,13 +311,13 @@
(lambda (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
(lambda (tag value)
(prim throw 'elisp-exception tag value)))
; Miscellaneous.
;;; Miscellaneous.
(built-in-func not
(lambda (x)

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

@ -2,32 +2,34 @@
;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
(define-module (language elisp runtime macro-slot)
#:use-module (language elisp runtime))
; This module contains the macro definitions of elisp symbols. In contrast to
; the other runtime modules, those are used directly during compilation, of
; course, so not really in runtime. But I think it fits well to the others
; here.
;;; This module contains the macro definitions of elisp symbols. In
;;; contrast to the other runtime modules, those are used directly
;;; during compilation, of course, so not really in runtime. But I think
;;; it fits well to the others here.
; 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.
;;; 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.
(built-in-macro prog1
(lambda (form1 . rest)
@ -41,7 +43,7 @@
(lambda (form1 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
(lambda (condition . thens)
@ -51,9 +53,10 @@
(lambda (condition . elses)
`(if ,condition nil (progn ,@elses))))
; 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
; and thus save it in a local variable before testing it.
;;; 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 and thus save it in a local variable before
;;; testing it.
(built-in-macro cond
(lambda (. clauses)
@ -77,7 +80,7 @@
(progn ,@(cdr cur))
,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
(case-lambda
@ -107,7 +110,7 @@
,var
,(iterate (car tail) (cdr tail)))))))))))
; Define the dotimes and dolist iteration macros.
;;; Define the dotimes and dolist iteration macros.
(built-in-macro dotimes
(lambda (args . body)
@ -150,15 +153,15 @@
(list (caddr args))
'())))))))))
; Exception handling. unwind-protect and catch are implemented as macros (throw
; is a built-in function).
;;; Exception handling. unwind-protect and catch are implemented as
;;; macros (throw is a built-in function).
; catch and throw can mainly be implemented directly using Guile's
; primitives for exceptions, the only difficulty is that the keys used
; within Guile must be symbols, while elisp allows any value and checks
; 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
; the elisp keys are not eq?, we rethrow the exception.
;;; catch and throw can mainly be implemented directly using Guile's
;;; primitives for exceptions, the only difficulty is that the keys used
;;; within Guile must be symbols, while elisp allows any value and
;;; checks 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 the elisp keys are not eq?, we rethrow the exception.
(built-in-macro catch
(lambda (tag . body)
@ -180,8 +183,8 @@
((guile-primitive throw) ,dummy-key ,elisp-key
,value))))))))))
; unwind-protect is just some weaker construct as dynamic-wind, so
; straight-forward to implement.
;;; unwind-protect is just some weaker construct as dynamic-wind, so
;;; straight-forward to implement.
(built-in-macro unwind-protect
(lambda (body . clean-ups)
@ -192,7 +195,7 @@
(lambda () ,body)
(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
(lambda (list-name)

19
module/language/elisp/runtime/value-slot.scm
View file

@ -2,22 +2,23 @@
;;; Copyright (C) 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;; This library is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; This library is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this library; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;;; 02110-1301 USA
;;; Code:
(define-module (language elisp runtime value-slot))
; This module contains the value-slots of elisp symbols.
;;; This module contains the value-slots of elisp symbols.