aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/fnewmeta.lisp18
-rw-r--r--src/interp/metalex.lisp3
-rw-r--r--src/interp/newaux.lisp43
-rw-r--r--src/interp/parse.boot15
4 files changed, 36 insertions, 43 deletions
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]]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 15:59:56 +0000