+;;; -*-lisp-*-
+;;;
+;;; Top-level parser for module syntax
+;;;
+;;; (c) 2010 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of the Sensble Object Design, an object system for C.
+;;;
+;;; SOD 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; SOD 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 SOD; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(in-package #:sod)
+
+;;;--------------------------------------------------------------------------
+;;; Toplevel syntax.
+
+(export 'module)
+
+;;; Type names.
+
+(define-pluggable-parser module typename (scanner)
+ ;; `typename' ID ( `,' ID )* `;'
+
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (and "typename"
+ (skip-many (:min 1)
+ (seq ((id :id))
+ (if (gethash id *module-type-map*)
+ (cerror* "Type `~A' already defined" id)
+ (add-to-module *module*
+ (make-instance 'type-item
+ :name id))))
+ #\,)
+ #\;))))
+
+;;; Fragments.
+
+(define-pluggable-parser module code (scanner)
+ ;; `code' ID `:' ID [ CONSTRAINTS ] `{' C-FRAGMENT `}'
+
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (seq ("code"
+ (reason :id)
+ #\:
+ (name :id)
+ (constraints (? (seq (#\[
+ (constraints (list (:min 1)
+ (list (:min 1) :id)
+ #\,))
+ #\])
+ constraints)))
+ (fragment (parse-delimited-fragment scanner #\{ #\})))
+ (add-to-module *module* (make-instance 'code-fragment-item
+ :fragment fragment
+ :constraints constraints
+ :reason reason
+ :name name))))))
+
+;;; External files.
+
+(defun read-module (pathname &key (truename (truename pathname)) location)
+ "Parse the file at PATHNAME as a module, returning it.
+
+ This is the main entry point for parsing module files. You may well know
+ the file's TRUENAME already (e.g., because `probe-file' dropped it into
+ your lap) so you can avoid repeating the search by providing it.
+
+ The LOCATION is the thing which wanted the module imported -- usually a
+ `file-location' object, though it might be anything other than `t' which
+ can be printed in the event of circular imports."
+
+ (define-module (pathname :location location :truename truename)
+ (with-open-file (f-stream pathname :direction :input)
+ (let* ((*readtable* (copy-readtable))
+ (char-scanner (make-instance 'charbuf-scanner
+ :stream f-stream))
+ (scanner (make-instance 'sod-token-scanner
+ :char-scanner char-scanner)))
+ (with-default-error-location (scanner)
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (skip-many () (plug module scanner)))))))))
+
+(define-pluggable-parser module test (scanner)
+ ;; `demo' STRING `;'
+
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (seq ("demo" (string :string) #\;)
+ (format t ";; DEMO ~S~%" string)))))
+
+(define-pluggable-parser module file (scanner)
+ ;; `import' STRING `;'
+ ;; `load' STRING `;'
+
+ (flet ((common (name type what thunk)
+ (find-file scanner
+ (merge-pathnames name
+ (make-pathname :type type
+ :case :common))
+ what
+ thunk)))
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (or (seq ("import" (name :string) #\;)
+ (common name "SOD" "module"
+ (lambda (path true)
+ (handler-case
+ (let ((module (read-module path
+ :truename true)))
+ (when module
+ (module-import module)
+ (pushnew module
+ (module-dependencies
+ *module*))))
+ (file-error (error)
+ (cerror* "Error reading module ~S: ~A"
+ path error))))))
+ (seq ("load" (name :string) #\;)
+ (common name "LISP" "Lisp file"
+ (lambda (path true)
+ (handler-case
+ (load true :verbose nil :print nil)
+ (error (error)
+ (cerror* "Error loading Lisp file ~S: ~A"
+ path error)))))))))))
+
+;;; Lisp escape.
+
+(define-pluggable-parser module lisp (scanner)
+ ;; `lisp' s-expression `;'
+
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (seq ((sexp (if (and (eql (token-type scanner) :id)
+ (string= (token-value scanner) "lisp"))
+ (let* ((stream (make-scanner-stream scanner))
+ (sexp (read stream t)))
+ (scanner-step scanner)
+ (values sexp t t))
+ (values '((:id "lisp")) nil nil)))
+ #\;)
+ (eval sexp)))))
+
+;;;--------------------------------------------------------------------------
+;;; Class declarations.
+
+(define-pluggable-parser module class (scanner)
+ ;; `class' id [`:' id-list] `{' class-item* `}'
+
+ (with-parser-context (token-scanner-context :scanner scanner)
+ (parse (seq ("class"
+ (name :id)
+ (supers (? (seq (#\: (supers (list (:min 1) :id #\,)))
+ supers)))
+ #\{
+
+
+;;;----- That's all, folks --------------------------------------------------
~mdw / sod / commitdiff