* interp/newaux.lisp: Remove digraphs '(<' and '>) as alternate

	spelling for '{' and '}'.
	* interp/fnewmeta.lisp (|PARSE-Primary1|): Use PARSE-Data for
	quoted forms.
	(|PARSE-Sexpr1|): Tidy.
	* interp/parse.boot (washOperatorName): New. Issue deprecation
	diagnostics for string syntax for operator names in signatures.
	(parseHas): Use it.
	(transCategoryItem): Likewise.
	* interp/metalex.lisp (advance-token): Likewise.
	* algebra/boolean.spad.pamphlet: Tidy.

6 files changed, 57 insertions, 50 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index e5495d95..3791a6d6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,19 @@
 2009-06-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/newaux.lisp: Remove digraphs '(<' and '>) as alternate
+	spelling for '{' and '}'.
+	* interp/fnewmeta.lisp (|PARSE-Primary1|): Use PARSE-Data for
+	quoted forms.
+	(|PARSE-Sexpr1|): Tidy.
+	* interp/parse.boot (washOperatorName): New. Issue deprecation
+	diagnostics for string syntax for operator names in signatures.
+	(parseHas): Use it.
+	(transCategoryItem): Likewise.
+	* interp/metalex.lisp (advance-token): Likewise.
+	* algebra/boolean.spad.pamphlet: Tidy.
+
+2009-06-11  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/info.boot (actOnInfo): Don't remember new domain names if
 	at capsule function scope.
 
diff --git a/src/algebra/boolean.spad.pamphlet b/src/algebra/boolean.spad.pamphlet
index 76c3c49b..12b6ad33 100644
--- a/src/algebra/boolean.spad.pamphlet
+++ b/src/algebra/boolean.spad.pamphlet
@@ -92,10 +92,10 @@ PropositionalFormula(T: SetCategory): Public == Private where
       per [[o, l, r]$Record(op: Symbol, lhs: %, rhs: %)]$FORMULA
 
     p and q ==
