diff --git a/README.quasiquote b/README.quasiquote new file mode 100644 index 0000000000000000000000000000000000000000..c3d8b29c9ba551e9362054bf11d8d4bf9428e1a1 --- /dev/null +++ b/README.quasiquote @@ -0,0 +1,196 @@ +fare-matcher friendly implementation of Quasiquote +Copyright (c) 2002-2010 Fahree Reedaw + + +PURPOSE + +The main purpose of this n+2nd reimplementation of quasiquote, +is enable matching of quasiquoted patterns with fare-matcher. + +Now, developing this implementation is also a challenge in understanding +the ins and outs of quasiquotation, and in exploring the way it interacts +with extended support for constant-building syntactic constructs. +And this, at least to me is as much fun as it is an intellectual challenge. :-) + + +INTERACTION WITH FARE-MATCHER + +This implementation of quasiquote requires the FARE-MATCHER system. + +It enables quasiquotation inside FARE-MATCHER patterns. +However, as a limitation to such use, note that as long as +the pattern-matcher isn't extended to match APPEND patterns, +which typically requires backtracking, then those quasiquote templates +that expand into something using APPEND can't be used as patterns to match. +This mostly restricts the use of ,@ or ,. to the end of a list. + +This implementation also uses FARE-MATCHER internally, +which allows to tremendously simplify the simplifier +used to normalize quasiquote-using expressions. +This simplifier in turn is necessary to simplify APPEND patterns +into CONS LIST* and LIST patterns for use with FARE-MATCHER. + + +REFERENCES + +Essential documents consulted while implementing this file: +Alan Bawden's paper: http://www.bawden.org/ftp/pepm99.ps.gz +CLtL2: http://www.supelec.fr/docs/cltl/clm/node367.html +CLHS: http://www.lisp.org/HyperSpec/Body/sec_2-4-6.html +Slate reference manual section 2.6.2 on quoting and unquoting: + http://slate.tunes.org/doc/progman/node12.html#SECTION00046200000000000000 +Common Lisp backquote implementation, written in Common Lisp. (public domain) + Author: Guy L. Steele Jr. Date: 27 December 1985 + To be used with patch by Alex Plotnick 2010 regarding the simplification pass. +SBCL backquote implementation (derived from CMUCL). + + +NOTES + +* We provide for a read-time quasiquote expander as well as + a macro-expansion-time quasiquote expander. + The read-time expander handles #() syntax correctly + but mightn't be as efficient as the built-in reader in the common case, + whereas the macro-expansion-time sees #() too late (see BUGS). + To use the macro-expansion-time one, uncomment the line that declares + feature :quasiquote-at-macro-expansion-time. + + +TO DO + +* The CLHS doesn't tell anything about multi-dimensional arrays; + however, this is the opportunity to define a MUP: Meta Unquote Protocol. + The MUP would allow to extend the quasiquote mechanism with support + for new constant-building syntactic constructs as such constructs are defined. + Maybe we will end up with a full-fledge declarative infrastructure + for a Parser-Preprocessor-Pretty-Printer, like camlp4 only more declarative. + +* Can we improve performance? + Statically compile and optimize the patterns for the simplifier? + +* Implement the MUP with an abstract API for new readers; + as examples, provide readers for existing syntax that can be toggled + as either unquote-aware or not: #(), #A, etc. + +* Implement tagged (and multiple-valued?) quasiquotes, unquotes and quotes. + + +BUGS: + +* It looks like there are nasty bugs in the simplifier. + Maybe start again afresh with a MUP for CONS? + We should start from the known-working algorithm described in CLtL2, + that keeps the data in simplified form at all time incrementally, + instead of trying a global simplification after-the-fact. + +* This version works inside simple vectors, so as to support + unquoting inside the #(...) syntax as the standard mandates. + However, doing that at macro-expansion time means that we disturb + any SIMPLE-VECTOR that appears in the source code, even if it comes + from forms other than #(...), such as #1A(...) or #.(VECTOR ...). + This phenomenon has been documented before in the following message: + http://groups.google.com/groups?q=author:kaz%40ashi.footprints.net&hl=en&lr=&ie=UTF-8&oe=UTF-8&safe=off&selm=cf333042.0303141409.bbf02e9%40posting.google.com&rnum=4 + +* Interestingly, I haven't seen the following problem stated, to know which is + correct of `#2(1 ,@'(2 3)) or `#3(1 ,@'(2 3)). In other words, does the read + argument to #() mean something at read-time or at vector-creation-time? + Of course, in the original intended usage, outside of any quasiquoting, + read-time and vector-creation-time are one and the same. + But what when quasiquote breaks up that identity? + +* Note that we do not handle unquoting inside structures + or arrays more complex than simple vectors. + +* Note that in the case of the macro-expansion-time expander, + we do not check for lone unquote syntax before macro expansion, + which may lead this implementation to accept hacks + that are not valid according to the standard, such as + macros that produce unbalanced unquote syntax markers. + +* Certainly, the implementation of quasiquote should be "opened" + so as to allow new syntactic features to take advantage of it. + Then, maybe we can redefine our own proper reader behaviour for #(...) + and each MUP-supporting piece of syntax, on top of the MUP? + + Note that copying and modifying read-tables is expensive, that dynamically + modifying and restoring read-tables might interfere with #. syntax, and that + caching modified read-tables will interfere with any subsequent modification + of a cached read-table, comparison not being possible. + This means that if we wanted the MUP to adapt to existing extensions + without modifying existing code, we would have to intercept the definition + of syntax reading functions before they are fed to either SET-MACRO-CHARACTER + or SET-DISPATCH-MACRO-CHARACTER. Spooky. + Now, this also requires that the current depth of quasiquoting be consulted + any time any of the MUP-enabled constructors is read. + +* The principle of the MUP is that + = structure readers that don't want to support unquote MUST be wrapped into + something that dynamically binds *quasiquote-level* to 0. + = structure readers #C(ARGSYNTAX) that do want to support unquote + MUST accumulate formal arguments to a structure constructor + into a list ARGUMENTS, then, if *quasiquote-level* is 0, behave like + #.(apply `#CONSTRUCTOR `#ARGUMENTS) + otherwise, behave like + ,(apply `#CONSTRUCTOR `#ARGUMENTS) + where #CONSTRUCTOR is the name of the constructor for given structure, + and #ARGUMENTS is whichever arguments have been deduced from the syntax, + which may include as many levels of unquotations as *quasiquote-level* says. + Note that in a strong sense, "#." is like "," assuming an infinite tower of + read-time evaluators a la 3-LISP. + +* Note that the above is obscured because we're trying to discuss + the behaviour of quasiquote-containing programs without having + a meta-level quasiquoting facility that could distinguish + between what is constant or variable at the meta-level independently from + what is constant or variable at the base level: + #CONSTRUCTOR and #ARGUMENTS would be better specified + through a special meta-level unquotation, the above expressions + being in a corresponding special quasiquotation. + A feature that would allow for clear separation of levels of meta-language + would be a tagged quasiquote feature, as in Slate (http://slate-language.org/). + +* This version is not safe with respect to quasiquoting expressions + where appear some marker symbols interned in the FARE-QUASIQUOTE package -- + such expressions may lead to confusion between the body of expressions + being quasiquoted and the internal quasiquote infrastructure. + Any objects used as markers instead of these interned symbols + would lead to the same "bug" if somehow used inside quasiquoted expressions; + but at least, non-interned symbols or gensyms would allow to avoid this bug + in expressions being READ. The "perfect" solution would be to use + objects GENSYMed at the moment a given QUASIQUOTE is read, + and kept in a lexical variable to prevent introspective cheat by #. syntax. + Then, after simplifying expressions, we could pass the read expression + through functions that would SUBSTitute proper symbols for the markers, + from the quasiquote package if pretty-printing is to be supported, + or otherwise from the CL package. + Note that this would have to be interleaved with support for working + inside vectors and other syntax. This is all very tricky + and until further notice is left as an exercise to the intrepid reader. + Thus, while the behaviour of our implementation isn't strictly correct, + we don't go through the hassle of modifying it into something + much less readable just for the sake of preventing code that would + deliberately confuse the quasiquote engine. + Now, if we imagine that some code were dynamically generated + based on system introspection, that could contain some of our magic markers, + then this code would have to be made safe for interaction with QUASIQUOTE; + this might (or might not?) require making QUASIQUOTE 100% fool-proof. + +* This implementation simplifies quasiquoting of literals + and other self-evaluating objects into the object itself, + instead of a `(QUOTE ,object) expression. + This is also the behaviour of the simplifier in CMUCL and SBCL, + but some people have expressed concerns that it might not be + strictly allowed in letter or spirit by the Common Lisp standards. + We believe that our behaviour is correct in both letter and spirit; + but in any case, a more literally correct (pun intended) behaviour + with respect to the CL standards can be achieved by defining + the feature QUASIQUOTE-QUOTES-LITERALS (untested). + +* The idea of making circular data-structures work within quasiquotation + makes my head ache with overarching pain. I make no attempt to try that, + and most conspicuously not in the simplifier. You're crazier than I am + if you do it and do it right. + +PS: If you're able to follow this discussion, you impress me. +Come join the TUNES project! + diff --git a/fare-matcher.asd b/fare-matcher.asd index 05a7dfdb84f5135c2b963da9c3d114e9afc523de..7403197cdec9c340ccebbafbe2a67230415b6e8a 100644 --- a/fare-matcher.asd +++ b/fare-matcher.asd @@ -2,7 +2,6 @@ (in-package :cl) (asdf:defsystem :fare-matcher - :version "1.0.0" :depends-on (:fare-utils) :serial t :components ((:file "packages") diff --git a/packages.lisp b/packages.lisp index 6692fc719dc3fd7dfe40e482d2322fdbac1abb61..d994354e71783fe3a76a789bb60f2eca4db8a278 100644 --- a/packages.lisp +++ b/packages.lisp @@ -27,11 +27,16 @@ (defpackage #:fare-quasiquote (:use #:fare-matcher #:fare-utils #:common-lisp) - (:shadow #:list #:append #:list* #:cons #:quote #:kwote #:quotep #:vector #:make-vector) + (:shadow #:list #:append #:nconc #:list* #:cons #:quote + #:kwote #:quotep #:vector #:make-vector) (:documentation "Quasiquote implementation with and for pattern-matching") (:export #:quasiquote-expand #:quasiquote #:unquote #:unquote-splicing - #:enable-quasiquote)) + #:enable-quasiquote + #:call-with-quasiquote-reader + #:call-with-unquote-reader + #:call-with-unquote-splicing-reader + #:call-with-unquote-nsplicing-reader)) (defpackage #:fare-clos-match #+openmcl (:shadowing-import-from #:ccl #:quit) diff --git a/quasiquote.lisp b/quasiquote.lisp index 24cf28ab15967f51e10619ec8a538a122389d56f..c5aa570fcdd3c85b6f5d8fd7948c6a3fccf24bd3 100644 --- a/quasiquote.lisp +++ b/quasiquote.lisp @@ -1,211 +1,23 @@ ;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; fare-matcher friendly implementation of Quasiquote -;;; Copyright (c) 2002-2006 Fahree Reedaw +;;; Copyright (c) 2002-2010 Fahree Reedaw +;;; See README.quasiquote #+xcvb (module (:depends-on ("packages" "matcher"))) -#| " -PURPOSE - -The main purpose of this n+2nd reimplementation of quasiquote, -is enable matching of quasiquoted patterns with fare-matcher. - -Now, developing this implementation is also a challenge in understanding -the ins and outs of quasiquotation, and in exploring the way it interacts -with extended support for constant-building syntactic constructs. -And this, at least to me is as much fun as it is an intellectual challenge. :-) - - -INTERACTION WITH FARE-MATCHER - -This implementation of quasiquote requires the FARE-MATCHER system. - -It enables quasiquotation inside FARE-MATCHER patterns. -However, as a limitation to such use, note that as long as -the pattern-matcher isn't extended to match APPEND patterns, -which typically requires backtracking, then those quasiquote templates -that expand into something using APPEND can't be used as patterns to match. -This mostly restricts the use of ,@ or ,. to the end of a list. - -This implementation also uses FARE-MATCHER internally, -which allows to tremendously simplify the simplifier -used to normalize quasiquote-using expressions. -This simplifier in turn is necessary to simplify APPEND patterns -into CONS LIST* and LIST patterns for use with FARE-MATCHER. - - -REFERENCES - -Essential documents consulted while implementing this file: -Alan Bawden's paper: http://www.bawden.org/ftp/pepm99.ps.gz -CLtL2: http://www.supelec.fr/docs/cltl/clm/node367.html -CLHS: http://www.lisp.org/HyperSpec/Body/sec_2-4-6.html -Slate reference manual section 2.6.2 on quoting and unquoting: - http://slate.tunes.org/doc/progman/node12.html#SECTION00046200000000000000 - - -NOTES - -* We provide for a read-time quasiquote expander as well as - a macro-expansion-time quasiquote expander. - The read-time expander handles #() syntax correctly - but mightn't be as efficient as the built-in reader in the common case, - whereas the macro-expansion-time sees #() too late (see BUGS). - To use the macro-expansion-time one, uncomment the line that declares - feature :quasiquote-at-macro-expansion-time. - - -TO DO - -* The CLHS doesn't tell anything about multi-dimensional arrays; - however, this is the opportunity to define a MUP: Meta Unquote Protocol. - The MUP would allow to extend the quasiquote mechanism with support - for new constant-building syntactic constructs as such constructs are defined. - Maybe we will end up with a full-fledge declarative infrastructure - for a Parser-Preprocessor-Pretty-Printer, like camlp4 only more declarative. - -* Can we improve performance? - Statically compile and optimize the patterns for the simplifier? - -* Implement the MUP with an abstract API for new readers; - as examples, provide readers for existing syntax that can be toggled - as either unquote-aware or not: #(), #A, etc. - -* Implement tagged (and multiple-valued?) quasiquotes, unquotes and quotes. - - -BUGS: - -* It looks like there are nasty bugs in the simplifier. - Maybe start again afresh with a MUP for CONS? - We should start from the known-working algorithm described in CLtL2, - that keeps the data in simplified form at all time incrementally, - instead of trying a global simplification after-the-fact. - -* This version works inside simple vectors, so as to support - unquoting inside the #(...) syntax as the standard mandates. - However, doing that at macro-expansion time means that we disturb - any SIMPLE-VECTOR that appears in the source code, even if it comes - from forms other than #(...), such as #1A(...) or #.(VECTOR ...). - This phenomenon has been documented before in the following message: - http://groups.google.com/groups?q=author:kaz%40ashi.footprints.net&hl=en&lr=&ie=UTF-8&oe=UTF-8&safe=off&selm=cf333042.0303141409.bbf02e9%40posting.google.com&rnum=4 - -* Interestingly, I haven't seen the following problem stated, to know which is - correct of `#2(1 ,@'(2 3)) or `#3(1 ,@'(2 3)). In other words, does the read - argument to #() mean something at read-time or at vector-creation-time? - Of course, in the original intended usage, outside of any quasiquoting, - read-time and vector-creation-time are one and the same. - But what when quasiquote breaks up that identity? - -* Note that we do not handle unquoting inside structures - or arrays more complex than simple vectors. - -* Note that in the case of the macro-expansion-time expander, - we do not check for lone unquote syntax before macro expansion, - which may lead this implementation to accept hacks - that are not valid according to the standard, such as - macros that produce unbalanced unquote syntax markers. - -* Certainly, the implementation of quasiquote should be "opened" - so as to allow new syntactic features to take advantage of it. - Then, maybe we can redefine our own proper reader behaviour for #(...) - and each MUP-supporting piece of syntax, on top of the MUP? - - Note that copying and modifying read-tables is expensive, that dynamically - modifying and restoring read-tables might interfere with #. syntax, and that - caching modified read-tables will interfere with any subsequent modification - of a cached read-table, comparison not being possible. - This means that if we wanted the MUP to adapt to existing extensions - without modifying existing code, we would have to intercept the definition - of syntax reading functions before they are fed to either SET-MACRO-CHARACTER - or SET-DISPATCH-MACRO-CHARACTER. Spooky. - Now, this also requires that the current depth of quasiquoting be consulted - any time any of the MUP-enabled constructors is read. - -* The principle of the MUP is that - = structure readers that don't want to support unquote MUST be wrapped into - something that dynamically binds *quasiquote-level* to 0. - = structure readers #C(ARGSYNTAX) that do want to support unquote - MUST accumulate formal arguments to a structure constructor - into a list ARGUMENTS, then, if *quasiquote-level* is 0, behave like - #.(apply `#CONSTRUCTOR `#ARGUMENTS) - otherwise, behave like - ,(apply `#CONSTRUCTOR `#ARGUMENTS) - where #CONSTRUCTOR is the name of the constructor for given structure, - and #ARGUMENTS is whichever arguments have been deduced from the syntax, - which may include as many levels of unquotations as *quasiquote-level* says. - Note that in a strong sense, #. is like , assuming an infinite tower of - read-time evaluators a la 3-LISP. - -* Note that the above is obscured because we're trying to discuss - the behaviour of quasiquote-containing programs without having - a meta-level quasiquoting facility that could distinguish - between what is constant or variable at the meta-level independently from - what is constant or variable at the base level: - #CONSTRUCTOR and #ARGUMENTS would be better specified - through a special meta-level unquotation, the above expressions - being in a corresponding special quasiquotation. - A feature that would allow for clear separation of levels of meta-language - would be a tagged quasiquote feature, as in Slate (http://slate.tunes.org/). - -* This version is not safe with respect to quasiquoting expressions - where appear some marker symbols interned in the FARE-QUASIQUOTE package -- - such expressions may lead to confusion between the body of expressions - being quasiquoted and the internal quasiquote infrastructure. - Any objects used as markers instead of these interned symbols - would lead to the same "bug" if somehow used inside quasiquoted expressions; - but at least, non-interned symbols or gensyms would allow to avoid this bug - in expressions being READ. The "perfect" solution would be to use - objects GENSYMed at the moment a given QUASIQUOTE is read, - and kept in a lexical variable to prevent introspective cheat by #. syntax. - Then, after simplifying expressions, we could pass the read expression - through functions that would SUBSTitute proper symbols for the markers, - from the quasiquote package if pretty-printing is to be supported, - or otherwise from the CL package. - Note that this would have to be interleaved with support for working - inside vectors and other syntax. This is all very tricky - and until further notice is left as an exercise to the intrepid reader. - Thus, while the behaviour of our implementation isn't strictly correct, - we don't go through the hassle of modifying it into something - much less readable just for the sake of preventing code that would - deliberately confuse the quasiquote engine. - Now, if we imagine that some code were dynamically generated - based on system introspection, that could contain some of our magic markers, - then this code would have to be made safe for interaction with QUASIQUOTE; - this might (or might not?) require making QUASIQUOTE 100% fool-proof. - -* This implementation simplifies quasiquoting of literals - and other self-evaluating objects into the object itself, - instead of a `(QUOTE ,object) expression. - This is also the behaviour of the simplifier in CMUCL and SBCL, - but some people have expressed concerns that it might not be - strictly allowed in letter or spirit by the Common Lisp standards. - We believe that our behaviour is correct in both letter and spirit; - but in any case, a more literally correct (pun intended) behaviour - with respect to the CL standards can be achieved by defining - the feature QUASIQUOTE-QUOTES-LITERALS (untested). - -* The idea of making circular data-structures work within quasiquotation - makes my head ache with overarching pain. I make no attempt to try that, - and most conspicuously not in the simplifier. You're crazier than I am - if you do it and do it right. - -PS: If you're able to follow this discussion, you impress me. -Come join the TUNES project! - -" |# (in-package :fare-quasiquote) +(declaim (optimize (speed 1) (safety 3) (debug 3))) + (eval-when (:compile-toplevel :load-toplevel :execute) -; comment/uncomment the line below to enable/disable some simplifications: -;(pushnew :quasiquote-quotes-literals *features*) -; comment/uncomment the line below to enable/disable some simplifications: -;(pushnew :quasiquote-at-macro-expansion-time *features*) +;;;; uncomment some of the lines below to disable according simplifications: +;;(pushnew :quasiquote-quotes-literals *features*) +;;(pushnew :quasiquote-at-macro-expansion-time *features*) ) (eval-when (:compile-toplevel :load-toplevel :execute) -; the below instruction enables pattern-matching for the simplifier. +;; the below instruction enables pattern-matching for the simplifier. (copy-function-matcher list cl:list list* cl:list* @@ -217,6 +29,10 @@ Come join the TUNES project! (make-single-arg-form quasiquote) (make-single-arg-form unquote) (make-single-arg-form unquote-splicing) +(make-single-arg-form unquote-nsplicing) +(defun make-vector-form (&rest x) (list* 'vector x)) +(defun vector-form-p (x) + (and (proper-list-p x) (eq (car x) 'vector))) (defmacro quote (x) (list 'cl:quote x)) (defmacro quasiquote (x) (quasiquote-expand x)) @@ -226,6 +42,9 @@ Come join the TUNES project! (defmacro unquote-splicing (x) (declare (ignore x)) (error "unquote-splicing disallowed outside quasiquote")) +(defmacro unquote-nsplicing (x) + (declare (ignore x)) + (error "unquote-nsplicing disallowed outside quasiquote")) (define-symbol-matcher knil '#'(lambda (form) @@ -237,126 +56,163 @@ Come join the TUNES project! #-quasiquote-quotes-literals nil) );eval-when +(defvar *comma* 'comma) +(defvar *comma-atsign* 'comma-atsign) +(defvar *comma-dot* 'comma-dot) +(defvar *bq-list* 'list) +(defvar *bq-append* 'append) +(defvar *bq-list** 'list*) +(defvar *bq-nconc* 'nconc) +(defvar *bq-clobberable* 'clobberable) +(defvar *bq-quote* 'quote) +(defvar *bq-quote-nil* knil) + (defparameter *quasiquote-level* 0 "current depth of quasiquote nesting") +(defparameter *simplify* t + "should we simplify backquoted expressions") -(defun quasiquote-expand (x) - (let ((e (expand x))) - (if (<= 1 *quasiquote-level*) - (simplify e) - e))) +(defun unquote-xsplicing-p (x) + (or (unquote-splicing-p x) (unquote-nsplicing-p x))) -(defun expand (x) - "Expand a quasiquoted form in single object context" +(defun quasiquote-expand (x) + (let ((*quasiquote-level* 0)) + (multiple-value-bind (top arg) + (quasiquote-expand-0 x) + (when (eq top 'unquote-splicing) + (error ",@ after backquote in ~S" x)) + (when (eq top 'unquote-nsplicing) + (error ",. after backquote in ~S" x)) + (quasiquote-expand-1 top arg)))) + +(defun quasiquote-expand-0 (x) + "Given an expression x under a backquote, return two values: +1- a token identifying a topmost function to apply on +2- an argument +When combining backquoted expressions, tokens are used for simplifications." (cond - ((literalp x) #+quasiquote-quotes-literals (kwote x) - #-quasiquote-quotes-literals x) - ((or (symbolp x) (quotep x)) (kwote x)) - ((quasiquotep x) (expand (quasiquote-expand (single-arg x)))) - ((unquotep x) (insert (single-arg x))) - ((unquote-splicing-p x) (error "can only splice in list context")) - ((consp x) (k-append (expand-list (car x)) (expand (cdr x)))) + ((null x) + (values nil nil)) + ((literalp x) + (values #+quasiquote-quotes-literals 'quote #-quasiquote-quotes-literals :literal x)) + ((or (symbolp x) (quotep x)) + (values 'quote x)) + ((unquote-splicing-p x) + (values 'unquote-splicing (single-arg x))) + ((unquote-nsplicing-p x) + (values 'unquote-nsplicing (single-arg x))) + ((unquotep x) + (values 'unquote (single-arg x))) + ((vector-form-p x) + (multiple-value-bind (top contents) (quasiquote-expand-0 (cdr x)) + (values 'vector (quasiquote-expand-1 top contents)))) #+quasiquote-at-macro-expansion-time ((simple-vector-p x) - (k-vector (quasiquote-expand (coerce x 'cl:list)))) - (t ;(warning "unrecognized object in quasiquote") - (kwote x)))) - -(defun expand-list (x) - "Expand a quasiquoted form in list context" + (values 'vector (quasiquote-expand (coerce x 'cl:list)))) + ((quasiquotep x) + ;; shouldn't be happening unless #+quasiquote-at-macro-expansion-time + (quasiquote-expand-0 (quasiquote-expand (single-arg x)))) + ((consp x) + (multiple-value-bind (atop a) (quasiquote-expand-0 (car x)) + (multiple-value-bind (dtop d) (quasiquote-expand-0 (cdr x)) + (when (eq dtop 'unquote-splicing) + (error ",@ after dot")) + (when (eq dtop 'unquote-nsplicing) + (error ",. after dot")) + (cond + ((eq atop 'unquote-splicing) + (if (null dtop) + (if (unquote-xsplicing-p a) + (values 'append (list a)) + (expand-unquote a)) + (values 'append + (cond ((eq dtop 'append) + (cons a d)) + (t (list a (quasiquote-expand-1 dtop d))))))) + ((eq atop 'unquote-nsplicing) + (if (null dtop) + (if (unquote-xsplicing-p a) + (values 'nconc (list a)) + (expand-unquote a)) + (values 'nconc + (cond ((eq dtop 'nconc) + (cons a d)) + (t (list a (quasiquote-expand-1 dtop d))))))) + ((null dtop) + (if (member atop '(quote :literal nil)) + (values 'quote (list a)) + (values 'list (list (quasiquote-expand-1 atop a))))) + ((member dtop '(quote :literal)) + (if (member atop '(quote :literal nil)) + (values 'quote (cons a d)) + (values 'list* (list (quasiquote-expand-1 atop a) + (quasiquote-expand-1 dtop d))))) + (t (let ((qa (quasiquote-expand-1 atop a))) + (if (member dtop '(list list*)) + (values dtop (cons qa d)) + (values 'list* + (list qa (quasiquote-expand-1 dtop d)))))))))) + (t + (error "unrecognized object in quasiquote")))) + +(defun expand-unquote (x) (cond - ((literalp x) (k-list #+quasiquote-quotes-literals (kwote x) - #-quasiquote-quotes-literals x)) - ((or (symbolp x) (quotep x)) (k-list (kwote x))) - ((quasiquotep x) (expand-list (quasiquote-expand (single-arg x)))) - ((unquotep x) (k-list (single-arg x))) - ((unquote-splicing-p x) (insert (single-arg x))) - ((consp x) (k-list (k-append (expand-list (car x)) - (expand (cdr x))))) - #+quasiquote-at-macro-expansion-time - ((simple-vector-p x) - (k-vector (quasiquote-expand (coerce x 'cl:list)))) - (t ;(warning "unrecognized object in quasiquote") - (k-list (kwote x))))) - -(defun simplify-head (x) - ;;; You don't want to know just how ugly this would be - ;;; without pattern-matching - ;;; However, a better implementation would attempt simplifications - ;;; at the place where things are constructed: - ;;; simplifications for LIST* would happen where LIST* is called, etc. - ;;; An even better implementation would do deforestation on the declarative - ;;; combination of the two rewrite systems. - (labels ((s (x) - (match x - ;; constant folding - ((cons (and c (or 'cons 'list* 'list 'append - 'vector 'make-vector - #-quasiquote-at-macro-expansion-time 'n-vector)) - (and l (when (all-constant-forms-p l)))) - (s (kwote (apply c (unfold-constant-forms l))))) - ;; simplify list* and its particular case cons - ((list 'list* l) - l) - ((cons (or 'cons 'list*) (rcons l knil)) - (apply #'k-list l)) - ;((cons (or 'cons 'list*) (rcons l1 (list (or 'quote 'cl:quote) l2))) - ; (if (proper-list-p l2) - ; (apply #'k-list (append l1 (protect-constant-forms l2))) - ; x)) - ((cons (or 'cons 'list*) - (rcons l1 (cons (and c (or 'cons 'list* 'list)) l2))) - (s (cons (list-extender c) (append l1 l2)))) - ((list 'list* y z) - (if (unquote-splicing-p y) x (k-cons y z))) - ;; simplify vectors - #-quasiquote-at-macro-expansion-time - ((list 'n-vector knil l) - (s (list 'make-vector l))) - ((list 'make-vector (cons 'list l)) - (cons 'vector l)) - ;; simplify append - ((list 'append) - knil) - ((list* 'append knil l) - (s (apply #'k-append l))) - ((cons 'append (rcons l knil)) - (s (apply #'k-append l))) - ((cons 'append (rcons l1 (cons 'append l2))) - (s (cons 'append (append l1 l2)))) - ((cons 'append (cons (cons 'append l1) l2)) - (s (cons 'append (append l1 l2)))) - ((list* 'append (list 'quote kl) ll) - (s (cons 'list* - (rcons (protect-constant-forms kl) - (s (apply #'k-append ll)))))) - ((list* 'append (cons 'list l1) l2) - (s (cons 'list* (rcons l1 (s (apply #'k-append l2)))))) - ((list* 'append (cons (or 'cons 'list*) (rcons l1 l2)) l3) - (s (cons 'list* (rcons l1 (s (k-append l2 (s (apply #'k-append l3)))))))) - ((list 'append l) - (if (unquote-splicing-p l) x l)) - ; append treatment should be redone, and allow for better constant folding, - ; resimplifying a whole list of append arguments when need be. - (* x)))) - (s x))) - -(defun simplify (x) - (match x - ((list 'quote *) x) ; do NOT go under quasiquote-generated quotes - ;;; mind that this ISN'T cl:quote above. - ((cons a b) (simplify-head (cons (simplify a) (simplify b)))) - (* x))) - -;(defun simplify (x) x) + ((null x) + (values nil nil)) + ((literalp x) + (values :literal x)) + ((symbolp x) + (values 'unquote x)) + ((simple-vector-p x) ;; XXX - test this. + (values 'vector (quasiquote-expand (coerce x 'cl:list)))) + ((not (consp x)) + (error "unrecognized object in unquote")) + ((and (quotep x) + (not (unquote-xsplicing-p (single-arg x)))) + (values 'quote (single-arg x))) + ((member (car x) '(append list list* nconc)) + (values (car x) (cdr x))) + ((eq (car x) 'cons) + (values 'list* (cdr x))) + (t (values 'unquote x)))) + +(defun quasiquote-expand-1 (top x) + "Given a top token and an expression, give the quasiquoting +of the result of the top operation applied to the expression" + (cond + ((member top '(unquote :literal nil)) + x) + ((eq top 'quote) + (kwote x)) + ((eq top 'list*) + (cond ((and (null (cddr x)) + (not (unquote-xsplicing-p (car x))) + (not (unquote-xsplicing-p (cadr x)))) + (k-cons (car x) (cadr x))) + ((unquote-xsplicing-p (car (last x))) + (k-append + (apply 'k-list (butlast x)) + (car (last x)))) + (t + (apply 'k-list* x)))) + ((eq top 'vector) + (k-vector x)) + (t + (cons (ecase top + ((list) 'list) + ((append) 'append) + ((nconc) 'nconc)) + x)))) ; we want our own tokens, but they must evaluate the usual way. (defsubst list (&rest r) (apply #'cl:list r)) (defsubst append (&rest r) (apply #'cl:append r)) (defsubst list* (&rest r) (apply #'cl:list* r)) +(defsubst nconc (&rest r) (apply #'cl:nconc r)) (defsubst cons (x y) (cl:cons x y)) (defsubst vector (&rest r) (apply #'cl:vector r)) -(defsubst make-vector (l) (apply #'cl:vector l)) +(defsubst make-vector (l) (coerce l 'simple-vector)) +(defsubst clobberable (x) x) ;; marks x as being unique and clobberable by nconc (defun k-vector (l) (list 'make-vector l)) (defun k-list (&rest r) (cons 'list r)) @@ -373,7 +229,8 @@ Come join the TUNES project! (defun self-evaluating-p (x) (or (literalp x) - (not (or (symbolp x) (combinationp x) ; (simple-vector-p x) + (not (or (symbolp x) (combinationp x) + #+quasiquote-at-macro-expansion-time (simple-vector-p x) )))) (defun constant-form-p (x) (or #-quasiquote-quotes-literals (self-evaluating-p x) @@ -389,49 +246,46 @@ Come join the TUNES project! (defun protect-constant-forms (l) (mapcar #'protect-constant-form l)) + (define-macro-matcher quasiquote #'(lambda (x) (pattern-matcher (quasiquote-expand x)))) -#+quasiquote-at-macro-expansion-time -(defun enable-met-quasiquote (&optional (readtable *readtable*)) - (set-macro-character - #\` #'(lambda (stream char) - (declare (ignore char)) - (make-quasiquote (read stream t nil t))) - nil readtable) - (set-macro-character - #\, #'(lambda (stream char) - (declare (ignore char)) - (case (peek-char nil stream t nil t) - ((#\@ #\.) - (read-char stream t nil t) - (make-unquote-splicing (read stream t nil t))) - (otherwise (make-unquote (read stream t nil t))))) - nil readtable) - nil) +;; Note: it would be a *very bad* idea to use quasiquote:quote +;; in the expansion of the macro-character #\' -; Note: it would be a *very bad* idea to use quasiquote:quote -; in the expansion of the macro-character #\' +(defun call-with-quasiquote-reader (thunk) + (let ((*quasiquote-level* (1+ *quasiquote-level*))) + (make-quasiquote (funcall thunk)))) -#-quasiquote-at-macro-expansion-time -(progn +(defun call-with-unquote-reader (thunk) + (let ((*quasiquote-level* (1- *quasiquote-level*))) + (unless (>= *quasiquote-level* 0) (error "unquote outside quasiquote")) + (make-unquote (funcall thunk)))) + +(defun call-with-unquote-splicing-reader (thunk) + (let ((*quasiquote-level* (1- *quasiquote-level*))) + (unless (>= *quasiquote-level* 0) (error "unquote-splicing outside quasiquote")) + (make-unquote-splicing (funcall thunk)))) + +(defun call-with-unquote-nsplicing-reader (thunk) + (let ((*quasiquote-level* (1- *quasiquote-level*))) + (unless (>= *quasiquote-level* 0) (error "unquote-nsplicing outside quasiquote")) + (make-unquote-nsplicing (funcall thunk)))) (defun read-quasiquote (stream) - (let ((*quasiquote-level* (1+ *quasiquote-level*))) - (quasiquote-expand (read stream t nil t)))) + (call-with-quasiquote-reader (lambda () (read stream t nil t)))) (defun read-unquote (stream) - (let ((*quasiquote-level* (1- *quasiquote-level*))) - (unless (>= *quasiquote-level* 0) (error "unquote outside quasiquote")) - (make-unquote (read stream t nil t)))) + (call-with-unquote-reader (lambda () (read stream t nil t)))) (defun read-unquote-splicing (stream) - (let ((*quasiquote-level* (1- *quasiquote-level*))) - (unless (>= *quasiquote-level* 0) (error "unquote outside quasiquote")) - (make-unquote-splicing (read stream t nil t)))) + (call-with-unquote-splicing-reader (lambda () (read stream t nil t)))) + +(defun read-unquote-nsplicing (stream) + (call-with-unquote-nsplicing-reader (lambda () (read stream t nil t)))) (defun n-vector (n contents) - (if (null n) (apply 'vector contents) + (if (null n) (coerce contents 'simple-vector) (let ((a (make-array n :element-type t))) (when (and (null contents) (> n 0)) (error "non-zero length vector with empty contents")) @@ -443,91 +297,49 @@ Come join the TUNES project! a))) (defun read-vector (stream n) -; http://www.lisp.org/HyperSpec/Body/sec_2-4-8-3.html + ;; http://www.lisp.org/HyperSpec/Body/sec_2-4-8-3.html (let ((contents (read-delimited-list #\) stream t))) (if (> *quasiquote-level* 0) (make-unquote (list 'n-vector n (quasiquote-expand contents))) (n-vector n contents)))) -(defun enable-rt-quasiquote (&optional (readtable *readtable*)) +(defun enable-quasiquote (&key expansion-time (readtable *readtable*)) + (ecase expansion-time + ((read macroexpand)) + ((nil) + (setf expansion-time + #-quasiquote-at-macro-expansion-time 'read + #+quasiquote-at-macro-expansion-time 'macroexpand))) (set-macro-character - #\` #'(lambda (stream char) - (declare (ignore char)) - (read-quasiquote stream)) + #\` (ecase expansion-time + ((read) + #'(lambda (stream char) + (declare (ignore char)) + (macroexpand-1 (read-quasiquote stream)))) + ((macroexpand) + #'(lambda (stream char) + (declare (ignore char)) + (read-quasiquote stream)))) nil readtable) (set-macro-character #\, #'(lambda (stream char) (declare (ignore char)) (case (peek-char nil stream t nil t) - ((#\@ #\.) + ((#\@) (read-char stream t nil t) (read-unquote-splicing stream)) + ((#\.) + (read-char stream t nil t) + (read-unquote-nsplicing stream)) (otherwise (read-unquote stream)))) nil readtable) - (set-dispatch-macro-character - #\# #\( - #'(lambda (stream subchar arg) - (declare (ignore subchar)) - (read-vector stream arg)) - readtable) - nil) -nil) - -#-quasiquote-at-macro-expansion-time -(defun enable-quasiquote (&optional (readtable *readtable*)) - (enable-rt-quasiquote readtable)) - -#+quasiquote-at-macro-expansion-time -(defun enable-quasiquote (&optional (readtable *readtable*)) - (enable-met-quasiquote readtable)) - -#| -; This version of princ allows one to see -; inside of your implementation's version of quasiquoted expressions... - -(defun rprinc (x) - "hand-made princ that allows to see inside quasiquotes -(results are implementation-dependent)" - (labels - ((rprinc-list (x) - (princ "(") - (rprinc-list-contents x) - (princ ")")) - (rprinc-list-contents (x) - (rprinc (car x)) - (rprinc-cdr (cdr x))) - (rprinc-cdr (x) - (if x (if (consp x) - (progn - (princ " ") - (rprinc-list-contents x)) - (progn - (princ " . ") - (rprinc x)))))) - (cond - ((consp x) (rprinc-list x)) - (t (princ x))) - x)) - -; You can test the quasiquote implementation like this: - -(in-package :fare-quasiquote) -(enable-quasiquote) - -(setq b 11) -(TTEST* - ('``a :result '(quote (quote a))) - ('`(a ,b) - :result '(list (quote a) b)) - ('``(a ,b) - :result '(quote (list (quote a) b))) - (`(a ,b) - :result '(a 11)) - ((ifmatch `(a ,x ,@y) '(a b c d) (list x y)) - :result '(b (c d))) - ((format nil "~(~A~)" '(1 2 3)) :result "(1 2 3)") - ((format nil "(~{~A~^ ~})" '`(a ,b ,@c .,d))) - ((format nil "~%(~{~A~^ ~})" '`(,@c .,d))) -) - -|# + (when (eq expansion-time 'read) + (set-dispatch-macro-character + #\# #\( + #'(lambda (stream subchar arg) + (declare (ignore subchar)) + (read-vector stream arg)) + readtable)) + t) + +(trace quasiquote-expand quasiquote-expand-0 quasiquote-expand-1 expand-unquote) \ No newline at end of file diff --git a/test/fare-matcher-test.asd b/test/fare-matcher-test.asd new file mode 100644 index 0000000000000000000000000000000000000000..592677a76f2c0bac8ea5e6224193dbb17a8b21a1 --- /dev/null +++ b/test/fare-matcher-test.asd @@ -0,0 +1,9 @@ +;;; -*- Lisp -*- +(in-package :cl) + +(asdf:defsystem :fare-matcher-test + :depends-on (:fare-matcher :hu.dwim.stefil) + :serial t + :components ((:file "packages") + (:file "matcher") + (:file "quasiquote"))) diff --git a/test/matcher.lisp b/test/matcher.lisp new file mode 100644 index 0000000000000000000000000000000000000000..5367e61fcf52dfa1bc5a7c9d9497941c6806898b --- /dev/null +++ b/test/matcher.lisp @@ -0,0 +1,3 @@ +#+xcvb (module (:depends-on ("packages"))) + +(in-package :fare-matcher-test) diff --git a/test/packages.lisp b/test/packages.lisp new file mode 100644 index 0000000000000000000000000000000000000000..18cdfc8881f43cd289399e462915a78424c10bb4 --- /dev/null +++ b/test/packages.lisp @@ -0,0 +1,12 @@ +#+xcvb (module ()) + +(in-package #:cl-user) + +(defpackage #:fare-matcher-test + (:use #:fare-matcher #:fare-quasiquote #:fare-utils #:common-lisp #:hu.dwim.stefil) + (:shadowing-import-from #:fare-quasiquote + #:quote + #:list #:list* #:append #:cons #:nconc + #:unquote #:quasiquote + #:unquote-splicing #:unquote-nsplicing #:unquote-xsplicing-p) + (:export)) diff --git a/test/quasiquote.lisp b/test/quasiquote.lisp new file mode 100644 index 0000000000000000000000000000000000000000..c7d84986e46e3f03838589aae0b9facd5156a16f --- /dev/null +++ b/test/quasiquote.lisp @@ -0,0 +1,55 @@ +#+xcvb (module (:depends-on ("packages"))) + +(in-package :fare-matcher-test) + +;; This version of princ allows one to see +;; inside of your implementation's version of quasiquoted expressions... + +(defun rprinc (x) + "hand-made princ that allows to see inside quasiquotes +(results are implementation-dependent)" + (labels + ((rprinc-list (x) + (princ "(") + (rprinc-list-contents x) + (princ ")")) + (rprinc-list-contents (x) + (rprinc (car x)) + (rprinc-cdr (cdr x))) + (rprinc-cdr (x) + (if x (if (consp x) + (progn + (princ " ") + (rprinc-list-contents x)) + (progn + (princ " . ") + (rprinc x)))))) + (cond + ((consp x) (rprinc-list x)) + (t (princ x))) + x)) + +;; You can test the quasiquote implementation like this: + +(defvar *saved-readtable* *readtable*) +(defparameter *fq-readtable* (copy-readtable *saved-readtable*)) +(enable-quasiquote :readtable *fq-readtable*) + +(defun fq (s) + (let ((*readtable* *fq-readtable*)) + (read-from-string s))) + +(defparameter b 11) + +(deftest test-quasiquote () + (macrolet ((q (x y) + `(is (equal (fq ,x) ',y)))) + (q "``a" (quote (quote a))) + (q "`(a ,b)" (list (quote a) b)) + (q "``(a ,b)" (quote (list (quote a) b))) + (q "`(a ,b)" (list (quote a) b)) + (q "`(a ,x ,@y)" (list* (quote a) x y)) + ;;(is (equal (ifmatch `(a ,x ,@y) '(a b c d) (list x y)) '(b (c d)))) + (q "`(1 2 3)" (quote (1 2 3))) + (q "`(a ,b ,@c .,d)" (list* (quote a) b (append c d))) + (q "`(,@c .,d)" (append c d))))