diff --git a/module/language/elisp/bindings.scm b/module/language/elisp/bindings.scm index 7ac3b4c56..f75ec082c 100644 --- a/module/language/elisp/bindings.scm +++ b/module/language/elisp/bindings.scm @@ -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)) diff --git a/module/language/elisp/compile-tree-il.scm b/module/language/elisp/compile-tree-il.scm index 173123292..8b23805d5 100644 --- a/module/language/elisp/compile-tree-il.scm +++ b/module/language/elisp/compile-tree-il.scm @@ -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 diff --git a/module/language/elisp/lexer.scm b/module/language/elisp/lexer.scm index 959acff98..6ed32d925 100644 --- a/module/language/elisp/lexer.scm +++ b/module/language/elisp/lexer.scm @@ -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) (charinteger 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)) diff --git a/module/language/elisp/parser.scm b/module/language/elisp/parser.scm index dee683895..c82d56e51 100644 --- a/module/language/elisp/parser.scm +++ b/module/language/elisp/parser.scm @@ -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))) diff --git a/module/language/elisp/runtime.scm b/module/language/elisp/runtime.scm index 3a041568b..bddfa82e4 100644 --- a/module/language/elisp/runtime.scm +++ b/module/language/elisp/runtime.scm @@ -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 () diff --git a/module/language/elisp/runtime/function-slot.scm b/module/language/elisp/runtime/function-slot.scm index f794caa59..33f74be47 100644 --- a/module/language/elisp/runtime/function-slot.scm +++ b/module/language/elisp/runtime/function-slot.scm @@ -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) diff --git a/module/language/elisp/runtime/macro-slot.scm b/module/language/elisp/runtime/macro-slot.scm index 0a55b7896..c88bfa47f 100644 --- a/module/language/elisp/runtime/macro-slot.scm +++ b/module/language/elisp/runtime/macro-slot.scm @@ -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) diff --git a/module/language/elisp/runtime/value-slot.scm b/module/language/elisp/runtime/value-slot.scm index 056b12289..438c33575 100644 --- a/module/language/elisp/runtime/value-slot.scm +++ b/module/language/elisp/runtime/value-slot.scm @@ -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.