-      binaryForm('_and, p, q)
+      binaryForm('and, p, q)
 
     p or q ==
-      binaryForm('_or, p, q)
+      binaryForm('or, p, q)
 
     implies(p,q) ==
       binaryForm('implies, p, q)
@@ -123,11 +123,11 @@ PropositionalFormula(T: SetCategory): Public == Private where
       nothing
 
     isAnd f ==
-      isBinaryNode?(f,'_and) => just binaryOperands f
+      isBinaryNode?(f,'and) => just binaryOperands f
       nothing
 
     isOr f ==
-      isBinaryNode?(f,'_or) => just binaryOperands f
+      isBinaryNode?(f,'or) => just binaryOperands f
       nothing
 
     isImplies f ==
@@ -195,7 +195,7 @@ PropositionalFormula(T: SetCategory): Public == Private where
 
     notFormula(p: %): OutputForm ==
       isNot p case % =>
-	elt(outputForm '_not, [notFormula((rep p).unForm)])$OutputForm
+	elt(outputForm 'not, [notFormula((rep p).unForm)])$OutputForm
       primaryFormula p
 
     andFormula(p: %): OutputForm ==
@@ -203,7 +203,7 @@ PropositionalFormula(T: SetCategory): Public == Private where
 	p' := (rep p).binForm
 	-- ??? idealy, we should be using `and$OutputForm' but
 	-- ??? a bug in the compiler currently prevents that.
-	infix(outputForm '_and, notFormula p'.lhs, 
+	infix(outputForm 'and, notFormula p'.lhs, 
 	  andFormula p'.rhs)$OutputForm
       notFormula p
 
@@ -212,7 +212,7 @@ PropositionalFormula(T: SetCategory): Public == Private where
 	p' := (rep p).binForm
 	-- ??? idealy, we should be using `or$OutputForm' but
 	-- ??? a bug in the compiler currently prevents that.
-	infix(outputForm '_or, andFormula p'.lhs, 
+	infix(outputForm 'or, andFormula p'.lhs, 
 	  orFormula p'.rhs)$OutputForm
       andFormula p
 
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index adf96fe8..60027f80 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -754,11 +754,9 @@
                         (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL))))))
       (|PARSE-Quad|) (|PARSE-String|) (|PARSE-IntegerTok|)
       (|PARSE-FormalParameter|)
-      (AND (MATCH-STRING "'")
-           (MUST (AND (MATCH-ADVANCE-STRING "'")
-                      (MUST (|PARSE-Expr| 999))
-                      (PUSH-REDUCTION '|PARSE-Primary1|
-                          (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))))
+      (AND (MATCH-ADVANCE-STRING "'")
+           (MUST (AND (MUST (|PARSE-Data|))
+                      (PUSH-REDUCTION '|PARSE-Primary1| (POP-STACK-1)))))
       (|PARSE-Sequence|) (|PARSE-Enclosure|))) 
 
 
@@ -909,7 +907,9 @@
 
 
 (DEFUN |PARSE-Sexpr1| ()
-  (OR (AND (|PARSE-AnyId|)
+  (OR (|PARSE-IntegerTok|)
+      (|PARSE-String|)
+      (AND (|PARSE-AnyId|)
            (OPTIONAL
                (AND (|PARSE-NBGliphTok| '=) (MUST (|PARSE-Sexpr1|))
                     (ACTION (SETQ LABLASOC
@@ -919,13 +919,11 @@
       (AND (MATCH-ADVANCE-STRING "'") (MUST (|PARSE-Sexpr1|))
            (PUSH-REDUCTION '|PARSE-Sexpr1|
                (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
-      (|PARSE-IntegerTok|)
       (AND (MATCH-ADVANCE-STRING "-") (MUST (|PARSE-IntegerTok|))
            (PUSH-REDUCTION '|PARSE-Sexpr1| (MINUS (POP-STACK-1))))
-      (|PARSE-String|)
-      (AND (MATCH-ADVANCE-STRING "<")
+      (AND (MATCH-ADVANCE-STRING "[")
            (BANG FIL_TEST (OPTIONAL (STAR REPEATOR (|PARSE-Sexpr1|))))
-           (MUST (MATCH-ADVANCE-STRING ">"))
+           (MUST (MATCH-ADVANCE-STRING "]"))
            (PUSH-REDUCTION '|PARSE-Sexpr1| (LIST2VEC (POP-STACK-1))))
       (AND (MATCH-ADVANCE-STRING "(")
            (BANG FIL_TEST
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index a98d681f..690c6243 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -356,10 +356,9 @@ NonBlank is true if the token is not preceded by a blank."
       (try-get-token Next-Token)))
 
 (defun advance-token ()
-  (current-token)                       ;don't know why this is needed
   "Makes the next token be the current token."
   (case Valid-Tokens
-    (0 (try-get-token (Current-Token)))
+    (0 (try-get-token Current-Token))
     (1 (decf Valid-Tokens)
        (setq Prior-Token (copy-token Current-Token))
        (try-get-token Current-Token))
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index 182e6135..a3d2ef79 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -101,17 +101,17 @@
           (|quo| 800 801)   (|div| 800 801)
           (/ 800 801)    (** 900 901)  (^ 900 901)
           (|exquo| 800 801) (+ 700 701)
-          (\- 700 701)    (\-\> 1001 1002)  (\<\- 1001 1002)
+          (- 700 701)    (-> 1001 1002)  (<- 1001 1002)
           (\: 996 997)    (\:\: 996 997)
           (\@ 996 997)    (|pretend| 995 996)
           (\.)            (\! \! 1002 1001)
           (\, 110 111)
           (\; 81 82 (|PARSE-SemiColon|))
-          (\< 400 400)    (\> 400 400)
-          (\<\< 400 400)  (\>\> 400 400)
-          (\<= 400 400)   (\>= 400 400)
+          (< 400 400)    (> 400 400)
+          (<< 400 400)  (>> 400 400)
+          (<= 400 400)   (>= 400 400)
           (= 400 400)     (^= 400 400)
-          (\~= 400 400)
+          (~= 400 400)
           (|in| 400 400)    (|case| 400 400)
           (|add| 400 120)   (|with| 2000 400 (|PARSE-InfixWith|))
           (|has| 400 400)
@@ -121,10 +121,10 @@
           (|and| 250 251)   (|or| 200 201)
           (/\\ 250 251)   (\\/ 200 201)
           (\.\. SEGMENT 401 699 (|PARSE-Seg|))
-          (=\> 123 103)
-          (+-\> 998 112)
+          (=> 123 103)
+          (+-> 998 112)
           (== DEF 122 121)
-          (==\> MDEF 122 121)
+          (==> MDEF 122 121)
           (\| 108 111)                          ;was 190 190
           (\:- LETD 125 124) (\:= %LET 125 124)))
  
@@ -139,19 +139,18 @@
           (|add| 900 120)
           (|with| 1000 300 (|PARSE-With|))
           (|has| 400 400)
-          (\- 701 700)  ; right-prec. wants to be -1 + left-prec
+          (- 701 700)  ; right-prec. wants to be -1 + left-prec
 ;;        (\+ 701 700)
           (\# 999 998)
           (\! 1002 1001)
           (\' 999 999 (|PARSE-Data|))
-          (\<\< 122 120 (|PARSE-LabelExpr|))
-          (\>\>)
-          (^ 260 259 NIL)
-          (\-\> 1001 1002)
+          (<< 122 120 (|PARSE-LabelExpr|))
+          (>>)
+          (-> 1001 1002)
           (\: 194 195)
           (|not| 260 259 NIL)
-          (\~ 260 259 nil)
-          (\= 400 700)
+          (~ 260 259 nil)
+          (= 400 700)
           (|return| 202 201 (|PARSE-Return|))
           (|leave| 202 201 (|PARSE-Leave|))
           (|exit| 202 201 (|PARSE-Exit|))
@@ -175,13 +174,13 @@
         `(
           ( \| (\))  (])   )
           ( *  (*)         )
-          ( \( (<) (\|)    )
+          ( \( (\|)        )
           ( +  (- (>))     )
           ( -  (>)         )
           ( <  (=) (<)     )
 	  ( /  (\\)        )
           ( \\ (/)         )
-          ( >  (=) (>) (\)))
+          ( >  (=) (>)     )
           ( =  (= (>)) (>) )
           ( \. (\.)        )
           ( ^  (=)         )
@@ -189,16 +188,6 @@
           ( [  (\|)        )
           ( \: (=) (-) (\:))))
 
-;; RENAMETOK defines alternate token strings which can be used for different
-;; keyboards which define equivalent tokens.
-  
-(mapcar 
-  #'(lambda (x) (MAKEPROP (CAR X) 'RENAMETOK (CADR X)) (MAKENEWOP X NIL))
-        '((\(\| \[)                     ; (| |) means []
-          (\|\) \])
-          (\(< \{)                      ; (< >) means {}
-          (>\) \})))
-
 ;; GENERIC operators be suffixed by `$' qualifications in SPAD code.  
 ;; `$' is then followed by a domain label, such as I for Integer, which 
 ;; signifies which domain the operator refers to.  For example `+$Integer' 
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index f2ff3381..1886e924 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -54,6 +54,14 @@ $normalizeTree := false
 ++ True if we know we are parsing a form supposed to designate a type.
 $parsingType := false
 
+--%
+
+washOperatorName x ==
+  STRINGP x =>
+    stackWarning('"String syntax for %1b in signature is deprecated.",[x])
+    INTERN x
+  x
+
 parseTransform: %ParseForm -> %Form 
 parseTransform x ==
   $defOp: local:= nil
@@ -200,15 +208,14 @@ parseHas t ==
   ["has",x,fn y] where
     fn y ==
       y is [":" ,op,["Mapping",:map]] =>
-         op:= (STRINGP op => INTERN op; op)
-         ["SIGNATURE",op,map]
+         ["SIGNATURE",washOperatorName op,map]
       y is ["Join",:u] => ["Join",:[fn z for z in u]]
       y is ["CATEGORY",kind,:u] => ["CATEGORY",kind,:[fn z for z in u]]
       kk:= getConstructorKindFromDB opOf y
       kk = "domain" or kk = "category" => makeNonAtomic y
       y is ["ATTRIBUTE",:.] => y
       y is ["SIGNATURE",:.] => y
-      y is [":",op,type] => ["SIGNATURE",op,[type],"constant"]
+      y is [":",op,type] => ["SIGNATURE",washOperatorName op,[type],"constant"]
       ["ATTRIBUTE",y]
  
 parseDEF: %ParseForm -> %Form
@@ -407,7 +414,7 @@ transCategoryItem x ==
     lhs is ["LISTOF",:y] =>
       "append" /[transCategoryItem ["SIGNATURE",z,rhs] for z in y]
     atom lhs =>
-      if STRINGP lhs then lhs:= INTERN lhs
+      lhs := washOperatorName lhs
       rhs is ["Mapping",:m] =>
         m is [.,"constant"] => [["SIGNATURE",lhs,[first m],"constant"]]
         [["SIGNATURE",lhs,m]]