1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32 33)package "BOOT" 34 35-- Dequeue functions 36 37-- dqUnit makes a unit dq i.e. a dq with one item, from the item 38 39-- dqAppend appends 2 dq's, destroying the first 40 41-- dqConcat concatenates a list of dq's, destroying all but the last 42 43-- dqToList transforms a dq to a list 44 45dqUnit s==(a:=[s];CONS(a,a)) 46 47dqAppend(x,y)== 48 if null x 49 then y 50 else if null y 51 then x 52 else 53 RPLACD(CDR x, first y) 54 RPLACD (x, CDR y) 55 x 56 57dqConcat ld== 58 if null ld 59 then nil 60 else if null rest ld 61 then first ld 62 else dqAppend(first ld,dqConcat rest ld) 63 64dqToList s == if null s then nil else first s 65 66-- Pile functions 67 68-- insertpiles converts a line-list to a line-forest where 69 70-- a line is a token-dequeue and has a column which is an integer. 71-- an A-forest is an A-tree-list 72-- an A-tree has a root which is an A, and subtrees which is an A-forest. 73 74-- A forest with more than one tree corresponds to a Scratchpad pile 75-- structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item. 76-- The ( ; and ) tokens are inserted into a >1-forest, otherwise 77-- the root of the first tree is concatenated with its forest. 78-- column t is the number of spaces before the first non-space in line t 79 80pileColumn t == rest tokPosn CAAR t 81pileComment t== EQ(tokType CAAR t,"negcomment") 82pilePlusComment t== EQ(tokType CAAR t,"comment") 83 84-- insertpile is used by next so s is non-null 85-- bite off a line-tree, return it and the remaining line-list. 86 87countParens(s, opar, cpar) == 88 ress := 0 89 for stok in dqToList s repeat 90 t := tokPart stok 91 if EQ(CAAR stok,"key") and EQ(t, opar) then 92 ress := ress + 1 93 if EQ(CAAR stok,"key") and EQ(t, cpar) then 94 ress := ress - 1 95 ress 96 97nopile (s, opar, cpar) == 98 -- SAY("nopile") 99 if npNull s 100 then [false,0,[],s] 101 else 102 [h,t]:=[car s,cdr s] 103 h := car h 104 ress := h 105 balance := countParens(h, opar, cpar) 106 -- SAY("balance = ", balance) 107 while not npNull t and balance > 0 repeat 108 h := car (car t) 109 t := cdr t 110 ress := dqAppend(ress, h) 111 balance := balance + countParens(h, opar, cpar) 112 -- SAY("balance = ", balance) 113 -- SAY("ress=", ress) 114 -- FIXME: we should return a pair [deque, stream], but 115 -- now we return nil instead of a stream 116 cons([[ress]], t) 117 118DEFPARAMETER($nopiles, false) 119 120setNopiles (t) == 121 $nopiles := t 122 123piles () == 124 $nopiles := false 125 126insertpile (s)== 127 $nopiles = "{" => nopile (s, "{", "}") 128 $nopiles = "(" => nopile (s, "(", ")") 129 if npNull s 130 then [false,0,[],s] 131 else 132 [h,t]:=[car s,cdr s] 133 if pilePlusComment h 134 then 135 [h1,t1]:=pilePlusComments s 136 a:=pileTree(-1,t1) 137 cons([pileCforest [:h1,a.2]],a.3) 138 else 139 stream:=CADAR s 140 a:=pileTree(-1,s) 141 cons([[a.2,stream]],a.3) 142 143pilePlusComments s== 144 if npNull s 145 then [[],s] 146 else 147 [h,t]:=[car s,cdr s] 148 if pilePlusComment h 149 then 150 [h1,t1]:=pilePlusComments t 151 [cons(h,h1),t1] 152 else [[],s] 153 154pileTree(n,s)== 155 if npNull s 156 then [false,n,[],s] 157 else 158 [h,t]:=[car s,cdr s] 159 hh := pileColumn first h 160 if hh > n 161 then pileForests(first h, hh, t) 162 else [false,n,[],s] 163 164eqpileTree(n,s)== 165 if npNull s 166 then [false,n,[],s] 167 else 168 [h,t]:=[car s,cdr s] 169 hh := pileColumn first h 170 if hh = n 171 then pileForests(first h, hh, t) 172 else [false,n,[],s] 173 174pileForest(n,s)== 175 [b,hh,h,t]:= pileTree(n,s) 176 if b 177 then 178 [h1,t1]:=pileForest1(hh,t) 179 [cons(h,h1),t1] 180 else [[],s] 181 182pileForest1(n,s)== 183 [b,n1,h,t]:= eqpileTree(n,s) 184 if b 185 then 186 [h1,t1]:=pileForest1(n,t) 187 [cons(h,h1),t1] 188 else [[],s] 189 190pileForests(h,n,s)== 191 [h1,t1]:=pileForest(n,s) 192 if npNull h1 193 then [true,n,h,s] 194 else pileForests(pileCtree(h,h1),n,t1) 195 196pileCtree(x,y)==dqAppend(x,pileCforest y) 197 198-- only enpiles forests with >=2 trees 199 200first_tok(t) == CAAR t 201last_tok(t) == CADR t 202 203pileCforest x== 204 if null x 205 then [] 206 else if null cdr x 207 then 208 f:= car x 209 if EQ(tokPart first_tok(f),"if") 210 then enPile f 211 else f 212 else enPile separatePiles x 213 214firstTokPosn t== tokPosn first_tok(t) 215lastTokPosn t== tokPosn last_tok(t) 216 217separatePiles x== 218 if null x 219 then [] 220 else if null cdr x 221 then car x 222 else 223 a:=car x 224 lta := tokPart(last_tok(a)) 225 ftb := tokPart(first_tok(car(cdr x))) 226 EQ(lta, ":") or EQ(lta, ";") or EQ(lta, "(") or 227 EQ(lta, "[") or EQ(lta, "{") or EQ(ftb, "in") or 228 EQ(ftb, "then") or EQ(ftb, "else") or EQ(ftb, ")") or 229 EQ(ftb, "]") or EQ(ftb, "}") => 230 dqConcat [a, separatePiles cdr x] 231 semicolon:=dqUnit tokConstruct("key", "BACKSET",lastTokPosn a) 232 dqConcat [a,semicolon,separatePiles cdr x] 233 234enPile x== 235 dqConcat [dqUnit tokConstruct("key","SETTAB",firstTokPosn x), 236 x, _ 237 dqUnit tokConstruct("key","BACKTAB",lastTokPosn x)] 238