aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog18
-rw-r--r--src/algebra/seg.spad.pamphlet14
-rw-r--r--src/interp/i-intern.boot6
-rw-r--r--src/interp/lexing.boot4
-rw-r--r--src/interp/newaux.lisp2
-rw-r--r--src/interp/parse.boot4
-rw-r--r--src/interp/parsing.lisp6
-rw-r--r--src/interp/postpar.boot22
-rw-r--r--src/interp/spad-parser.boot14
9 files changed, 39 insertions, 51 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 2fc0070c..8d9f41cc 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,23 @@
2011-10-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/spad-parser.boot (parseSegmentTail): Tidy.
+ * interp/postpar.boot (postSEGMENT): Remove.
+ (postTupleCollect): Likewise.
+ (postBootNotEqual): Likewise.
+ * interp/parsing.lisp (CHAR-EQ): Remove.
+ (CHAR-NE): Likewise.
+ (getToken): Likewise.
+ * interp/newaux.lisp: Remove "^=" as legitimate operator.
+ * interp/lexing.boot (geToken): Rename from getSpadToken.
+ * interp/i-intern.boot (mkAtree3): Check for new form of universal
+ segment.
+ * interp/parse.boot (parseSegment): Likewise.
+ * algebra/seg.spad.pamphlet (Segment): Use .. instead of SEGMENT.
+ (SegmentFunctions2): Likewise.
+ (UniversalSegment): Likewise.
+
+2011-10-17 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
* lisp/core.lisp.in: Add ref and deref to support references.
* interp/sys-constants.boot ($OperatorFunctionNames): Add "by" and
"..".
diff --git a/src/algebra/seg.spad.pamphlet b/src/algebra/seg.spad.pamphlet
index c0795e9e..7bd81dcd 100644
--- a/src/algebra/seg.spad.pamphlet
+++ b/src/algebra/seg.spad.pamphlet
@@ -139,7 +139,7 @@ Segment(S:Type): SegmentCategory(S) with
s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr
coerce(s:%):OutputForm ==
- seg := SEGMENT(s.low::OutputForm, s.high::OutputForm)
+ seg := s.low::OutputForm..s.high::OutputForm
s.incr = 1 => seg
infix(" by "::OutputForm, seg, s.incr::OutputForm)
@@ -217,7 +217,7 @@ SegmentFunctions2(R:Type, S:Type): public == private where
private ==> add
map(f : R->S, r : Segment R): Segment S ==
- SEGMENT(f lo r,f hi r)$Segment(S)
+ (f(lo r)..f(hi r))$Segment(S)
if R has OrderedRing then
map(f : R->S, r : Segment R): List S ==
@@ -412,8 +412,8 @@ UniversalSegment(S: Type): SegmentCategory(S) with
s case Rec2 => (s :: Rec2).incr
(s :: Rec).incr
- SEGMENT(a) == segment a
- SEGMENT(a,b) == segment(a,b)
+ a.. == segment a
+ a..b == segment(a,b)
coerce(sg : SEG): % == segment(lo sg, hi sg)
@@ -435,8 +435,8 @@ UniversalSegment(S: Type): SegmentCategory(S) with
coerce(s: %): OutputForm ==
seg :=
e := (lo s)::OutputForm
- hasHi s => SEGMENT(e, (hi s)::OutputForm)
- SEGMENT e
+ hasHi s => e..(hi s)::OutputForm
+ e..
inc := incr s
inc = 1 => seg
infix(" by "::OutputForm, seg, inc::OutputForm)
@@ -455,7 +455,7 @@ UniversalSegment(S: Type): SegmentCategory(S) with
while not null ls and hasHi first ls repeat
s := first ls
ls := rest ls
- ns := BY(SEGMENT(lo s, hi s), incr s)$Segment(S)
+ ns := BY(lo(s)..hi(s), incr s)$Segment(S)
lb := concat!(lb,ns)
if not null ls then
s := first ls
diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot
index b8be53f7..61533d39 100644
--- a/src/interp/i-intern.boot
+++ b/src/interp/i-intern.boot
@@ -195,10 +195,10 @@ mkAtree3(x,op,argl) ==
op="=" => [mkAtreeNode "equation",:[mkAtree1 arg for arg in argl]]
op="not" and argl is [["=",lhs,rhs]] =>
[mkAtreeNode "not",[mkAtreeNode "=",mkAtree1 lhs,mkAtree1 rhs]]
- op="in" and argl is [var ,["SEGMENT",lb,ul]] =>
+ op="in" and argl is [var ,["SEGMENT",lb,:ul]] =>
upTest:=
- null ul => nil
- mkLessOrEqual(var,ul)
+ ul = nil => nil
+ mkLessOrEqual(var,first ul)
lowTest:=mkLessOrEqual(lb,var)
z :=
ul => ['and,lowTest,upTest]
diff --git a/src/interp/lexing.boot b/src/interp/lexing.boot
index 325aa513..8b0e1b7e 100644
--- a/src/interp/lexing.boot
+++ b/src/interp/lexing.boot
@@ -188,7 +188,7 @@ tokenInstall(sym,typ,tok,nonblank == true) ==
tokenNonblank?(tok) := nonblank
tok
-getSpadToken tok ==
+getToken tok ==
not skipBlankChars() => nil
tt := tokenLookaheadType currentChar()
tt is 'EOF => tokenInstall(nil,'_*EOF,tok,$nonblank)
@@ -203,7 +203,7 @@ getSpadToken tok ==
getGliph(tok,tt)
tryGetToken tok ==
- getSpadToken tok =>
+ getToken tok =>
$validTokens := $validTokens + 1
tok
nil
diff --git a/src/interp/newaux.lisp b/src/interp/newaux.lisp
index 3d668367..3e85eb7d 100644
--- a/src/interp/newaux.lisp
+++ b/src/interp/newaux.lisp
@@ -109,7 +109,7 @@
(< 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)
diff --git a/src/interp/parse.boot b/src/interp/parse.boot
index 9f30064d..f980de7c 100644
--- a/src/interp/parse.boot
+++ b/src/interp/parse.boot
@@ -311,8 +311,8 @@ parseInBy t ==
parseSegment: %ParseForm -> %Form
parseSegment p ==
- p is ["SEGMENT",a,b] =>
- b => ["SEGMENT",parseTran a, parseTran b]
+ p is ["SEGMENT",a,:b] =>
+ b => ["SEGMENT",parseTran a, parseTran first b]
["SEGMENT",parseTran a]
-- SEGMENT is being elted from a domain
["SEGMENT",:rest p]
diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp
index ce5a2826..565fce93 100644
--- a/src/interp/parsing.lisp
+++ b/src/interp/parsing.lisp
@@ -602,10 +602,6 @@ the stack, then stack a NIL. Return the value of prod."
;; auxiliary functions needed by the parser
-(defun char-eq (x y) (char= (character x) (character y)))
-
-(defun char-ne (x y) (char/= (character x) (character y)))
-
(Defun FLOATEXPID (X &aux S)
(if (AND (IDENTP X) (char= (char-upcase (ELT (SETQ S (PNAME X)) 0)) #\E)
(> (LENGTH S) 1)
@@ -614,8 +610,6 @@ the stack, then stack a NIL. Return the value of prod."
(READ-FROM-STRING S t nil :start 1)
NIL))
-(defun |getToken| (x) (if (EQCAR x '|elt|) (third x) x))
-
(defun |dollarTran| (dom rand)
(let ((eltWord (if |$InteractiveMode| '|$elt| '|elt|)))
(if (and (not (atom rand)) (cdr rand))
diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot
index aa279f98..aba24540 100644
--- a/src/interp/postpar.boot
+++ b/src/interp/postpar.boot
@@ -346,12 +346,6 @@ postRepeat t ==
t isnt ["REPEAT",:m,x] => systemErrorHere ["postRepeat",t]
["REPEAT",:postIteratorList m,postTran x]
-postSEGMENT: %ParseTree -> %ParseForm
-postSEGMENT t ==
- t isnt ["SEGMENT",a,b] => systemErrorHere ["postSEGMENT",t]
- key:= [a,'"..",:(b => [b]; nil)]
- postError ['" Improper placement of segment",:bright key]
-
postCollect: %ParseTree -> %ParseForm
postCollect t ==
t isnt [constructOp,:m,x] => systemErrorHere ["postCollect",t]
@@ -371,11 +365,6 @@ postCollect t ==
["REDUCE","append",0,[op,:itl,newBody]]
[op,:itl,y]
-postTupleCollect: %ParseTree -> %ParseForm
-postTupleCollect t ==
- t isnt [constructOp,:m,x] => systemErrorHere ["postTupleCollect",t]
- postCollect [constructOp,:m,["construct",x]]
-
postIteratorList: %List %ParseTree -> %List %ParseForm
postIteratorList x ==
x is [p,:l] =>
@@ -530,15 +519,6 @@ unComma x ==
x is ["%Comma",:y] => y
[x]
---% `^='
-++ check that `^=' is not used in Spad code to mean `not equal'.
-postBootNotEqual: %ParseTree -> %ParseForm
-postBootNotEqual u ==
- checkWarning ['"Operator ", :bright '"^=",
- '"is not valid Spad. Please use",:bright '"~=",'"instead."]
- ["~=",:postTran rest u]
-
-
--% %Match
postAlternatives alts ==
@@ -570,7 +550,6 @@ for x in [["with", :"postWith"],_
["in", :"postin"],_
["IN", :"postIn"],_
["REPEAT", :"postRepeat"],_
- ["TupleCollect", :"postTupleCollect"],_
["add", :"postAdd"],_
["%Reduce", :"postReduce"],_
[",", :"postComma"],_
@@ -588,7 +567,6 @@ for x in [["with", :"postWith"],_
["->", :"postMapping"],_
["=>", :"postExit"],_
["%Match",:"postMatch"],_
- ["^=", :"postBootNotEqual"],_
["%Comma", :"post%Comma"]] repeat
property(first x, 'postTran) := rest x
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 43e04256..894907b2 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -334,11 +334,10 @@ parseExpression() ==
parseSegmentTail() ==
parseGlyph ".." =>
- stackUpdated?($reduceStack) := false
- parseExpression()
- if not stackUpdated? $reduceStack then
- pushReduction('segmentTail,nil)
- pushReduction('parseSegmentTail,["SEGMENT",popStack2(),popStack1()])
+ seg :=
+ parseExpression() => ["SEGMENT",popStack2(),popStack1()]
+ ["SEGMENT",popStack1()]
+ pushReduction('parseSegmentTail,seg)
nil
parseReductionOp() ==
@@ -547,7 +546,7 @@ parseLoop() ==
parseOpenBracket() ==
s := currentSymbol()
- getToken s is "[" =>
+ s is "[" or s is ["elt",.,"["] =>
do
s is ["elt",:.] =>
pushReduction('parseOpenBracket,["elt",second s,"construct"])
@@ -558,7 +557,7 @@ parseOpenBracket() ==
parseOpenBrace() ==
s := currentSymbol()
- getToken s is "{" =>
+ s is "{" or s is ["elt",.,"{"] =>
do
s is ["elt",:.] =>
pushReduction('parseOpenBracket,["elt",second s,"brace"])
@@ -805,7 +804,6 @@ for x in [
[">", ["="], [">"]],_
["=", ["=", [">"]] ,[">"]],_
[".", ["."]],_
- ["^", ["="]],_
["~", ["="]],_
["[", ["|"]],_
[":", ["="], ["-"], [":"]]_
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 07:12:15 +0000