[climacs-cvs] CVS update: climacs/prolog-syntax.lisp

[Christophe Rhodes]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv32465

Modified Files:
	prolog-syntax.lisp 
Log Message:
get [] and {} more right.

* separate SYNTACTIC-LEXEME from CANONICAL-NAME, which latter is defined
  also for empty-list and curly-brackets as well as NAMEs and OPs

NOTE NOTE NOTE: giving [] and {} canonical names of "[]" and "{}" is 
in fact wrong, as '[]' and '{}' should not be equal to [] and {}.

Date: Mon Apr  4 21:09:49 2005
Author: crhodes

Index: climacs/prolog-syntax.lisp
diff -u climacs/prolog-syntax.lisp:1.8 climacs/prolog-syntax.lisp:1.9
--- climacs/prolog-syntax.lisp:1.8	Mon Apr  4 17:46:31 2005
+++ climacs/prolog-syntax.lisp	Mon Apr  4 21:09:49 2005
@@ -443,14 +443,21 @@
 
 (defclass atom (prolog-nonterminal)
   ((value :initarg :value :accessor value)))
-(defmethod syntactic-lexeme ((thing atom))
-  (syntactic-lexeme (value thing)))
+(defmethod canonical-name ((thing atom))
+  (canonical-name (value thing)))
+(defmethod canonical-name ((thing name))
+  ;; FIXME: should canonize
+  (lexeme-string (syntactic-lexeme thing)))
 (defclass empty-list (prolog-nonterminal)
   (([ :initarg :[ :accessor [)
    (] :initarg :] :accessor ])))
+(defmethod canonical-name ((thing empty-list))
+  "[]")
 (defclass curly-brackets (prolog-nonterminal)
   (({ :initarg :{ :accessor {)
    (} :initarg :} :accessor })))
+(defmethod canonical-name ((thing curly-brackets))
+  "{}")
 (defmethod display-parse-tree ((entity atom) (syntax prolog-syntax) pane)
   (display-parse-tree (value entity) syntax pane))
 (defmethod display-parse-tree ((entity empty-list) (syntax prolog-syntax) pane)
@@ -538,8 +545,8 @@
   ((name :initarg :name :accessor name)
    (priority :initarg :priority :accessor priority)
    (specifier :initarg :specifier :accessor specifier)))
-(defmethod syntactic-lexeme ((thing op))
-  (syntactic-lexeme (name thing)))
+(defmethod canonical-name ((thing op))
+  (canonical-name (name thing)))
 (defclass prefix-op (op) ())
 (defclass binary-op (op) ())
 (defclass postfix-op (op) ())
@@ -581,7 +588,7 @@
 ;;; 6.2.1.1
 (defun term-directive-p (term)
   (and (compound-term-p term)
-       (string= (lexeme-string (syntactic-lexeme (functor term))) ":-")
+       (string= (canonical-name (functor term)) ":-")
        (= (arity term) 1)))
 
 (define-prolog-rule (directive -> (directive-term end))
@@ -601,8 +608,7 @@
 
 ;;; 6.3.1.2
 (define-prolog-rule (term -> ((atom
-                               (string= (lexeme-string (syntactic-lexeme atom))
-                                        "-"))
+                               (string= (canonical-name atom) "-"))
                               integer))
   ;; FIXME: this doesn't really look right.
   (make-instance 'constant-term :priority 0 :value (list atom integer)))
@@ -715,14 +721,14 @@
     (make-instance 'postfix-operator-compound-lterm :priority (priority op)
 		   :left term :operator op)))
 (define-prolog-rule (term -> ((op (eql (specifier op) :fy)) term))
-  (when (and (or (not (string= (lexeme-string (syntactic-lexeme op)) "-"))
+  (when (and (or (not (string= (canonical-name op) "-"))
                  (not (numeric-constant-p term)))
              (not (typep (first-lexeme term) 'open-ct-lexeme))
              (<= (priority term) (priority op)))
     (make-instance 'prefix-operator-compound-term
                    :right term :operator op :priority (priority op))))
 (define-prolog-rule (lterm -> ((op (eql (specifier op) :fx)) term))
-  (when (and (or (not (string= (lexeme-string (syntactic-lexeme op)) "-"))
+  (when (and (or (not (string= (canonical-name op) "-"))
                  (not (numeric-constant-p term)))
              (not (typep (first-lexeme term) 'open-ct-lexeme))
              (< (priority term) (priority op)))
@@ -805,7 +811,7 @@
   (def 50 :xfx ":"))
 
 (defun find-predefined-operator (name specifiers)
-  (find (lexeme-string (syntactic-lexeme name))
+  (find (canonical-name name)
         (remove-if-not (lambda (x) (member (opspec-specifier x) specifiers))
                        *predefined-operators*)
         :key #'opspec-name :test #'string=))