aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-05-25 21:33:06 +0000
committerdos-reis <gdr@axiomatics.org>2009-05-25 21:33:06 +0000
commit48f85cd0f651d269dfc1c641befe1fb1e4c50486 (patch)
tree3b8da34eec93270d4696a19ac3489295952d2244
parente7ad9a3ff2ef291339dbb704426a8bef6ab8970a (diff)
downloadopen-axiom-48f85cd0f651d269dfc1c641befe1fb1e4c50486.tar.gz
* interp/sys-constants.boot ($OperatorFunctionNames): New.
* interp/metalex.lisp (|PARSE-OperatorFunctionName|): New. Use it. * interp/fnewmeta.lisp (|PARSE-Category|): Handle operator function names.
-rw-r--r--src/ChangeLog7
-rw-r--r--src/interp/fnewmeta.lisp3
-rw-r--r--src/interp/metalex.lisp7
-rw-r--r--src/interp/newaux.lisp2
-rw-r--r--src/interp/sys-constants.boot9
5 files changed, 26 insertions, 2 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 4ed033f9..4960a30f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
2009-05-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/sys-constants.boot ($OperatorFunctionNames): New.
+ * interp/metalex.lisp (|PARSE-OperatorFunctionName|): New. Use it.
+ * interp/fnewmeta.lisp (|PARSE-Category|): Handle operator
+ function names.
+
+2009-05-25 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* algebra/kl.spad.pamphlet (KernelFunctions2): Remove OrderedSet
requirements.
* algebra/op.spad.pamphlet (BasicOperatorFunctions1): Likewise.
diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp
index 3a0ffa89..c819222d 100644
--- a/src/interp/fnewmeta.lisp
+++ b/src/interp/fnewmeta.lisp
@@ -420,7 +420,8 @@
(CONS (POP-STACK-2)
(APPEND (POP-STACK-1) NIL)))))
(AND (ACTION (SETQ G1 (LINE-NUMBER CURRENT-LINE)))
- (|PARSE-Application|)
+ (OR (|PARSE-Application|)
+ (|PARSE-OperatorFunctionName|))
(MUST (OR (AND (MATCH-ADVANCE-STRING ":")
(MUST (|PARSE-Expression|))
(PUSH-REDUCTION '|PARSE-Category|
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index aebd2aaa..f89ebf6e 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -636,6 +636,13 @@ as keywords.")
(defun-parse-token KEYWORD)
(defun-parse-token ARGUMENT-DESIGNATOR)
+(defun |PARSE-OperatorFunctionName| ()
+ (let ((tok (match-current-token 'keyword)))
+ (when (and tok (member (token-symbol tok) |$OperatorFunctionNames|))
+ (Push-Reduction 'IDENTIFIER-TOKEN
+ (copy-tree (token-symbol tok)))
+ (action (advance-token)))))
+
; Meta tokens fall into the following categories:
;
; Number
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index 3d328de7..d8ac603e 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -205,7 +205,7 @@
;; is `+' for Integers.
(mapcar #'(lambda (x) (MAKEPROP X 'GENERIC 'TRUE))
- '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ^= ))
+ '(- = * |rem| |mod| |quo| |div| / ** |exquo| + - < > <= >= ~= ))
(defun SPECIALCASESYNTAX () (OR (AND (char= TOK '#\#) (DIGITP CHR))))
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index ab119c84..b50e1d56 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -731,3 +731,12 @@ $KillLispSystem == 14
$SpadReaderTag ==
"SPAD__READER"
+
+--%
+
+++ List of operator names that can be overloaded in libraries.
+$OperatorFunctionNames ==
+ ["**", "^", "*", "/", "rem", "quo", "mod", "div", "exquo",
+ "+", "-", ">", ">=", "=", "~=", "<", "<=", "~", "not",
+ "case", "and", "or", "<<", ">>" ]
+