[elpa] master f3ce070 09/60: Add simple scheme parser

[Junpeng Qiu]

branch: master
commit f3ce0702a60e60eec680ad841d9997a2551327a1
Author: Junpeng Qiu <address@hidden>
Commit: Junpeng Qiu <address@hidden>

    Add simple scheme parser
---
 scheme.el |  116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 116 insertions(+)

diff --git a/scheme.el b/scheme.el
new file mode 100644
index 0000000..121dff4
--- /dev/null
+++ b/scheme.el
@@ -0,0 +1,116 @@
+;;; scheme.el --- Scheme parser using parsec.el      -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2016  Junpeng Qiu
+
+;; Author: Junpeng Qiu <address@hidden>
+;; Keywords: extensions
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 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 General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Ref: https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/
+
+;;; Code:
+
+(defsubst scheme-bool (value)
+  (cons 'Bool value))
+
+(defsubst scheme-true ()
+  (scheme-bool 'True))
+
+(defsubst scheme-false ()
+  (scheme-bool 'False))
+
+(defsubst scheme-atom (atom)
+  (cons 'Atom atom))
+
+(defsubst scheme-number (number)
+  (cons 'Number number))
+
+(defsubst scheme-list (&rest values)
+  (cons 'List values))
+
+(defsubst scheme-dotted-list (head tail)
+  (cons 'DottedList (cons head tail)))
+
+(defsubst scheme-symbol ()
+  (parsec-re "[$!#%&|*+/:<=>address@hidden"))
+
+(defsubst scheme-spaces ()
+  (parsec-many (parsec-ch ? )))
+
+(defun scheme-parse-string ()
+  (parsec-and (parsec-ch ?\")
+              (parsec-return (parsec-many-as-string (parsec-re "[^\"]"))
+                (parsec-ch ?\"))))
+
+(defun scheme-parse-atom ()
+  (let (first rest atom)
+    (parsec-and (setq first (parsec-or (parsec-letter) (scheme-symbol)))
+                (setq rest (parsec-many (parsec-or (parsec-letter)
+                                                   (parsec-digit)
+                                                   (scheme-symbol)))))
+    (setq atom (parsec-list-to-string (cons first rest)))
+    (cond
+     ((string= atom "#t") (scheme-true))
+     ((string= atom "#f") (scheme-false))
+     (t (scheme-atom atom)))))
+
+(defun scheme-parse-number ()
+  (scheme-number
+   (string-to-number (parsec-many1-as-string (parsec-digit)))))
+
+(defun scheme-parse-list ()
+  (apply #'scheme-list (parsec-sepby (scheme-parse-expr) (scheme-spaces))))
+
+(defun scheme-parse-dotted-list ()
+  (scheme-dotted-list (parsec-endby (scheme-parse-expr) (scheme-spaces))
+                      (parsec-and
+                        (parsec-ch ?.)
+                        (scheme-spaces)
+                        (scheme-parse-expr))))
+
+(defun scheme-parse-quoted ()
+  (parsec-and
+    (parsec-ch ?\')
+    (scheme-list (scheme-atom "quote") (scheme-parse-expr))))
+
+(defun scheme-parse-expr ()
+  (parsec-or (scheme-parse-atom)
+             (scheme-parse-string)
+             (scheme-parse-number)
+             (scheme-parse-quoted)
+             (parsec-and
+               (parsec-ch ?\()
+               (parsec-or
+                (parsec-save (parsec-return (scheme-parse-list)
+                               (parsec-ch ?\))))
+                (parsec-return (scheme-parse-dotted-list)
+                  (parsec-ch ?\)))))))
+
+(defun scheme-read (expr)
+  (parsec-do-parse expr
+    (scheme-parse-expr)))
+
+(scheme-read "25")
+(scheme-read "\"This is a string\"")
+(scheme-read "(symbol)")
+(scheme-read "(a test)")
+(scheme-read "(a . test)")
+(scheme-read "(a (nested) test)")
+(scheme-read "(a '(quoted (dotted . list)) test)")
+
+(provide 'scheme)
+;;; scheme.el ends here