Merged rdp into the main informatimago repository.

Pascal J. Bourguignon [2012-04-14 23:48]
Merged rdp into the main informatimago repository.
Filename
Makefile
rdp/README
rdp/com.informatimago.rdp.asd
rdp/com.informatimago.rdp.basic.asd
rdp/com.informatimago.rdp.basic.example.asd
rdp/com.informatimago.rdp.example.asd
rdp/example-basic.lisp
rdp/example-lisp.lisp
rdp/movie-shell.lisp
rdp/rdp-basic-gen.lisp
rdp/rdp-macro.lisp
rdp/rdp.lisp
rdp/scratch.lisp
diff --git a/Makefile b/Makefile
index fc74301..af0d236 100644
--- a/Makefile
+++ b/Makefile
@@ -63,7 +63,7 @@ PREFIX=$(HOME)/quicklisp/local-projects
 PACKAGES=$(PREFIX)

 PACKAGE_PATH=com/informatimago
-MODULES= common-lisp clext clmisc  clisp  susv3
+MODULES= common-lisp clext clmisc  clisp  susv3  rdp



diff --git a/rdp/README b/rdp/README
new file mode 100644
index 0000000..72e6173
--- /dev/null
+++ b/rdp/README
@@ -0,0 +1,20 @@
+This system defines a simple Recursive Decent Parser generator.
+
+See the COPYING file for the full license.
+
+
+Copyright Pascal Bourguignon 2006 - 2012
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as published by
+the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+
+You should have received a copy of the GNU Affero General Public License
+along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
diff --git a/rdp/com.informatimago.rdp.asd b/rdp/com.informatimago.rdp.asd
new file mode 100644
index 0000000..b1c4886
--- /dev/null
+++ b/rdp/com.informatimago.rdp.asd
@@ -0,0 +1,56 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.rdp.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the com.informatimago.rdp system.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Added this header.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.rdp
+    :name "Recursive Descent Parser Generator"
+    :description   "This package defines a Recursive Descent Parser generator.
+The client may define methods to generate the code of the parser in
+different languages than lisp."
+    :author "<PJB> Pascal Bourguignon <pjb@informatimago.com>"
+    :version "1.0.0"
+    :licence "AGPL3"
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Summer 2011")
+                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.rdp/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+    :depends-on (:cl-ppcre
+                 :com.informatimago.common-lisp.cesarum
+                 :com.informatimago.common-lisp.parser)
+    :components ((:file "rdp")
+                 (:file "rdp-macro" :depends-on ("rdp"))))
+
+;;;; THE END ;;;;
diff --git a/rdp/com.informatimago.rdp.basic.asd b/rdp/com.informatimago.rdp.basic.asd
new file mode 100644
index 0000000..0b7716d
--- /dev/null
+++ b/rdp/com.informatimago.rdp.basic.asd
@@ -0,0 +1,51 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.rdp.basic.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Define the com.informatimago.rdp.basic system.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Added this header.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.rdp.basic
+    :name "Recursive Descent Parser Generator - BASIC generator."
+    :description   "This package defines methods to generate the parsers in BASIC."
+    :author "<PJB> Pascal Bourguignon <pjb@informatimago.com>"
+    :version "1.0.0"
+    :licence "AGPLv3"
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Summer 2011")
+                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.rdp.basic/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+    :depends-on ("com.informatimago.rdp")
+    :components ((:file "rdp-basic-gen")))
+
+;;;; THE END ;;;;
diff --git a/rdp/com.informatimago.rdp.basic.example.asd b/rdp/com.informatimago.rdp.basic.example.asd
new file mode 100644
index 0000000..e9f8e7a
--- /dev/null
+++ b/rdp/com.informatimago.rdp.basic.example.asd
@@ -0,0 +1,52 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.rdp.basic.example.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Define the com.informatimago.rdp.basic.example system.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Added this header.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.rdp.basic.example
+    :name "An example of parser generated in BASIC with the Recursive Descent Parser Generator."
+    :description "An example of parser generated in BASIC with the Recursive Descent Parser Generator."
+    :author "<PJB> Pascal Bourguignon <pjb@informatimago.com>"
+    :version "1.0.0"
+    :licence "AGPLv3"
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Summer 2011")
+                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.rdp.basic.example/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+    :depends-on ("com.informatimago.rdp"
+                 "com.informatimago.rdp.basic")
+    :components ((:file "example-basic")))
+
+;;;; THE END ;;;;
diff --git a/rdp/com.informatimago.rdp.example.asd b/rdp/com.informatimago.rdp.example.asd
new file mode 100644
index 0000000..eccacfe
--- /dev/null
+++ b/rdp/com.informatimago.rdp.example.asd
@@ -0,0 +1,51 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.rdp.example.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Defines the com.informatimago.rdp.example system.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Added this header.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(asdf:defsystem :com.informatimago.rdp.example
+    :name "An example of parser generated with the Recursive Descent Parser Generator."
+    :description "An example of parser generated with the Recursive Descent Parser Generator."
+    :author "<PJB> Pascal Bourguignon <pjb@informatimago.com>"
+    :version "1.0.0"
+    :licence "AGPLv3"
+    :properties ((#:author-email                   . "pjb@informatimago.com")
+                 (#:date                           . "Summer 2011")
+                 ((#:albert #:output-dir)          . "../documentation/com.informatimago.rdp.example/")
+                 ((#:albert #:formats)             . ("docbook"))
+                 ((#:albert #:docbook #:template)  . "book")
+                 ((#:albert #:docbook #:bgcolor)   . "white")
+                 ((#:albert #:docbook #:textcolor) . "black"))
+    :depends-on ("com.informatimago.rdp")
+    :components ((:file "example-lisp")))
+
+;;;; THE END ;;;;
diff --git a/rdp/example-basic.lisp b/rdp/example-basic.lisp
new file mode 100644
index 0000000..84c89dc
--- /dev/null
+++ b/rdp/example-basic.lisp
@@ -0,0 +1,158 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               example-basic.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    An example grammar for the recusive descent parser generator.
+;;;;    The actions are written in a pseudo basic
+;;;;    to generate a pseudo basic parser.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2011-07-19 <PJB> Updated regexps, now we use extended regexps.
+;;;;    2006-09-10 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal Bourguignon 2006 - 2011
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+
+(defpackage "COM.INFORMATIMAGO.RDP.BASIC.EXAMPLE"
+  (:use "COMMON-LISP" "COM.INFORMATIMAGO.RDP")
+  (:export "PARSE-EXAMPLE"))
+(in-package "COM.INFORMATIMAGO.RDP.BASIC.EXAMPLE")
+
+
+(defgrammar example
+    :target-language :basic
+    :terminals ((ident   "[A-Za-z][A-Za-z0-9]*")
+                ;; real must come first to match the longest first.
+                (real    "[-+]?[0-9]+.[0-9]+([Ee][-+]?[0-9]+)?")
+                (integer "[-+]?[0-9]+"))
+    :start program
+    :rules ((--> factor
+                 (alt ident
+                      number
+                      (seq "(" expression ")" :action "RES=A2"))
+                 :action "RES=A1")
+            (--> number  (alt integer real) :action "RES=A1")
+            (--> term
+                 factor (rep (alt "*" "/") factor)
+                 :action "NCAR=A1:NCDR=A2:CALL CONS")
+            (--> expression
+                 (opt (alt "+" "-"))
+                 term
+                 (rep (alt "+" "-") term
+                      :action
+                      "NCAR=A2:NCDR=NIL:CALL CONS"
+                      "NCAR=A1:NCDR=RES:CALL CONS")
+                 :action
+                 "IF A1<>0 THEN"
+                 "  NCAR=A2:NCDR=NIL:CALL CONS"
+                 "  NCAR=A1:NCDR=RES:CALL CONS"
+                 "  NCAR=RES"
+                 "ELSE"
+                 "  NCAR=A2"
+                 "ENDIF"
+                 "NCDR=A3:CALL CONS"
+                 "TMP=RES"
+                 "NSTRING$=\"+\":CALL MKSTR:NCAR=RES:NCDR=TMP:CALL CONS")
+            (--> condition
+                 (alt (seq "odd" expression
+                           :action
+                           "NCAR=A2:NCDR=NIL:CALL CONS:TMP=RES"
+                           "NSTRING$=\"ODD\":CALL MKSTR"
+                           "NCAR=RES:NCDR=TMP:CALL CONS")
+                      (seq expression
+                           (alt "=" "#" "<" "<=" ">" ">=")
+                           expression
+                           :action
+                           "NCAR=A3:NCDR=NIL:CALL CONS"
+                           "NCAR=A1:NCDR=RES:CALL CONS"
+                           "NCAR=A2:NCDR=RES:CALL CONS"))
+                 :action "RES=A1")
+            (--> statement
+                 (opt (alt (seq ident ":=" expression
+                                :action
+                                "NCAR=A3:NCDR=NIL:CALL CONS"
+                                "NCAR=A1:NCDR=RES:CALL CONS"
+                                "TMP=RES:NSTRING$=\"LET\":CALL MKSTR"
+                                "NCAR=RES:NCDR=TMP:CALL CONS")
+                           (seq "call" ident
+                                :action
+                                "NCAR=A2:NCDR=NIL:CALL CONS"
+                                "TMP=RES:NSTRING$=\"CALL\":CALL MKSTR"
+                                "NCAR=RES:NCDR=TMP:CALL CONS")
+                           (seq "begin" statement
+                                (rep ";" statement :action "RES=A2")
+                                "end"
+                                :action "NCAR=A2:NCDR=A3:CALL CONS")
+                           (seq "if" condition "then" statement
+                                :action
+                                "NCAR=A4:NCDR=NIL:CALL CONS"
+                                "NCAR=A2:NCDR=RES:CALL CONS"
+                                "TMP=RES:NSTRING$=\"IF\":CALL MKSTR"
+                                "NCAR=RES:NCDR=TMP:CALL CONS")
+                           (seq "while" condition "do" statement
+                                :action
+                                "NCAR=A4:NCDR=NIL:CALL CONS"
+                                "NCAR=A2:NCDR=RES:CALL CONS"
+                                "TMP=RES:NSTRING$=\"WHILE\":CALL MKSTR"
+                                "NCAR=RES:NCDR=TMP:CALL CONS")))
+                 :action "RES=A1")
+            (--> block
+                 (opt "const" ident "=" number
+                      (rep "," ident "=" number
+                           :action
+                           "NCAR=A4:NCDR=NIL:CALL CONS"
+                           "NCAR=A2:NCDR=RES:CALL CONS")
+                      ";"
+                      :action
+                      "NCAR=A4:NCDR=NIL:CALL CONS"
+                      "NCAR=A2:NCDR=RES:CALL CONS"
+                      "NCAR=RES:NCDR=A5:CALL CONS")
+                 (opt "var" ident
+                      (rep "," ident :action "RES=A2")
+                      ";"
+                      :action
+                      "NCAR=A3:NCDR=NIL:CALL CONS"
+                      "NCAR=A2:NCDR=RES:CALL CONS")
+                 (rep "procedure" ident ";" block ";"
+                      :action
+                      "NCAR=A4:NCDR=NIL:CALL CONS"
+                      "NCAR=A2:NCDR=RES:CALL CONS"
+                      "TMP=RES:NSTRING$=\"PROCEDURE\":CALL MKSTR"
+                      "NCAR=RES:NCDR=TMP:CALL CONS")
+                 statement
+                 :action
+                 "NCAR=A4:NCDR=NIL:CALL CONS"
+                 "NCAR=A3:NCDR=RES:CALL CONS"
+                 "NCAR=A2:NCDR=RES:CALL CONS"
+                 "NCAR=A1:NCDR=RES:CALL CONS"
+                 "TMP=RES:NSTRING$=\"BLOCK\":CALL MKSTR"
+                 "NCAR=RES:NCDR=TMP:CALL CONS")
+            (--> program
+                 block "." :action "RES=A1")))
+
+
+;;;; THE END ;;;;
+
diff --git a/rdp/example-lisp.lisp b/rdp/example-lisp.lisp
new file mode 100644
index 0000000..2e4b8da
--- /dev/null
+++ b/rdp/example-lisp.lisp
@@ -0,0 +1,200 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               example-lisp.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    An example grammar for the recusive descent parser generator.
+;;;;    The actions are written in Lisp, to generate a lisp parser.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2011-07-19 <PJB> Updated regexps, now we use extended regexps.
+;;;;    2011-07-19 <PJB> Added defpackage forms.  Added parsing example sources.
+;;;;    2006-09-10 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal Bourguignon 2006 - 2006
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+
+(defpackage "COM.INFORMATIMAGO.RDP.EXAMPLE"
+  (:use "COMMON-LISP" "COM.INFORMATIMAGO.RDP")
+  (:export "PARSE-EXAMPLE"))
+(in-package "COM.INFORMATIMAGO.RDP.EXAMPLE")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Example Language
+;;; taken from: http://en.wikipedia.org/wiki/Recursive_descent_parser
+;;;
+
+(defgrammar example
+    :terminals ((ident   "[A-Za-z][A-Za-z0-9]*")
+                ;; real must come first to match the longest first.
+                (real    "[-+]?[0-9]+\\.[0-9]+([Ee][-+]?[0-9]+)?")
+                (integer "[-+]?[0-9]+"))
+    :start program
+    :rules ((--> factor
+                 (alt ident
+                      number
+                      (seq "(" expression ")" :action $2))
+                 :action $1)
+            (--> number  (alt integer real) :action $1)
+            (--> term
+                 factor (rep (alt "*" "/") factor)
+                 :action `(,$1 . ,$2))
+            (--> expression
+                 (opt (alt "+" "-"))
+                 term
+                 (rep (alt "+" "-") term :action `(,$1 ,$2))
+                 :action `(+ ,(if $1 `(,$1 ,$2) $2)  . ,$3))
+            (--> condition
+                 (alt (seq "odd" expression
+                           :action `(oddp ,$2))
+                      (seq expression
+                           (alt "=" "#" "<" "<=" ">" ">=")
+                           expression
+                           :action `(,$2 ,$1 ,$3)))
+                 :action $1)
+            (--> statement
+                 (opt (alt (seq ident ":=" expression
+                                :action `(setf ,$1 ,$3))
+                           (seq "call" ident
+                                :action `(call ,$2))
+                           (seq "begin" statement
+                                (rep ";" statement
+                                     :action $2)
+                                "end"
+                                :action `(,$2 . ,$3))
+                           (seq "if" condition "then" statement
+                                :action `(if ,$2 ,$4))
+                           (seq "while" condition "do" statement
+                                :action `(while ,$2 ,$4))))
+                 :action $1)
+            (--> block
+                 (opt "const" ident "=" number
+                      (rep "," ident "=" number
+                           :action `(,$2 ,$4))
+                      ";"
+                      :action `((,$2 ,$4) . ,$5))
+                 (opt "var" ident
+                      (rep "," ident :action $2)
+                      ";"
+                      :action `(,$2 . ,$3))
+                 (rep "procedure" ident ";" block ";"
+                      :action `(procedure ,$2 ,$4))
+                 statement
+                 :action `(block ,$1 ,$2 ,$3 ,$4))
+            (--> program
+                 block "." :action $1)))
+
+
+
+(assert (equal (COM.INFORMATIMAGO.RDP.EXAMPLE:PARSE-EXAMPLE
+                "
+    const abc = 123,
+          pi=3.141592e+0;
+    var a,b,c;
+    procedure gcd;
+    begin
+        while a # b do
+        begin
+             if a<b then b:=b-a ;
+             if a>b then a:=a-b
+        end
+    end;
+begin
+    a:=42;
+    b:=30.0;
+    call gcd
+end.")
+               '(BLOCK (((IDENT "abc" 11) (INTEGER "123" 17)) ((IDENT "pi" 32) (REAL "3.141592e+0" 35))) ((IDENT "a" 57) (IDENT "b" 59) (IDENT "c" 61)) ((PROCEDURE (IDENT "gcd" 79) (BLOCK NIL NIL NIL ((WHILE (("#" "#" 112) (+ ((IDENT "a" 110))) (+ ((IDENT "b" 114)))) ((IF (("<" "<" 151) (+ ((IDENT "a" 150))) (+ ((IDENT "b" 152)))) (SETF (IDENT "b" 159) (+ ((IDENT "b" 162)) (("-" "-" 163) ((IDENT "a" 164)))))) (IF ((">" ">" 186) (+ ((IDENT "a" 185))) (+ ((IDENT "b" 187)))) (SETF (IDENT "a" 194) (+ ((IDENT "a" 197)) (("-" "-" 198) ((IDENT "b" 199)))))))))))) ((SETF (IDENT "a" 235) (+ ((INTEGER "42" 238)))) (SETF (IDENT "b" 246) (+ ((REAL "30.0" 249)))) (CALL (IDENT "gcd" 264))))))
+
+
+
+(defpackage "COM.INFORMATIMAGO.RDP.EXAMPLE-WITHOUT-ACTION"
+  (:use "COMMON-LISP" "COM.INFORMATIMAGO.RDP")
+  (:export "PARSE-EXAMPLE-WITHOUT-ACTION"))
+(in-package "COM.INFORMATIMAGO.RDP.EXAMPLE-WITHOUT-ACTION")
+
+(defgrammar example-without-action
+    :terminals ((ident   "[A-Za-z][A-Za-z0-9]*")
+                ;; real must come first to match the longest first.
+                (real    "[-+]?[0-9]+\\.[0-9]+([Ee][-+]?[0-9]+)?")
+                (integer "[-+]?[0-9]+"))
+    :start program
+    :rules ((--> factor
+                 (alt ident
+                      number
+                      (seq "(" expression ")")))
+            (--> number  (alt integer real))
+            (--> term
+                 factor (rep (alt "*" "/") factor))
+            (--> expression
+                 (opt (alt "+" "-"))
+                 term
+                 (rep (alt "+" "-") term))
+            (--> condition
+                 (alt (seq "odd" expression)
+                      (seq expression
+                           (alt "=" "#" "<" "<=" ">" ">=")
+                           expression)))
+            (--> statement
+                 (opt (alt (seq ident ":=" expression)
+                           (seq "call" ident)
+                           (seq "begin" statement
+                                (rep ";" statement)
+                                "end")
+                           (seq "if" condition "then" statement)
+                           (seq "while" condition "do" statement))))
+            (--> block
+                 (opt "const" ident "=" number
+                      (rep "," ident "=" number) ";")
+                 (opt "var" ident (rep "," ident) ";")
+                 (rep "procedure" ident ";" block ";")
+                 statement)
+            (--> program
+                 block ".")))
+
+
+(assert (equal (COM.INFORMATIMAGO.RDP.EXAMPLE-WITHOUT-ACTION:PARSE-EXAMPLE-WITHOUT-ACTION
+                "
+    const abc = 123,
+          pi=3.141592e+0;
+    var a,b,c;
+    procedure gcd;
+    begin
+        while a # b do
+        begin
+             if a<b then b:=b-a ;
+             if a>b then a:=a-b
+        end
+    end;
+begin
+    a:=42;
+    b:=30.0;
+    call gcd
+end.")
+               '(PROGRAM (BLOCK (("const" "const" 5) (IDENT "abc" 11) ("=" "=" 15) (NUMBER (INTEGER "123" 17)) ((("," "," 20) (IDENT "pi" 32) ("=" "=" 34) (NUMBER (REAL "3.141592e+0" 35)))) (";" ";" 46)) (("var" "var" 53) (IDENT "a" 57) ((("," "," 58) (IDENT "b" 59)) (("," "," 60) (IDENT "c" 61))) (";" ";" 62)) ((("procedure" "procedure" 69) (IDENT "gcd" 79) (";" ";" 82) (BLOCK NIL NIL NIL (STATEMENT (("begin" "begin" 89) (STATEMENT (("while" "while" 104) (CONDITION ((EXPRESSION NIL (TERM (FACTOR (IDENT "a" 110)) NIL) NIL) ("#" "#" 112) (EXPRESSION NIL (TERM (FACTOR (IDENT "b" 114)) NIL) NIL))) ("do" "do" 116) (STATEMENT (("begin" "begin" 128) (STATEMENT (("if" "if" 147) (CONDITION ((EXPRESSION NIL (TERM (FACTOR (IDENT "a" 150)) NIL) NIL) ("<" "<" 151) (EXPRESSION NIL (TERM (FACTOR (IDENT "b" 152)) NIL) NIL))) ("then" "then" 154) (STATEMENT ((IDENT "b" 159) (":=" ":=" 160) (EXPRESSION NIL (TERM (FACTOR (IDENT "b" 162)) NIL) ((("-" "-" 163) (TERM (FACTOR (IDENT "a" 164)) NIL)))))))) (((";" ";" 166) (STATEMENT (("if" "if" 182) (CONDITION ((EXPRESSION NIL (TERM (FACTOR (IDENT "a" 185)) NIL) NIL) (">" ">" 186) (EXPRESSION NIL (TERM (FACTOR (IDENT "b" 187)) NIL) NIL))) ("then" "then" 189) (STATEMENT ((IDENT "a" 194) (":=" ":=" 195) (EXPRESSION NIL (TERM (FACTOR (IDENT "a" 197)) NIL) ((("-" "-" 198) (TERM (FACTOR (IDENT "b" 199)) NIL)))))))))) ("end" "end" 210))))) NIL ("end" "end" 219)))) (";" ";" 222))) (STATEMENT (("begin" "begin" 224) (STATEMENT ((IDENT "a" 235) (":=" ":=" 236) (EXPRESSION NIL (TERM (FACTOR (NUMBER (INTEGER "42" 238))) NIL) NIL))) (((";" ";" 240) (STATEMENT ((IDENT "b" 246) (":=" ":=" 247) (EXPRESSION NIL (TERM (FACTOR (NUMBER (REAL "30.0" 249))) NIL) NIL)))) ((";" ";" 253) (STATEMENT (("call" "call" 259) (IDENT "gcd" 264))))) ("end" "end" 268)))) ("." "." 271))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; THE END ;;;;
diff --git a/rdp/movie-shell.lisp b/rdp/movie-shell.lisp
new file mode 100644
index 0000000..0df5ab5
--- /dev/null
+++ b/rdp/movie-shell.lisp
@@ -0,0 +1,130 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               movie-shell.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    A silly little shell, taking commands like in Tron.
+;;;;    The commands are parsed with a recursive descent grammar,
+;;;;    the parser being generated by com.informatimago.rdp.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2011-07-19 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2011 - 2011
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(ql:quickload :com.informatimago.rdp)
+(use-package  :com.informatimago.rdp)
+
+
+(defvar *password* '("0" . "NONE"))
+
+(defun sh-code-password-to-memory (ident address)
+  (setf *password* (cons address ident))
+  (format t "~&PASSWORD STORED TO MEMORY ~A~%" address))
+
+(defun sh-request-access-to (&key program database)
+  (format t "~&ACCESS TO ~:[PROGRAM~;DATABASE~] ~A IS ~:[REJECTED~;GRANTED~]~%"
+          database (or program database)  (string= (cdr *PASSWORD*) "GOLDFINGER")))
+
+(defun sh-status-report-on (&rest what)
+  (format t "~&~{~A~^ ~} STATUS IS OK~%" what))
+
+(defun sh-quit ()
+  (format t "~&GOOD BYE, M. DILLIGER.~%")
+  (throw 'gazongues nil))
+
+
+(defgrammar movie-shell
+    :terminals ((ident   "[A-Za-z][A-Za-z0-9]*")
+                (address "[0-9][0-9A-F]*"))
+    :start command
+    :rules ((--> command (alt request code quit) :action (values))
+            (--> request
+                 "REQUEST"
+                 (alt (seq "ACCESS" "TO" ident (alt "PROGRAM" "DATABASE")
+                           :action (sh-request-access-to
+                                    (intern (second $4) "KEYWORD") (second $3)))
+                      (seq "STATUS" "REPORT" "ON" "MISSING" "DATA"
+                           :action (sh-status-report-on (second $4) (second $5)))))
+            (--> code
+                 "CODE" ident "TO" "MEMORY" address
+                 :action (sh-code-password-to-memory (second $2) (second $5)))
+            (--> quit
+                 "QUIT"
+                 :action (sh-quit))))
+
+(defun movie-shell ()
+  (catch 'gazongues
+    (loop
+       :for command = (progn (format *query-io* "~%> ")
+                             (finish-output *query-io*)
+                             (clear-input *query-io*)
+                             (read-line *query-io*))
+       :do (progn
+             (handler-case (parse-movie-shell (string-upcase command))
+               (error (err)
+                 (format t "~&~A~%" err)))
+             (finish-output))))
+  (finish-output)
+  (values))
+
+
+;; CL-USER> (movie-shell)
+;;
+;; > request access to secret program
+;;
+;; ACCESS TO PROGRAM SECRET IS GRANTED
+;;
+;; > code zero to memory 42
+;;
+;; PASSWORD STORED TO MEMORY 42
+;;
+;; > request access to secret program
+;;
+;; ACCESS TO PROGRAM SECRET IS REJECTED
+;;
+;; > request access to big database
+;;
+;; ACCESS TO DATABASE BIG IS REJECTED
+;;
+;; > code goldfinger to memory 42
+;;
+;; PASSWORD STORED TO MEMORY 42
+;;
+;; > request access to big database
+;;
+;; ACCESS TO DATABASE BIG IS GRANTED
+;;
+;; > request status report on missing data
+;;
+;; MISSING DATA STATUS IS OK
+;;
+;; > quit
+;;
+;; GOOD BYE, M. DILLIGER.
+;; ; No value
+;; CL-USER>
+
+;;;; THE END ;;;;
diff --git a/rdp/rdp-basic-gen.lisp b/rdp/rdp-basic-gen.lisp
new file mode 100644
index 0000000..b12dbc6
--- /dev/null
+++ b/rdp/rdp-basic-gen.lisp
@@ -0,0 +1,289 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               rdp-basic-gen.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    A (pseudo) basic generator for the recusive descent parser generator.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2011-07-19 <PJB> Updated for new rdp.
+;;;;    2006-09-10 <PJB> Created.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal Bourguignon 2006 - 2006
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(in-package "COM.INFORMATIMAGO.RDP")
+
+
+(defparameter *linenum* 0)
+
+(defun emit (fctrl &rest args)
+  (format t "~&~4D " (incf *linenum* 10))
+  (apply (function format) t fctrl args))
+
+
+(defmethod generate-boilerplate ((target (eql :basic)) grammar &key (trace nil))
+  (declare (ignore trace))
+  `(progn
+    (emit "SCANSRC$=\"\" : SCANFUN$=\"\" : SCANPOS=0")
+    (emit "CURTOK$=\"\"  : CURTXT$=\"\"  : CURPOS=0")
+    (emit "SPACES$=" "+CHR$(10)+CHR$(13)+CHR$(9)")
+    (emit "DEF SCANEOF : IF LEN(SCANSRC$)<=SCANPOS THEN RETURN 1 ELSE RETURN 0 : ENDFUN")
+    (emit "SUB ACCEPT")
+    (emit "  IF TOKEN$ <> CURTOK$ THEN")
+    (emit "     PRINT \"ERROR: AT POSITION\",CURPOS,\"EXPECTED \",TOKEN$,\" NOT \",CURTOK$")
+    (emit "     STOP")
+    (emit "  ELSE")
+    (emit "     ACCEPTOK$=CURTOK$:ACCEPTXT$=CURTXT$:ACCEPPOS$=CURPOS$")
+    (emit "     CALL SCANFUN$")
+    (emit "  ENDIF")
+    (emit "ENDSUB")
+    (emit "MAXCONS=100000")
+    (emit "NIL=0:CONS=1:STRING=2:NUMBER=3")
+    (emit "TYPELABEL$[NIL]=\"NIL\"")
+    (emit "TYPELABEL$[CONS]=\"CONS\"")
+    (emit "TYPELABEL$[STRING]=\"STRING\"")
+    (emit "TYPELABEL$[NUMBER]=\"NUMBER\"")
+    (emit "DIM TYPES[MAXCONS],CAR[MAXCONS],CDR[MAXCONS],STRINGS$[MAXCONS],NUMBERS[MAXCONS]")
+    (emit "TYPES[NIL]=NIL:CAR[NIL]=NIL:CDR[NIL]=NIL:STRINGS$[NIL]=\"NIL\":NUMBERS[NIL]=0")
+    (emit "FREE=MAXCONS")
+    (emit "SUB CONS")
+    (emit "  IF FREE<=1 THEN PRINT \"ERROR: OUT OF CONS SPACE\" : STOP : ENDIF")
+    (emit "  FREE=FREE-1")
+    (emit "  TYPES[FREE]=CONS")
+    (emit "  CAR[FREE]=NCAR")
+    (emit "  CDR[FREE]=NCDR")
+    (emit "  RES=FREE")
+    (emit "ENDSUB")
+    (emit "SUB MKSTR")
+    (emit "  IF FREE<=1 THEN PRINT \"ERROR: OUT OF CONS SPACE\" : STOP : ENDIF")
+    (emit "  FREE=FREE-1")
+    (emit "  TYPES[FREE]=STRING")
+    (emit "  STRING$[FREE]=NSTRING$")
+    (emit "  RES=FREE")
+    (emit "ENDSUB")
+    (emit "SUB MKNUM")
+    (emit "  IF FREE<=1 THEN PRINT \"ERROR: OUT OF CONS SPACE\" : STOP : ENDIF")
+    (emit "  FREE=FREE-1")
+    (emit "  TYPES[FREE]=NUMBER")
+    (emit "  NUMBER[FREE]=NNUMBER")
+    (emit "  RES=FREE")
+    (emit "ENDSUB")
+    (emit "SUB REVERSE")
+    (emit "  REV=0:TREV=NIL")
+    (emit "  WHILE LIST<>0")
+    (emit "   IF TYPES[LIST]<>CONS THEN")
+    (emit "      PRINT \"ERROR: REVERSE EXPECTS A LIST, NOT A \",TYPELABEL$[TYPES[LIST]]")
+    (emit "      STOP")
+    (emit "    ELSE")
+    (emit "      NEW=CDR[LIST]")
+    (emit "      CDR[LIST]=REV:TYPES[LIST]=TREV")
+    (emit "      REV=LIST:TREV=CONS")
+    (emit "      LIST=NEW")
+    (emit "    ENDIF")
+    (emit "  ENDWHILE")
+    (emit "  RES=REV")
+    (emit "ENDSUB")))
+
+
+(defmethod gen-scanner-function-name ((target (eql :basic)) grammar-name)
+   (format nil "SCAN~A" grammar-name))
+
+
+(defmethod generate-scanner ((target (eql :basic)) grammar &key (trace nil))
+  (let* ((an-terminals  (sort (remove-if-not
+                               (lambda (item)
+                                 (and (stringp item)
+                                      (alphanumericp (aref item (1- (length item))))))
+                               (grammar-all-terminals grammar))
+                              (function >) :key (function length)))
+         (nan-terminals (sort (remove-if
+                               (lambda (item)
+                                 (or (not (stringp item))
+                                     (alphanumericp (aref item (1- (length item))))))
+                               (grammar-all-terminals grammar))
+                              (function >) :key (function length)))
+         (nl-terminals (remove-if (function stringp) (grammar-terminals grammar)))
+         (lit-an-terminals-regexp
+          (format nil "^(~{~A~^|~})([^A-Za-z0-9]|$)"
+                  (mapcar (function regexp-quote-extended) an-terminals)))
+         (lit-nan-terminals-regexp
+          (format nil "^(~{~A~^|~})"
+                  (mapcar (function regexp-quote-extended)  nan-terminals)))
+         (fname (gen-scanner-function-name target (grammar-name grammar))))
+    `(progn
+       (emit "SUB ~A" ',fname)
+       ,@(when trace `((emit "PRINT \"> ~A\"" ',(symbol-name fname))))
+       (emit "  WHILE POS(SCANSRC$[SCANPOS],SPACES$)>0 : SCANPOS=SCANPOS+1 : ENDWHILE")
+       (emit "  CURPOS=SCANPOS")
+       (emit "  IF SCANEOF<>0 THEN")
+       (emit "    SCANPOS=LEN(SCANSRC$)")
+       (emit "    SCANTXT$=\"<END OF SOURCE>\"")
+       (emit "    SCANTOK$=\"\"")
+       (emit "  ELSE")
+       (emit "    REM *** ASSUMING THERE IS SOME WAY TO MATCH REGEXPS IN BASIC...")
+       (when an-terminals
+         (emit "    MATCHREGEXP  \"~A\" SCANSRC$,SCANPOS INTO START,END" ',lit-an-terminals-regexp)
+         (emit "    IF START>0 THEN")
+         (emit "      SCANPOS=END")
+         (emit "      SCANTXT$=MID$(SCANSRC$,START,END-1)")
+         (emit "      SCANTOK$=SCANTXT$")
+         (emit "    ELSE"))
+       (when nan-terminals
+         (emit "      MATCHREGEXP  \"~A\" SCANSRC$,SCANPOS INTO START,END" ',lit-nan-terminals-regexp)
+         (emit "      IF START>0 THEN")
+         (emit "        SCANPOS=END")
+         (emit "        SCANTXT$=MID$(SCANSRC$,START,END)")
+         (emit "        SCANTOK$=SCANTXT$")
+         (emit "      ELSE"))
+       ,@(labels ((gen (terminals)
+                       (if (null terminals)
+                           `( (emit "       PRINT \"ERROR: AT POSITION\",CURPOS,\"EXPECTED \",TOKEN$,\" NOT \",CURTOK$")
+                              (emit "       STOP"))
+                           (let ((terminal (car terminals)))
+                             `(
+                               (emit "   MATCHREGEXP \"^(~A)\" SCANSRC$,SCANPOS INTO START,END" ',(second terminal))
+                               (emit "   IF START>0 THEN")
+                               (emit "        SCANPOS=END")
+                               (emit "        SCANTXT$=MID$(SCANSRC$,START,END)")
+                               (emit "        SCANTOK$=\"~A\"" ',(first terminal))
+                               (emit "   ELSE")
+                               ,@(gen (cdr terminals))
+                               (emit "   ENDIF"))))))
+                 (gen  (grammar-terminals grammar)))
+       (when nan-terminals (emit "      ENDIF"))
+       (when an-terminals  (emit "    ENDIF"))
+       (emit "  ENDIF")
+       ,@(when trace `((emit "PRINT \"< ~A\"" ',(symbol-name fname))))
+       (emit "ENDSUB"))))
+
+
+(defmethod gen-parse-function-name ((target (eql :basic)) grammar non-terminal)
+   (format nil "PARSE~A" non-terminal))
+
+(defmethod gen-in-firsts ((target (eql :basic)) firsts)
+  (format nil "(~{CURTOK$=\"~A\"~^ OR ~})"  firsts))
+
+
+(defparameter *lex* 0)
+
+(defmethod gen-parsing-statement ((target (eql :basic)) grammar item)
+  (if (atom item)
+      (if (terminalp grammar item)
+          `(emit "TOKEN$=~S : CALL ACCEPT" ',(string item))
+          (let* ((firsts (first-rhs grammar item))
+                 (emptyp (member nil firsts)))
+            `(progn
+               (emit "IF ~A THEN" ',(gen-in-firsts target (remove nil firsts)))
+               (emit "  CALL ~A" ',(gen-parse-function-name target grammar item))
+               (emit "ELSE")
+               ,(if emptyp
+                    `(emit "  RET=NIL")
+                    `(progn
+                       (emit "  PRINT \"ERROR: UNEXPECTED TOKEN \",SCANTOK$")
+                       (emit "  STOP")))
+               (emit "ENDIF"))))
+      (ecase (car item)
+        ((seq)
+         (destructuring-bind (seq items actions) item
+           (let ((index 0)
+                 (lex (incf *lex*)))
+             `(progn
+                ,@(mapcar (lambda (item)
+                            `(progn
+                               ,(gen-parsing-statement target grammar item)
+                               (emit "L~DA~D=RES" ,lex ,(incf index))))
+                          items)
+                ,@(loop
+                     :for prev = "NIL" :then "A0"
+                     :for i :from index :downto 1
+                     :collect
+                     `(emit "A~D=L~DA~D:NCAR=A~D:NCDR=~A:CALL CONS:A0=RES"
+                            ,i ,lex ,i ,i ,prev))
+                ,@(mapcar (lambda (act) `(emit "~A" ',act)) actions)))))
+        ((rep)
+         (let ((lex (incf *lex*)))
+           `(progn
+              (emit "L~DRES=NIL" ,lex)
+              (emit "WHILE ~A"
+                    ',(gen-in-firsts target (first-rhs grammar (second item))))
+              ,(gen-parsing-statement target grammar (second item))
+              (emit "NCAR=RET:NCDR=L~DRES:CALL CONS:L~DRES=RES" ,lex ,lex)
+              (emit "ENDWHILE")
+              (emit "LIST=L~DRES:CALL REVERSE" ,lex))))
+        ((opt)
+         (let ((lex (incf *lex*)))
+           `(progn
+              (emit "L~DRES=NIL" ,lex)
+              (emit "IF ~A THEN"
+                    ',(gen-in-firsts target (first-rhs grammar (second item))))
+              ,(gen-parsing-statement target grammar (second item))
+              (emit "ELSE")
+              (emit "  RES=NIL")
+              (emit "ENDIF"))))
+        ((alt)
+         (labels ((gen (items)
+                    (if (null items)
+                        `(progn
+                           (emit "PRINT \"ERROR: DID NOT EXPECT \",CURTOK$")
+                           (emit "STOP"))
+                        `(progn
+                           (emit "IF ~A THEN"
+                                 ',(gen-in-firsts target
+                                                  (first-rhs grammar (car items))))
+                           ,(gen-parsing-statement target grammar (car items))
+                           (emit "ELSE")
+                           ,(gen (cdr items))
+                           (emit "ENDIF")))))
+           (gen (second item)))))))
+
+
+(defmethod generate-nt-parser ((target (eql :basic)) grammar non-terminal &key (trace nil))
+  (let ((fname (gen-parse-function-name target grammar non-terminal)))
+    `(progn
+       (emit "SUB ~A" ',fname)
+       ,@(when trace `((emit "PRINT \"> ~A\"" ',(symbol-name fname))))
+       ,(gen-parsing-statement target grammar (find-rule grammar non-terminal))
+       ,@(when trace `((emit "PRINT \"< ~A\"" ',(symbol-name fname))))
+       (emit "ENDSUB"))))
+
+
+(defmethod generate-parser ((target (eql :basic)) grammar &key (trace nil))
+  (let ((scanner-function (gen-scanner-function-name target (grammar-name grammar)))
+        (fname (gen-parse-function-name target grammar (grammar-name grammar))))
+    `(progn
+       (emit "SUB ~A" ',fname)
+       ,@(when trace `((emit "PRINT \"> ~A\"" ',(symbol-name fname))))
+       (emit "  SCANSRC$=SOURCE$ : SCANPOS=0 : SCANFUN$=\"~A\"" ',scanner-function)
+       (emit "  CALL SCANFUN$")
+       (emit "  CALL ~A" ',(gen-parse-function-name target grammar (grammar-start grammar)))
+       (emit "  IF SCANEOF<>0 THEN")
+       (emit "    PRINT \"ERROR: END OF SOURCE NOT REACHED\"")
+       (emit "    STOP")
+       (emit "  ENDIF")
+       ,@(when trace `((emit "PRINT \"< ~A\"" ',(symbol-name fname))))
+       (emit "ENDSUB"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; THE END ;;;;
diff --git a/rdp/rdp-macro.lisp b/rdp/rdp-macro.lisp
new file mode 100644
index 0000000..175ebb8
--- /dev/null
+++ b/rdp/rdp-macro.lisp
@@ -0,0 +1,209 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               rdp-macro.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    The defgrammar macro.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Extracted from rdp.lisp.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(in-package "COM.INFORMATIMAGO.RDP")
+
+
+(defmacro defgrammar (name &key terminals (scanner t) (skip-spaces t)
+                      start rules
+                      (target-language :lisp) (trace nil))
+  "
+DO:     This macros generates a simple scanner and recursive decent parser
+        for the language described by this grammar.
+        For each <non-terminal> in the grammar, a function named
+        <name>/PARSE-<non-terminal> is generated, in addition to
+        functions SCAN-<name> and PARSE-<name>.
+        The grammar structure is also generated for run-time
+        in the global special variable <name>.
+
+
+TERMINALS:
+
+        A liste of couples (name-of-terminals regexp-of-terminal).
+
+        Note that terminals don't necessarily have a name since they
+        may be written directly in the grammar rules as strings.
+
+
+SCANNER:
+
+        Can be either:
+        - T            A scanner is generated.
+        - NIL          No scanner is generated.
+        - a class-name subclass of COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER
+                       which is used to get tokens.
+
+SKIP-SPACES:
+
+        When false, the spaces are not eaten between token.  It's up
+        to the grammar or the scanner to deal with them.  (Only when a
+        scanner is generated with :scanner t).
+
+START:
+
+        The start symbol (non-terminal).
+
+RULES:
+
+        A list of grammar rules.
+
+
+TARGET-LANGUAGE:
+
+        Specifies the language into which the code is generated, as a
+        keyword.  The actions must still be written as lisp
+        expressions, but to generate the language specified.  There
+        must be a set of methods specialized on this target-language
+        keyword.
+
+TRACE:
+
+        When true, the parser functions are traced..
+
+
+SYNTAX:
+
+    (defgrammar <name>
+        :terminals (( <terminal>       \"regexp\" [ / \"regexp\" ]) ...)
+        :start        <non-terminal>
+        :rules     ((--> <non-terminal> <items> ) ...))
+
+    <items>            ::= | <item> <items>
+    <item>             ::= <seq> | <rep> | <alt> | <opt>
+                           | <non-terminal> | <literal-terminal> | <terminal>
+    <seq>              ::= (SEQ <items> <action>) ; <items> may be empty.
+    <rep>              ::= (REP <item> <items> <action>)
+    <opt>              ::= (OPT <item> <items> <action>)
+    <alt>              ::= (ALT <item> <items>)
+    <action>           ::= | :ACTION <forms>
+    <forms>            ::= | <form> <forms>
+    <form>             ::= form        -- any lisp form.
+    <non-terminal>     ::= symbol      -- any lisp symbol (keywords reserved).
+    <terminal>         ::= symbol      -- any lisp symbol (keywords reserved).
+    <literal-terminal> ::= string      -- any lisp string.
+
+SEMANTICS:
+
+        The terminals are either named terminals listed in the :TERMINALS
+        clause, or literal terminals written directly in the productions as
+        lisp strings.  They are matched as-is.
+
+        An extended regular expression regex(7) may be given that
+        will be matched by the scanner to infer the given terminal.
+        The literal terminals are matched first, the longest first,
+        and with ([A-Za-z0-9]|$) appended to terminals ending in a
+        letter or digit (so that they don't match when part of a
+        longer identifier).
+        Then the regular expressions are matched in the order given.
+
+        A second regexp can be given for a terminal, which must not be
+        matched, after the first regexp, for the terminal to be
+        recognized.  (:terminals ((alpha \"[A-Za-z]+\" / \"[0-9]\")))
+        will recognize \"abcd, efgh\" as the ALPHA \"abcd\", but
+        won't recognize \"abcd42, efgh\" as an ALPHA.
+
+        :START specifies the start non-terminal symbol.
+
+        The non-terminal symbols are infered implicitely from the grammar rules.
+
+        If there are more than one subforms, or an action,
+        the REP and OPT forms take an implicit SEQ:
+          (REP a b c :ACTION f)   -->  (REP (SEQ a b c :ACTION f))
+          (OPT a b c :ACTION f)   -->  (OPT (SEQ a b c :ACTION f))
+          (REP a :ACTION f)       -->  (REP (SEQ a :ACTION f))
+          (OPT a :ACTION f)       -->  (OPT (SEQ a :ACTION f))
+          (REP a)                 -->  (REP a)
+          (OPT a)                 -->  (OPT a)
+
+        Embedded ALT are flattened:
+          (ALT a b (ALT c d) e f) --> (ALT a b c d e f)
+
+        Actions are executed in a lexical environment where the
+        symbols $1, $2, etc are bound to the results of the
+        subforms. $0 is bound to the  list of the results of the
+        subforms.  In addition, for each non-terminal the non-terminal
+        symbol is bound to the result of the corresponding subform.
+        When the non-terminal is present several times in the
+        production, a dot and an index number is appended.
+
+            (--> example
+                 (seq thing item \",\" item (opt \",\" item
+                                                :action (list item))
+                      :action (list thing item.1 item.2 $5)))
+
+            would build a list with the results of parsing thing, the
+            two items, and the optional part.
+
+        The action for REP is to return a possibly empty list of the
+        results of its single subform repeated.  (REP is 0 or more).
+
+        The action for OPT is to return either NIL, or the result of
+        its single subform unchanged.
+
+        The action for an ALT is to return the result of the selected
+        alternative unchanged.
+
+        The default action for an internal SEQ is to return the list of the
+        results of its subforms.
+
+        The default action for an implicit SEQ for a given <non-terminal> lhs
+        is to return the list of the results of its subforms prefixed by the
+        <non-terminal> symbol.
+
+TODO:   We could also flatten sequences without action, or even sequences with
+        actions with renumbering.
+"
+  (dolist (terminal terminals)
+    (assert (or (and (= 2 (length terminal))
+                     (symbolp (first terminal))
+                     (stringp (second terminal)))
+                (and (= 4 (length terminal))
+                     (symbolp (first terminal))
+                     (stringp (second terminal))
+                     (symbolp (third terminal))
+                     (string= "/" (third terminal))
+                     (stringp (fourth terminal))))
+            (terminal)
+            "Invalid terminal clause ~S.~%Should be (terminal \"regexp\") or (terminal \"regexp\" / \"regexp\")."
+            terminal))
+  (generate-grammar name
+                    :terminals terminals
+                    :scanner scanner
+                    :skip-spaces skip-spaces
+                    :start start
+                    :rules rules
+                    :target-language target-language
+                    :trace trace))
+
+;;;; THE END ;;;;
diff --git a/rdp/rdp.lisp b/rdp/rdp.lisp
new file mode 100644
index 0000000..9b1b1ee
--- /dev/null
+++ b/rdp/rdp.lisp
@@ -0,0 +1,1283 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               rdp.lisp
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    Implements a simple recursive descent parser.
+;;;;
+;;;;    http://en.wikipedia.org/wiki/Formal_grammar
+;;;;    http://en.wikipedia.org/wiki/Recursive_descent_parser
+;;;;    http://en.wikipedia.org/wiki/Parsing_expression_grammar
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2012-02-24 <PJB> Upgraded for use in com.informatimago.lse;
+;;;;                     Changed to AGPL3 license.
+;;;;    2011-01-12 <PJB> Added grammar parameter to functions
+;;;;                     generating function names so that different
+;;;;                     grammars with non-terminals named the same
+;;;;                     don't collide.
+;;;;    2006-09-09 <PJB> Created
+;;;;BUGS
+;;;;
+;;;;    The First set of a non-terminal that can reduce to the empty string
+;;;;    should include the Follow set of this non-terminal, but for this,
+;;;;    we'd have to normalize the grammar rules, and then generate parsing
+;;;;    functions that don't correspond directly to the source rules.
+;;;;
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal Bourguignon 2006 - 2012
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, 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 Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+;;;;**************************************************************************
+
+(eval-when (:execute :compile-toplevel :load-toplevel)
+  (setf *features* (cons :use-ppcre (set-difference *features* '(:use-ppcre :use-regexp)))))
+
+
+(defpackage "COM.INFORMATIMAGO.RDP"
+  (:use "COMMON-LISP"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.CONSTRAINTS"
+        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.PEEK-STREAM"
+        "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER")
+  (:export "DEFGRAMMAR" "SEQ" "REP" "OPT" "ALT" "GRAMMAR-NAMED"
+           "GENERATE-GRAMMAR"
+
+           "GRAMMAR" "MAKE-GRAMMAR" "COPY-GRAMMAR"
+           "GRAMMAR-NAME" "GRAMMAR-TERMINALS" "GRAMMAR-START" "GRAMMAR-RULES"
+           "GRAMMAR-ALL-TERMINALS" "GRAMMAR-ALL-NON-TERMINALS"
+           "GRAMMAR-SKIP-SPACES"
+
+           "FIND-RULE" "TERMINALP" "NON-TERMINAL-P"
+           "FIRST-SET" "FOLLOW-SET" "NULLABLEP"
+
+           "CLEAN-RULES"
+           "NORMALIZE-GRAMMAR" "COMPUTE-FIRST-SETS" "COMPUTE-FOLLOW-SETS"
+
+           "$0"
+
+           "*NON-TERMINAL-STACK*"
+           ;; Re-export form com.informatimago.common-lisp.parser.scanner:
+           "TOKEN" "TOKEN-KIND" "TOKEN-TEXT" "TOKEN-LINE" "TOKEN-COLUMN"
+           "*SPACE*" "WORD-EQUAL"
+           "RDP-SCANNER"
+           "SCANNER-LINE" "SCANNER-COLUMN" "SCANNER-STATE" "SCANNER-CURRENT-TOKEN"
+           "SCANNER-SPACES" "SCANNER-TAB-WIDTH"
+           "SKIP-SPACES" "SCAN-NEXT-TOKEN"
+           "SCANNER-BUFFER" "SCANNER-CURRENT-TEXT"
+           "SCANNER-END-OF-SOURCE-P" "ADVANCE-LINE" "ACCEPT"
+           "PARSER-ERROR"
+           "PARSER-ERROR-LINE"
+           "PARSER-ERROR-COLUMN"
+           "PARSER-ERROR-GRAMMAR"
+           "PARSER-ERROR-SCANNER"
+           "PARSER-ERROR-NON-TERMINAL-STACK"
+           "PARSER-ERROR-FORMAT-CONTROL"
+           "PARSER-ERROR-FORMAT-ARGUMENTS"
+           "PARSER-END-OF-SOURCE-NOT-REACHED"
+           "PARSER-ERROR-UNEXPECTED-TOKEN"
+           "PARSER-ERROR-EXPECTED-TOKEN")
+  (:documentation "
+This package implements a simple recursive descent parser.
+
+Copyright Pascal Bourguignon 2006 - 2012
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU Affero General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+"))
+(in-package "COM.INFORMATIMAGO.RDP")
+
+
+
+(defstruct (grammar
+             (:print-function (lambda (object stream depth)
+                                (declare (ignore depth))
+                                (print-unreadable-object (object stream :type t :identity t)
+                                  (format stream "~A" (grammar-name object))))))
+  name terminals start rules
+  all-terminals
+  all-non-terminals
+  ;; ---
+  (scanner     t)
+  (skip-spaces t)
+  ;; --- computed:
+  first-function
+  follow-function)
+
+
+
+
+(defvar *grammars* (make-hash-table)
+  "Records the variables defined with DEFGRAMMAR.
+Use (GRAMMAR-NAMED name) to look up a grammar.")
+
+(defun grammar-named (name)
+  "Returns the grammar named NAME, or NIL if none."
+  (gethash name *grammars*))
+
+
+
+
+(defgeneric generate-boilerplate (target-language grammar &key trace)
+  (:documentation "Generate the boilerplate code needed by the scanner and parser.
+
+This code must be a single lisp form.  In the case of the :lisp
+target-language, this form is the code of the boilerplate itself.  For
+another language, this form is lisp code used to generate that other
+language boilerplate."))
+
+
+(defgeneric generate-scanner     (target-language grammar &key trace)
+    (:documentation "Generate the scanner code,
+when (grammar-scanner grammar) is T.  (grammar-scanner grammar) may
+be the class-name of a scanner to use.
+
+This code must be a single lisp form.  In the case of the :lisp
+target-language, this form is the code of the boilerplate itself.  For
+another language, this form is lisp code used to generate that other
+language boilerplate."))
+
+
+(defgeneric generate-nt-parser   (target-language grammar non-terminal &key trace)
+    (:documentation "Generate the parser code for the given non-terminal.
+
+This code must be a single lisp form.  In the case of the :lisp
+target-language, this form is the code of the boilerplate itself.  For
+another language, this form is lisp code used to generate that other
+language boilerplate."))
+
+
+(defgeneric generate-parser      (target-language grammar &key trace)
+    (:documentation "Generate the toplevel parser code.
+
+This code must be a single lisp form.  In the case of the :lisp
+target-language, this form is the code of the boilerplate itself.  For
+another language, this form is lisp code used to generate that other
+language boilerplate."))
+
+
+
+
+;;; First, we define a grammar, with actions.
+;;; The scanner and parser is generated at macro expansion time.
+
+(defvar *linenum* 0)
+
+(defun generate-grammar (name &key terminals (scanner t) (skip-spaces t)
+                           start rules
+                           (target-language :lisp) (trace nil))
+    "
+SEE ALSO:   The docstring of DEFGRAMMAR.
+RETURN:     A form that defines the grammar object and its parser functions.
+"
+    (let* ((clean-rules (clean-rules rules))
+           (grammar (make-grammar :name name
+                                  :terminals terminals
+                                  :start start
+                                  :rules clean-rules
+                                  :scanner scanner
+                                  :skip-spaces skip-spaces))
+           (*linenum* 0)
+           (g (gensym "grammar")))
+      (setf (gethash (grammar-name grammar) *grammars*) grammar)
+      (compute-all-terminals     grammar)
+      (compute-all-non-terminals grammar)
+      (compute-first-follow      grammar)
+
+      `(let ((*linenum* 0)
+             (,g (make-grammar
+                  :name ',name
+                  :terminals ',terminals
+                  :start ',start
+                  :rules ',clean-rules
+                  :scanner ',scanner
+                  :skip-spaces ',skip-spaces)))
+         (setf (gethash (grammar-name ,g) *grammars*) ,g)
+         (compute-all-terminals     ,g)
+         (compute-all-non-terminals ,g)
+         (compute-first-follow      ,g)
+
+         ,(generate-boilerplate target-language grammar :trace trace)
+         ,(generate-scanner     target-language grammar :trace trace)
+         ,@(mapcar (lambda (non-terminal)
+                     (generate-nt-parser target-language grammar non-terminal  :trace trace))
+                   (grammar-all-non-terminals grammar))
+         ,(generate-parser target-language grammar :trace trace)
+         ',name)))
+
+
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Cleaning of the grammar rules:
+;;;
+
+;; When stored inside the grammar structure, rules must be of the
+;; cleaned form:
+;;
+;; rule    := (<lhs> <rhs>) .
+;; lhs     := <non-terminal> .
+;; rhs     := (seq <items> <actions>)
+;;          | (rep <items>)
+;;          | (opt <items>)
+;;          | (alt <items>) .
+;; items   := ( <word>* ) .
+;; word    := <rhs> | <terminal> | <non-terminal> .
+;; actions := ( <form>* ) .
+;;
+;; - a SEQ rhs may have 0 or more items in its <items> list.
+;; - a REP rhs should have exactly 1 SEQ item in its <items> list.
+;; - a OPT rhs should have exactly 1 SEQ item in its <items> list.
+;; - a ALT rhs should have 1 or more items in its <items> list.
+;;
+;; ε is represented as (seq () ('nil))
+;; ε is not expected from the user rules, but is generated in
+;; normalized grammars.
+;;
+;;
+;; FIND-RULES returns a list of <rule>s.
+;; FIND-RULE  returns a <rhs>.
+;; Notice: if there are several rules for the same non-terminal,
+;; find-rule returns a single ALT rhs with all the rhs of the rules of
+;; that non-terminal.
+
+
+(defun split-action (rhs)
+  (declare (inline))
+  (let ((separator (position :action rhs)))
+    (if separator
+        (values (subseq rhs 0 separator) (subseq rhs (1+ separator)))
+        (values rhs                      nil))))
+
+(defun clean-seq (expr)
+  (multiple-value-bind (rhs actions) (split-action (cdr expr))
+    (setf actions (or actions '($0)))
+    (let ((items (mapcar (lambda (item) (clean item)) rhs)))
+      (if (and (null actions) (or (null items) (null (cdr items))))
+          (car items)
+          (list 'seq items actions)))))
+
+(defun clean-with-action (expr)
+  (multiple-value-bind (rhs actions) (split-action (cdr expr))
+    (if (null actions)
+        (if (null rhs)
+            '(seq () ('nil))
+            `(,(car expr) (,(clean-seq `(seq ,@rhs)))))
+        `(,(car expr) (,(clean-seq `(seq ,@rhs :action ,@actions)))))))
+
+(defun clean-rep (expr) (clean-with-action expr))
+(defun clean-opt (expr) (clean-with-action expr))
+
+(defun clean-alt (expr)
+  (assert (not (find :action expr))
+          () "An ALT rule cannot have :ACTION~%Erroneous rule: ~S" expr)
+  (let ((items (mapcar (function clean) (cdr expr))))
+    (if (null (cdr items))
+        (car items)
+        `(alt ,(mapcan (lambda (item)
+                         (if (and (consp item) (eql 'alt (car item)))
+                             (second item)
+                             (list item)))
+                       items)))))
+
+(defun clean (expr)
+  (if (atom expr)
+      expr
+      (ecase (car expr)
+        ((seq) (clean-seq expr))
+        ((rep) (clean-rep expr))
+        ((alt) (clean-alt expr))
+        ((opt) (clean-opt expr)))))
+
+
+(defun clean-rules (rules)
+  (mapcar (lambda (rule)
+            (destructuring-bind (--> non-term &rest items) rule
+               (assert (string= --> '-->) () "Rules should be written as (--> <non-terminal> <rhs>)~%Invalid rule: ~S" rule)
+               `(,non-term ,(clean
+                             (if (find :action items)
+                                 `(seq ,@items)
+                                 `(seq ,@items :action `(,',non-term ,@$0)))))))
+          rules))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric word-equal (a b)
+  (:method ((a t) (b t))           (eql a b))
+  (:method ((a string) (b string)) (string= a b)))
+
+(defun compute-all-terminals (grammar)
+  (labels  ((find-strings (items)
+              (cond
+                ((stringp items) (list items))
+                ((atom items)    '())
+                (t (mapcan (function find-strings) (second items))))))
+    (setf (grammar-all-terminals grammar)
+          (delete-duplicates
+           (nconc
+            (mapcar (function first) (grammar-terminals grammar))
+            (mapcan (function find-strings)
+                    (mapcar (function second) (grammar-rules grammar))))
+           :test (function word-equal)))))
+
+
+(defun compute-all-non-terminals (grammar)
+  (labels ((find-symbols (items)
+             (cond
+               ((symbolp items) (list items))
+               ((atom items)    '())
+               (t (mapcan (function find-symbols) (second items))))))
+    (setf (grammar-all-non-terminals grammar)
+          (nset-difference
+           (delete-duplicates
+            (nconc
+             (list (grammar-start grammar))
+             (mapcar (function first) (grammar-rules grammar))
+             (mapcan (function find-symbols)
+                     (mapcar (function second) (grammar-rules grammar)))))
+           (grammar-all-terminals grammar)))))
+
+
+
+;;; To implement the follow-set function we need to put the grammar
+;;; into a normal form.
+;;; We don't really need it to generate a simplistic recursive descent
+;;; parser.
+
+
+(defun terminalp (grammar item)
+  (member item (grammar-all-terminals grammar)
+          :test (function word-equal)))
+
+(defun non-terminal-p (grammar item)
+  (member item (grammar-all-non-terminals grammar)))
+
+
+(defun find-rules (grammar non-terminal)
+  "
+RETURN: all the produtions with NON-TERMINAL as left-hand-side.
+PRE:    (non-terminal-p non-terminal)
+"
+  (let ((rules (mapcar (function second)
+                       (remove-if-not (lambda (rule) (eql non-terminal (first rule)))
+                                      (grammar-rules grammar)))))
+    (if (null rules)
+        (error "~s is not a non-terminal in the grammar ~A"
+               non-terminal (grammar-name grammar))
+        rules)))
+
+(defun find-rule (grammar non-terminal)
+  "
+RETURN: the productions with NON-TERMINAL as left-hand-side as a
+        single ALT production (or just the production if there's only
+        one).
+PRE:    (non-terminal-p non-terminal)
+"
+  (let ((rules (find-rules grammar non-terminal)))
+    (if (null (cdr rules))
+        (car rules)
+        `(alt ,rules))))
+
+
+(define-modify-macro appendf (&rest args)  append "Append onto list")
+
+(defun prepend (old &rest new-lists)
+  (apply (function append) (append new-lists (list old))))
+(define-modify-macro prependf (&rest args) prepend "Prepend onto list")
+
+
+
+(defun compute-first-sets (grammar)
+  "
+PRE:    The GRAMMAR must be normalized.
+        (ie. containly only SEQ rules)
+
+DO:     Signals an error if there are duplicates in the first set of a non-terminal.
+RETURN: A hash-table containing the first-set for each symbol of the
+        grammar.  (terminals and non terminals).
+"
+  (let ((first-sets (make-hash-table :test (function equal))))
+    (labels ((first-set (symbol)
+               (let ((entry (gethash symbol first-sets)))
+                 (cond (entry
+                        (if (eq :error entry)
+                            (error "There's a left recursion involving the symbol ~S in the grammar ~A"
+                                   symbol (grammar-name grammar))
+                            entry))
+                       ((terminalp grammar symbol)
+                        (setf (gethash symbol first-sets)
+                              (list symbol)))
+                       ((compute-first-set symbol)))))
+             (compute-first-set (non-terminal)
+               (setf (gethash non-terminal first-sets) :error)
+               (let ((first-set '()))
+                 (dolist (rule (find-rules grammar non-terminal))
+                   (destructuring-bind (seq sentence &optional action) rule
+                     (declare (ignore seq action))
+                     (if (null sentence)
+                         (push nil first-set)
+                         (loop
+                           :with all-firsts = '()
+                           :for item :in sentence
+                           :for firsts = (first-set item)
+                           :do      (setf all-firsts (union firsts (delete nil all-firsts)))
+                           :while   (member nil firsts)
+                           :finally (prependf first-set all-firsts)))))
+                 (let ((unique-first-set  (remove-duplicates first-set :test (function equal))))
+                   (assert (= (length first-set) (length unique-first-set))
+                           () "There are duplicates in the first sets of the rules for the non-terminal ~S: ~S"
+                           non-terminal (duplicates first-set))
+                  (setf (gethash non-terminal first-sets) unique-first-set)))))
+      (map nil (function first-set) (grammar-all-terminals grammar))
+      (map nil (function first-set) (grammar-all-non-terminals grammar)))
+    first-sets))
+
+
+(defun compute-first-function (grammar)
+  "
+PRE:    The GRAMMAR must be normalized.
+        (ie. containly only SEQ rules)
+RETURN: The first-set function for the grammar symbols.
+"
+  (let ((first-sets (compute-first-sets grammar)))
+    (setf (grammar-first-function grammar)
+          (lambda (symbol-or-sequence)
+            (labels ((first-set (item)
+                       (cond
+                         ((null item) nil)
+                         ((atom item)
+                          (multiple-value-bind (first-set presentp) (gethash item first-sets)
+                            (if presentp
+                                first-set
+                                (error "~S is not a symbol of the grammar ~A"
+                                       item (grammar-name grammar)))))
+                         (t (loop
+                               :with result = '()
+                               :for item :in symbol-or-sequence
+                               :for first-set = (first-set item)
+                               :do (prependf result first-set)
+                               :while (member nil first-set)
+                               :finally (return (delete-duplicates result :test (function equal))))))))
+              (first-set symbol-or-sequence))))))
+
+
+(defun nullablep (grammar sentence)
+  (cond
+    ((null  sentence)
+     t)
+    ((listp sentence)
+     (every (lambda (word) (nullablep grammar word)) sentence))
+    ((terminalp grammar sentence)
+     nil)
+    ((non-terminal-p grammar sentence)
+     (labels ((nullable-rule-p (rule)
+                (if (atom rule)
+                    (nullablep grammar rule)
+                    (ecase (first rule)
+                      ((seq rep) (every (lambda (item) (nullable-rule-p item))
+                                        (second rule)))
+                      ((opt) t)
+                      ((alt) (some (lambda (item) (nullable-rule-p item))
+                                   (second rule)))))))
+       (nullable-rule-p (find-rule grammar sentence))))))
+
+
+(defvar *eof-symbol* (make-symbol "EOF")
+  "The symbol used to denote the End-Of-Source in the follow-sets.")
+
+(defun compute-follow-sets (grammar)
+  "
+PRE:    The GRAMMAR must be normalized.
+        (ie. containly only SEQ rules)
+RETURN: A hash-table containing the follow-set for each non-terminal
+        of the grammar.
+"
+  (let ((base-constraints      '())
+        (recursive-constraints '()))
+    (flet ((first-set (item) (first-set grammar item)))
+      ;; {$EOF$} ⊂ (follow-set start)
+      (push `(subset (set ,*eof-symbol*) (follow-set ,(grammar-start grammar)))
+            base-constraints)
+      (dolist (rule (grammar-rules grammar))
+        (destructuring-bind (non-terminal (seq symbols action)) rule
+          (declare (ignore seq action))
+          (when symbols
+            (loop
+               :for (n . beta) :on symbols
+               :do (when (non-terminal-p grammar n)
+                     (let ((m (first-set beta)))
+                       (when beta
+                         ;; (first-set beta)āˆ–{ε} ⊂ (follow-set n)
+                         (push `(subset (set ,@m) (follow-set ,n)) base-constraints))
+                       (when (and (not (eql n non-terminal)) (nullablep grammar beta))
+                         ;; (follow-set non-terminal) ⊂ (follow-set n)
+                         (push (list non-terminal n) recursive-constraints)))))))))
+    (let ((follow-sets (make-hash-table)))
+      ;; initialize the follow-sets:
+      (dolist (non-terminal (grammar-all-non-terminals  grammar))
+        (setf (gethash non-terminal follow-sets) '()))
+
+      ;; apply the base-constraints:
+      (loop
+         :for constraint :in base-constraints
+         :do (destructuring-bind (subset (set &rest elements) (follow-set non-terminal)) constraint
+               (declare (ignore subset set follow-set))
+               (setf (gethash non-terminal follow-sets)
+                     (union (gethash non-terminal follow-sets)
+                            (remove nil elements)))))
+
+      ;; resolve the recursive constraints:
+      (solve-constraints recursive-constraints
+                         (lambda (subset superset)
+                           (let ((old-cardinal (length (gethash superset follow-sets))))
+                             (setf (gethash superset follow-sets)
+                                   (union (gethash subset   follow-sets)
+                                          (gethash superset follow-sets)))
+                             (/= (length (gethash superset follow-sets)) old-cardinal))))
+      follow-sets)))
+
+
+(defun compute-follow-function (grammar &optional non-terminals)
+  "
+PRE:    The GRAMMAR must be normalized.
+        (ie. containly only SEQ rules)
+
+NON-TERMINAL: When given, it's the list of non-terminals of the
+              non-normalized grammar which we are interested in.
+
+RETURN: The follow-set function for the grammar non-terminals.
+"
+  (let ((follow-sets
+         (if non-terminals
+             (let ((follow-sets (make-hash-table :size (length non-terminals)))
+                   (normalized-follow-sets (compute-follow-sets grammar)))
+               (dolist (non-terminal non-terminals follow-sets)
+                 (setf (gethash non-terminal follow-sets)
+                       (gethash non-terminal normalized-follow-sets))))
+             (compute-follow-sets grammar))))
+    ;; build the resulting function.
+    (setf (grammar-follow-function grammar)
+          (lambda (non-terminal)
+            (or (gethash non-terminal follow-sets)
+                (error "~S is not a non-terminal of the grammar ~A"
+                       non-terminal (grammar-name grammar)))))))
+
+
+
+(defun compute-first-follow (grammar)
+  (let ((ng (normalize-grammar grammar)))
+    (setf (grammar-first-function  grammar) (compute-first-function ng)
+          (grammar-follow-function grammar)
+          (compute-follow-function ng (grammar-all-non-terminals grammar)))
+    grammar))
+
+(defun first-set (grammar symbol)
+  (unless (grammar-first-function grammar)
+    (compute-first-follow grammar))
+  (funcall (grammar-first-function grammar) symbol))
+
+(defun follow-set (grammar non-terminal)
+  (unless (grammar-follow-function grammar)
+    (compute-first-follow grammar))
+  (funcall (grammar-follow-function grammar) non-terminal))
+
+
+
+;;; Follow set.
+;;; Normalization of the grammar.
+;;; Each rule is put under the form:  a --> ε   or   a --> e a
+
+
+(defun make-new-non-terminal (base-nt non-terminals)
+  (loop
+     :for i :from 1
+     :for new-nt = (intern (format nil "~A-~A" base-nt i))
+     :while (member new-nt non-terminals)
+     :finally (return new-nt)))
+
+
+(defun normalize-grammar-rules (rules non-terminals)
+  "
+Substitute any sub-expressions in the rhs with a new non-terminal and
+a new production.  Then replace the rep, opt, and alt rules with seq
+rules and new produtions.  Returns the new production set.
+"
+  (values
+   (loop
+      :while rules ; :for is always evaluated before :while
+      :collect (let ((rule (pop rules)))
+                 (destructuring-bind (nt rhs) rule
+                   (labels ((new-rule (rule)
+                              (push (first rule) non-terminals)
+                              (push rule rules))
+                            (process-item (item)
+                              (if (listp item)
+                                  (let ((new-nt (make-new-non-terminal nt non-terminals)))
+                                    (new-rule (list new-nt item))
+                                    new-nt)
+                                  item)))
+                     (let ((op (first rhs)))
+                       (ecase op
+                         ((seq)
+                          (destructuring-bind (op items actions) rhs
+                            (list nt (list* op (mapcar (function process-item) items)
+                                            (when actions (list actions))))))
+                         ((rep)
+                          ;; a --> (rep e)
+                          ;; -------------
+                          ;; a --> ε   :action '()
+                          ;; a --> e a :action (cons $1 $2)
+                          (destructuring-bind (op items) rhs
+                            (declare (ignore op))
+                            (new-rule (list nt '(seq () ('()))))
+                            (list nt `(seq (,(process-item (first items)) ,nt)
+                                           ((cons $1 $2))))))
+                         ((opt)
+                          ;; a --> (opt e)
+                          ;; -------------
+                          ;; a --> ε :action '()
+                          ;; a --> e :action (list $1)
+                          (destructuring-bind (op items) rhs
+                            (declare (ignore op))
+                            (new-rule (list nt '(seq () ('()))))
+                            (list nt `(seq (,(process-item (first items)))
+                                           ((list $1))))))
+                         ((alt)
+                          ;; a --> (alt eā‚ ... eν)
+                          ;; -------------
+                          ;; a --> eā‚ :action $0
+                          ;; ...
+                          ;; a --> eν :action $0
+                          (destructuring-bind (op items) rhs
+                            (declare (ignore op))
+                            (let ((new-items  (mapcar (function process-item) items)))
+                              (dolist (new-item (rest new-items)
+                                       (list nt `(seq (,(first new-items)) (($0)))))
+                                (new-rule (list nt `(seq (,new-item) (($0)))))))))))))))
+   non-terminals))
+
+
+
+
+(defun normalize-grammar (grammar)
+  "Return a new normalized grammar parsing the same language as GRAMMAR."
+  (let ((new-grammar (make-grammar
+                      :name (intern (format nil "NORMALIZED-~A"
+                                            (grammar-name grammar)))
+                      :terminals (grammar-terminals grammar)
+                      :start (grammar-start grammar)
+                      :rules (normalize-grammar-rules (grammar-rules grammar)
+                                                      (grammar-all-non-terminals grammar))
+                      :skip-spaces (grammar-skip-spaces grammar))))
+    (setf (gethash (grammar-name new-grammar) *grammars*) new-grammar)
+    (compute-all-terminals     new-grammar)
+    (compute-all-non-terminals new-grammar)
+    new-grammar))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Regexp Portability Layer.
+;;;
+;;; Used by the code generated by the Lisp generator below.
+;;;
+;;; On clisp, the user can choose to use the REGEXP package instead of
+;;; CL-PPCRE, by adjoining :use-regexp instead of :use-ppcre to
+;;; *features* (see the beginning of this file).
+
+
+
+;; (:export "SPLIT-STRING"
+;;          "STRING-MATCH" "MATCH-STRING" "MATCH-BEGINNING" "MATCH-END"
+;;          "REGEXP-MATCh-ANY" "REGEXP-COMPILE" "REGEXP-QUOTE-EXTENDED")
+
+
+(defun split-string (string regexp)
+  #-(or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'split-string)
+  #+(and clisp use-regexp) (regexp:regexp-split regexp string)
+  #+use-ppcre (cl-ppcre:split regexp string))
+
+
+(defvar *string-match-results* '())
+
+#+(and clisp use-regexp)
+(defun nsubseq (sequence start &optional (end nil))
+  "
+RETURN:  When the SEQUENCE is a vector, the SEQUENCE itself, or a dispaced
+         array to the SEQUENCE.
+         When the SEQUENCE is a list, it may destroy the list and reuse the
+         cons cells to make the subsequence.
+"
+  (if (vectorp sequence)
+      (if (and (zerop start) (or (null end) (= end (length sequence))))
+          sequence
+          (make-array (- (if end
+                             (min end (length sequence))
+                             (length sequence))
+                         start)
+                      :element-type (array-element-type sequence)
+                      :displaced-to sequence
+                      :displaced-index-offset start))
+      (let ((result (nthcdr start sequence)))
+        (when end
+          (setf (cdr (nthcdr (- end start -1) sequence)) nil))
+        result)))
+
+(defun string-match (regexp string &key (start 0) (end nil))
+  #-(or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'split-match)
+  #+(and clisp use-regexp)
+  (setf *string-match-results*
+         (let ((results (if (stringp regexp)
+                           (multiple-value-list
+                            (regexp:match regexp string :start start :end end :extended t :ignore-case nil :newline t :nosub nil))
+                           (regexp:regexp-exec (cdr regexp) string :start start :end end :return-type 'list))))
+          (if (equal '(nil) results)
+              nil
+              results)))
+  #+use-ppcre
+  (setf *string-match-results*
+        (let ((results (multiple-value-list
+                        (if (stringp regexp)
+                            (cl-ppcre:scan regexp       string :start start :end (or end (length string)))
+                            (cl-ppcre:scan (cdr regexp) string :start start :end (or end (length string)))))))
+          (if (equal '(nil) results)
+              nil
+              (destructuring-bind (as ae ss es) results
+                  (list as ae
+                        (concatenate 'vector (vector as) ss)
+                        (concatenate 'vector (vector ae) es)))))))
+
+(defun match-string (index string &optional (match-results *string-match-results*))
+  #-(or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-string)
+  #+(and clisp use-regexp)
+  (let ((m (elt match-results index)))
+    (when m (regexp:match-string string m)))
+  #+use-ppcre
+  (let ((start (ignore-errors (aref (elt match-results 2) index)))
+        (end   (ignore-errors (aref (elt match-results 3) index))))
+    (when (and start end)
+      (subseq string start end))))
+
+(defun match-beginning (index &optional (match-results *string-match-results*))
+  #-(or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-beginning)
+  #+(and clisp use-regexp)
+  (let ((m (elt match-results index)))
+    (when m (regexp:match-start m)))
+  #+use-ppcre
+  (ignore-errors (aref (elt match-results 2) index)))
+
+(defun match-end (index &optional (match-results *string-match-results*))
+  #-(or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'match-end)
+  #+(and clisp use-regexp)
+  (let ((m (elt match-results index)))
+    (when m (regexp:match-end m)))
+  #+use-ppcre
+  (ignore-errors (aref (elt match-results 3) index)))
+
+(defun regexp-match-any (groupsp)
+  #- (or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'regexp-match-any)
+  #+(and clisp use-regexp) (if groupsp "(.*)" ".*")
+  #+use-ppcre              (if groupsp "(.*)" ".*"))
+
+(defun regexp-compile (regexp)
+  #- (or use-ppcre (and clisp use-regexp))
+  (error "Please implement ~S (perhaps push :use-ppcre on *features*)." 'regexp-compile)
+  #+(and clisp use-regexp) (regexp:regexp-compile regexp
+                                                  :extended t
+                                                  :ignore-case nil
+                                                  :newline t
+                                                  :nosub nil)
+  #+use-ppcre (cl-ppcre:create-scanner regexp
+                                       :case-insensitive-mode nil
+                                       :multi-line-mode nil
+                                       :extended-mode nil
+                                       :destructive nil))
+
+(defun regexp-quote-extended (string)
+  ;; #+clisp regexp:regexp-quote doesn't quote extended regexps...
+  ;;        (regexp:regexp-quote "(abc .*" t) --> "(abc \\.\\*"  instead of "\\(abc \\.\\*"
+  #-use-ppcre
+  (let* ((special-characters "^.[$()|*+?{\\")
+         (increase (count-if (lambda (ch) (find ch special-characters)) string)))
+     (if (zerop increase)
+         string
+         (let ((result (make-array (+ (length string) increase)
+                                    :element-type 'character)))
+           (loop
+              :with i = -1
+              :for ch :across string
+              :do (if (find ch special-characters)
+                      (setf (aref result (incf i)) #\\
+                            (aref result (incf i)) ch)
+                      (setf (aref result (incf i)) ch)))
+           result)))
+  #+use-ppcre
+  (cl-ppcre:quote-meta-chars string))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Generator -- LISP
+;;;
+
+(defvar *boilerplate-generated* nil)
+;; (setf *boilerplate-generated* nil)
+
+
+(defmethod generate-boilerplate ((target (eql :lisp)) (grammar grammar) &key (trace nil))
+  (declare (ignore trace))
+  (if *boilerplate-generated*
+      nil
+      (progn
+        (setf *boilerplate-generated* t)
+        `(progn
+
+           (defvar *non-terminal-stack* '()
+             "For error reporting.")
+
+           (define-condition parser-error (error)
+             ((line    :initarg :line    :initform 1   :reader parser-error-line)
+              (column  :initarg :column  :initform 0   :reader parser-error-column)
+              (grammar :initarg :grammar :initform nil :reader parser-error-grammar)
+              (scanner :initarg :scanner :initform nil :reader parser-error-scanner)
+              (non-terminal-stack :initarg :non-terminal-stack
+                                  :initform '()
+                                  :reader parser-error-non-terminal-stack)
+              (format-control     :initarg :format-control
+                                  :initform ""
+                                  :reader parser-error-format-control)
+              (format-arguments   :initarg :format-arguments
+                                  :initform '()
+                                  :reader parser-error-format-arguments))
+             (:report print-parser-error))
+
+           (defmethod print-parser-error ((err parser-error) stream)
+             (format stream
+                     "~&~@[~A:~]~D:~D: ~?~%"
+                     (let ((source (scanner-source (parser-error-scanner err))))
+                       (unless (stringp source) (ignore-errors (pathname source))))
+                     (parser-error-line err)
+                     (parser-error-column err)
+                     (parser-error-format-control err)
+                     (parser-error-format-arguments err)))
+
+           (define-condition parser-end-of-source-not-reached (parser-error)
+             ())
+
+           (define-condition parser-error-unexpected-token (parser-error)
+             ((expected-token :initarg :expected-token
+                              :initform nil
+                              :reader parser-error-expected-token)))
+
+
+           (defclass rdp-scanner (scanner)
+             ((buffer       :accessor scanner-buffer
+                            :type     (or null string)
+                            :initform nil)
+              (current-text :accessor scanner-current-text
+                            :initform "")))
+
+           (defmethod scanner-current-token ((scanner rdp-scanner))
+             (token-kind (call-next-method)))
+
+           (defmethod scanner-end-of-source-p ((scanner rdp-scanner))
+             (and (or (null (scanner-buffer scanner))
+                      (<= (length (scanner-buffer scanner))
+                          (scanner-column scanner)))
+                  (let ((ps  (slot-value scanner 'stream)))
+                   (not (ungetchar ps (getchar ps))))))
+
+           (defmethod advance-line ((scanner rdp-scanner))
+             "RETURN: The new current token, old next token"
+             (cond
+               ((scanner-end-of-source-p scanner)
+                #|End of File -- don't move.|#)
+               ((setf (scanner-buffer scanner) (readline (slot-value scanner 'stream)))
+                ;; got a line -- advance a token.
+                (setf (scanner-column scanner) 0)
+                (incf (scanner-line   scanner))
+                (setf (scanner-current-token scanner) nil
+                      (scanner-current-text  scanner) "")
+                (scan-next-token scanner))
+               (t
+                ;; Just got EOF
+                (setf (scanner-current-token scanner) '|<END OF FILE>|
+                      (scanner-current-text  scanner) "<END OF FILE>")))
+             (scanner-current-token scanner))
+
+           (defmethod accept ((scanner rdp-scanner) token)
+             (if (word-equal token (scanner-current-token scanner))
+                 (prog1 (list (token-kind (scanner-current-token scanner))
+                              (scanner-current-text scanner)
+                              (scanner-column scanner))
+                   (scan-next-token scanner))
+                 (error 'parser-error-unexpected-token
+                        :line   (scanner-line scanner)
+                        :column (scanner-column scanner)
+                        :grammar (grammar-named ',(grammar-name grammar))
+                        :scanner scanner
+                        :non-terminal-stack (copy-list *non-terminal-stack*)
+                        :expected-token token
+                        :format-control "Expected ~S, not ~A (~S)~%~S~%~{~A --> ~S~}"
+                        :format-arguments (list
+                                           token
+                                           (scanner-current-token scanner)
+                                           (scanner-current-text scanner)
+                                           *non-terminal-stack*
+                                           (assoc (first *non-terminal-stack*)
+                                                  ',(grammar-rules grammar))))))
+
+           (defparameter *spaces*
+             (format nil "^([~{~C~}]+)" '(#\space #\newline #\tab)))))))
+
+
+(defvar *non-terminal-stack* '()
+  "For error reporting.")
+
+(defmacro with-non-terminal (non-terminal &body body)
+  `(let ((*non-terminal-stack* (cons ',non-terminal *non-terminal-stack*)))
+     ;; (print *non-terminal-stack*)
+     ,@body))
+
+
+(defmethod gen-scanner-function-name ((target (eql :lisp)) (grammar grammar))
+  (intern (format nil "~:@(SCAN-~A~)" (grammar-name grammar))))
+
+(defmethod gen-scanner-class-name ((target (eql :lisp)) (grammar grammar))
+  (intern (format nil "~:@(~A-SCANNER~)" (grammar-name grammar))))
+
+
+(defun gen-trace (fname form trace)
+  (if trace
+      `(progn
+         ,form
+         (trace ,fname))
+      form))
+
+(defun tracep (keyword trace)
+  (or (eql keyword trace)
+      (and (listp trace) (member keyword trace))))
+
+
+(defmethod generate-scanner ((target (eql :lisp)) grammar &key (trace nil))
+  ;;
+  ;; an-terminals  = literal terminals (given as string in rules), ending with an alphanumeric.
+  ;; nan-terminals = literal terminals ending with something else than an alphanumeric.
+  ;; nl-terminals  = non-literal terminals (specified in :terminals clauses).
+  ;;
+  ;; an-terminals are scanned by excluding alphanumerics directly after them.
+  ;; "while" --> "(while)([^A-Za-z0-9]|$)"  so that "while whilemin" scans as <while> <identifier>.
+  ;;
+  ;; nl-terminals are processed in the order they're given in the :terminals clauses.
+  ;;
+  (case (grammar-scanner grammar)
+    ((t)
+     (let* ((scanner-class-name (gen-scanner-class-name target grammar))
+            ;; Literal Alpha Numeric Terminals
+            (an-terminals  (sort (remove-if-not
+                                  (lambda (item)
+                                    (and (stringp item)
+                                         (alphanumericp (aref item (1- (length item))))))
+                                  (grammar-all-terminals grammar))
+                                 (function >) :key (function length)))
+            ;; Literal Non Alpha Numeric Terminals
+            (nan-terminals (sort (remove-if
+                                  (lambda (item)
+                                    (or (not (stringp item))
+                                        (alphanumericp (aref item (1- (length item))))))
+                                  (grammar-all-terminals grammar))
+                                 (function >) :key (function length)))
+            ;; Non Literal Terminals
+            (nl-terminals (remove-if (function stringp) (grammar-terminals grammar)))
+            ;; Regexps for all the Literal Alpha Numeric Terminals
+            (lit-an-terminals-regexp
+             (format nil "^(~{~A~^|~})([^A-Za-z0-9]|$)"
+                     (mapcar (function regexp-quote-extended) an-terminals)))
+            ;; Regexps for all the Literal Non Alpha Numeric Terminals
+            (lit-nan-terminals-regexp
+             (format nil "^(~{~A~^|~})"
+                     (mapcar (function regexp-quote-extended)  nan-terminals)))
+            (form  `(progn
+
+                      (setf (grammar-scanner (gethash  ',(grammar-name grammar) *grammars*)) ',scanner-class-name)
+
+                      (defclass ,scanner-class-name  (rdp-scanner)
+                        ())
+
+                      (defmethod scan-next-token ((scanner ,scanner-class-name) &optional parser-data)
+                        (declare (ignore parser-data))
+                        (let (match)
+                          ,@(when (grammar-skip-spaces grammar)
+                                  `((setf match (string-match *spaces*
+                                                              (scanner-buffer scanner)
+                                                              :start (scanner-column scanner)))
+                                    (when match
+                                      (setf (scanner-column scanner) (match-end 1 match)))))
+                          (cond
+                            ;; end of source
+                            ((scanner-end-of-source-p scanner)
+                             (setf (scanner-column scanner)   (length (scanner-buffer scanner))
+                                   (scanner-current-token scanner) '|<END OF SOURCE>|
+                                   (scanner-current-text scanner)   "<END OF SOURCE>"))
+                            ;; Literal Alpha Numeric and Non Alpha Numeric Terminals:
+                            ,@(when (or an-terminals nan-terminals)
+                                    `(((or ,@(when an-terminals
+                                                   `((setf match (string-match ',lit-an-terminals-regexp
+                                                                               (scanner-buffer scanner)
+                                                                               :start (scanner-column scanner)))))
+                                           ,@(when nan-terminals
+                                                   `((setf match (string-match ',lit-nan-terminals-regexp
+                                                                               (scanner-buffer scanner)
+                                                                               :start (scanner-column scanner))))))
+                                       (let ((text (match-string 1 (scanner-buffer scanner) match)))
+                                        (setf (scanner-column scanner)        (match-end 1 match)
+                                              ;; TODO: See what package we intern in!
+                                              (scanner-current-token scanner) (intern text)
+                                              (scanner-current-text scanner)  text)))))
+                            ;; Non Literal Terminals: we have a regexp for each terminal.
+                            ,@(mapcar
+                               (lambda (terminal)
+                                 `(,(if (= 4 (length terminal))
+                                        ;; (terminal-name match-regexp / exclude-regexp)
+                                        `(and (setf match (string-match
+                                                           ',(format nil "^(~A)" (second terminal))
+                                                           (scanner-buffer scanner)
+                                                           :start (scanner-column scanner)))
+                                              (not (string-match ,(format nil "^(~A)" (fourth terminal))
+                                                                 (scanner-buffer scanner)
+                                                                 :start (match-end 1 match))))
+                                        ;; (terminal-name match-regexp)
+                                        `(setf match (string-match
+                                                      ',(format nil "^(~A)" (second terminal))
+                                                      (scanner-buffer scanner)
+                                                      :start (scanner-column scanner))))
+                                    (setf (scanner-column scanner)        (match-end 1 match)
+                                          (scanner-current-token scanner) ',(first terminal)
+                                          (scanner-current-text scanner)  (match-string 1 (scanner-buffer scanner) match))))
+                               nl-terminals)
+                            ;; Else we have an error:
+                            (t
+                             (error 'scanner-error-invalid-character
+                                    :line   (scanner-line   scanner)
+                                    :column (scanner-column scanner)
+                                    :state  (scanner-state  scanner)
+                                    :current-token (scanner-current-token scanner)
+                                    :scanner scanner
+                                    :invalid-character (aref (scanner-buffer scanner) (scanner-column scanner))
+                                    :format-control "Invalid character ~C at position: ~D~%~S~%~{~A --> ~S~}"
+                                    :format-arguments (list
+                                                       (aref (scanner-buffer scanner) (scanner-column scanner))
+                                                       (scanner-column scanner)
+                                                       *non-terminal-stack*
+                                                       (assoc (first *non-terminal-stack*)
+                                                              ',(grammar-rules grammar)))))))))))
+       (setf (grammar-scanner (grammar-named (grammar-name grammar))) scanner-class-name)
+       (gen-trace 'scan-next-token form trace)))
+    (otherwise
+     #|Dont do anything|#
+     `',(grammar-scanner grammar))))
+
+
+(defmethod gen-parse-function-name ((target (eql :lisp)) (grammar grammar) non-terminal)
+  (intern (format nil "~:@(~A/PARSE-~A~)" (grammar-name grammar) non-terminal)))
+
+(defmethod gen-in-firsts ((target (eql :lisp)) firsts)
+  (if (null (cdr firsts))
+      `(word-equal (scanner-current-token scanner) ',(car firsts))
+      `(member  (scanner-current-token scanner) ',firsts
+                :test (function word-equal))))
+
+
+
+
+;; (com.informatimago.rdp::find-rules (grammar-named 'normalized-encoding) 'request)
+(defstruct sentence-node word attribute)
+
+;; Not finished.
+;; (defun attribute-rule (grammar nt item)
+;;   (ecase item
+;;     ((seq)  (loop
+;;                :with result = (list (make-sentence-node :word nil :attribute (follow-set grammar nt)))
+;;                :for word :in (reverse (second item))
+;;                :do ))
+;;     ((rep))
+;;     ((opt))
+;;     ((alt)))
+;;   (if (null sentence)
+;;       (list (make-sentence-node :word nil :attribute (follow-set grammar nt)))
+;;       (let ((rest-sentence (process-sentence grammar nt (rest sentence))))
+;;        (cons (make-sentence-node :word (first sentence)
+;;                                  :attribute (if (nullablep grammar (first sentence))
+;;                                                 (remove nil (union (first-set grammar (first sentence))
+;;                                                                    (sentence-node-attribute (first rest-sentence))))
+;;                                                 (first-set grammar (first sentence))))
+;;              rest-sentence))))
+
+(defun process-sentence (grammar nt sentence)
+  (if (null sentence)
+      (list (make-sentence-node :word nil :attribute (follow-set grammar nt)))
+      (let ((rest-sentence (process-sentence grammar nt (rest sentence))))
+       (cons (make-sentence-node :word (first sentence)
+                                 :attribute (if (nullablep grammar (first sentence))
+                                                (remove nil (union (first-set grammar (first sentence))
+                                                                   (sentence-node-attribute (first rest-sentence))))
+                                                (first-set grammar (first sentence))))
+             rest-sentence))))
+
+
+(defmethod gen-parsing-statement ((target (eql :lisp)) (grammar grammar) item)
+  ;; If we want to generate the parser directly from the grammar with
+  ;; seq/rep/opt/alt, then we need to replicate the algorithm for the
+  ;; first-set of sentences here. :-(
+  (labels ((es-first-set (extended-sentence)
+             (if (atom extended-sentence)
+                 (first-set grammar extended-sentence)
+                 (ecase (car extended-sentence)
+                   ((seq) (loop
+                             :with all-firsts = '()
+                             :for item :in (second extended-sentence)
+                             :for firsts = (es-first-set item)
+                             :do (setf all-firsts (union firsts (delete nil all-firsts)))
+                             :while (member nil firsts)
+                             :finally (return all-firsts)))
+                   ((rep) (es-first-set (first (second extended-sentence))))
+                   ((opt) (union '(nil) (es-first-set (first (second extended-sentence)))))
+                   ((alt) (reduce (function union) (second extended-sentence)
+                                  :key (function es-first-set)))))))
+   (if (atom item)
+       (if (terminalp grammar item)
+           `(accept scanner ',item)
+           (let* ((firsts (es-first-set item))
+                  (emptyp (member nil firsts)))
+             (if emptyp
+                 `(when ,(gen-in-firsts target (remove nil firsts))
+                    (,(gen-parse-function-name target grammar item) scanner))
+                 `(if ,(gen-in-firsts target (remove nil firsts))
+                      (,(gen-parse-function-name target grammar item) scanner)
+                      (error 'parser-error-unexpected-token
+                             :line    (scanner-line scanner)
+                             :column  (scanner-column scanner)
+                             :grammar (grammar-named ',(grammar-name grammar))
+                             :scanner scanner
+                             :non-terminal-stack (copy-list *non-terminal-stack*)
+                             :format-control "Unexpected token ~S~%~S~%~{~A --> ~S~}"
+                             :format-arguments (list
+                                                (scanner-current-token scanner)
+                                                *non-terminal-stack*
+                                                ',(assoc item (grammar-rules grammar))))))))
+       (ecase (car item)
+         ((seq)
+          (destructuring-bind (seq items actions) item
+            (declare (ignore seq))
+            (let ((dollars (loop
+                             :for i :from 1 :to (length items)
+                             :collect (intern (format nil "$~D" i))))
+                  (ignorables '()))
+              `(let ,(mapcar (lambda (dollar item)
+                               `(,dollar ,(gen-parsing-statement target grammar item)))
+                             dollars items)
+                 (let (($0 (list ,@dollars))
+                       ;; new:
+                       ,@ (let ((increments (make-hash-table)))
+                            (mapcan (lambda (dollar item)
+                                      (when (and (or (non-terminal-p grammar item)
+                                                     (terminalp grammar item))
+                                                 (token-kind item))
+                                        (let* ((index  (incf (gethash item increments 0)))
+                                               (igno   (intern (format nil "~:@(~A.~A~)" item index))))
+                                          (pushnew item ignorables)
+                                          (push    igno ignorables)
+                                          (append (when (= 1 index)
+                                                    (list (list item dollar)))
+                                                  (list (list igno dollar))))))
+                                    dollars items))
+                       ;; ---
+                       )
+                   (declare (ignorable $0 ,@ignorables))
+                   ,@actions)))))
+         ((rep)
+          `(loop
+              :while ,(gen-in-firsts target (es-first-set (first (second item))))
+              :collect ,(gen-parsing-statement target grammar (first (second item)))))
+         ((opt)
+          `(when ,(gen-in-firsts target (es-first-set (first (second item))))
+             ,(gen-parsing-statement target grammar (first (second item)))))
+         ((alt)
+          `(cond
+             ,@(mapcar (lambda (item)
+                         `(,(gen-in-firsts target (es-first-set item))
+                            ,(gen-parsing-statement target grammar item)))
+                       (second item))))))))
+
+
+(defmethod generate-nt-parser ((target (eql :lisp)) (grammar grammar) non-terminal &key (trace nil))
+  (let* ((fname (gen-parse-function-name target grammar non-terminal))
+         (form  `(defun ,fname (scanner)
+                   ,(format nil "~S" (assoc non-terminal (grammar-rules grammar)))
+                   (with-non-terminal ,non-terminal
+                       ,(gen-parsing-statement target grammar (find-rule grammar non-terminal))))))
+    (gen-trace fname form trace)))
+
+
+(defmethod generate-parser ((target (eql :lisp)) grammar &key (trace nil))
+  (let* ((fname  (intern (format nil "~:@(PARSE-~A~)" (grammar-name grammar))))
+         (form   `(defun ,fname (source)
+                    "
+SOURCE: When the grammar has a scanner generated, or a scanner class
+        name, SOURCE can be either a string, or a stream that will be
+        scanned with the generated scanner.  Otherwise, it should be a
+        SCANNER instance.
+"
+                    (with-non-terminal ,(grammar-name grammar)
+                      (let ((scanner ,(if (grammar-scanner grammar)
+                                          `(make-instance ',(grammar-scanner grammar) :source source)
+                                          'source)))
+                        (advance-line scanner)
+                        (prog1 (,(gen-parse-function-name target grammar (grammar-start grammar))
+                                  scanner)
+                          (unless (scanner-end-of-source-p scanner)
+                            (error 'parser-end-of-source-not-reached
+                                   :line (scanner-line scanner)
+                                   :column (scanner-column scanner)
+                                   :grammar (grammar-named ',(grammar-name grammar))
+                                   :scanner scanner
+                                   :non-terminal-stack (copy-list *non-terminal-stack*)))))))))
+    (gen-trace fname form trace)))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; THE END ;;;;
diff --git a/rdp/scratch.lisp b/rdp/scratch.lisp
new file mode 100644
index 0000000..01d3e96
--- /dev/null
+++ b/rdp/scratch.lisp
@@ -0,0 +1,41 @@
+(com.informatimago.rdp.example:parse-example
+  "
+    const abc = 123,
+          pi=3.141592e+0;
+    var a,b,c;
+    procedure gcd;
+    begin
+        while a # b do
+        begin
+             if a<b then b:=b-a ;
+             if a>b then a:=a-b
+        end
+    end;
+begin
+    a:=42;
+    b:=30.0;
+    call gcd
+end.")
+
+(com.informatimago.rdp.example-without-action:parse-example-without-action
+ "
+    const abc = 123,
+          pi=3.141592e+0;
+    var a,b,c;
+    procedure gcd;
+    begin
+        while a # b do
+        begin
+             if a<b then b:=b-a ;
+             if a>b then a:=a-b
+        end
+    end;
+begin
+    a:=42;
+    b:=30.0;
+    call gcd
+end.")
+
+
+
+
ViewGit