diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 14 | ||||
| -rw-r--r-- | src/algebra/boolean.spad.pamphlet | 14 | ||||
| -rw-r--r-- | src/interp/fnewmeta.lisp | 18 | ||||
| -rw-r--r-- | src/interp/metalex.lisp | 3 | ||||
| -rw-r--r-- | src/interp/newaux.lisp | 43 | ||||
| -rw-r--r-- | src/interp/parse.boot | 15 |
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]] |