diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 3 | ||||
| -rw-r--r-- | src/interp/metalex.lisp | 7 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 2 | ||||
| -rw-r--r-- | src/interp/sys-constants.boot | 9 |
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", "<<", ">>" ] + |