diff options
Diffstat (limited to 'src/algebra/list.spad.pamphlet')
| -rw-r--r-- | src/algebra/list.spad.pamphlet | 91 |
1 files changed, 48 insertions, 43 deletions
diff --git a/src/algebra/list.spad.pamphlet b/src/algebra/list.spad.pamphlet index 0b6da7ff..eb0913ef 100644 --- a/src/algebra/list.spad.pamphlet +++ b/src/algebra/list.spad.pamphlet @@ -49,37 +49,42 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where -- LIST, CAR, CDR, NCONC2, NREVERSE, LENGTH -- Also REVERSE, since it's called in Polynomial Ring - Qfirst ==> QCAR$Lisp - Qrest ==> QCDR$Lisp Qnull ==> NULL$Lisp - Qeq ==> EQ$Lisp - Qcons ==> CONS$Lisp Qpush ==> PUSH$Lisp Exports ==> ListAggregate S Implementation ==> add + import %nil: % from Foreign Builtin + import %makepair: (S,%) -> % from Foreign Builtin + import %eq: (%,%) -> Boolean from Foreign Builtin + import %lempty?: % -> Boolean from Foreign Builtin + import %head: % -> S from Foreign Builtin + import %tail: % -> % from Foreign Builtin + import %lreverse: % -> % from Foreign Builtin + import %lreverse!: % -> % from Foreign Builtin + #x == LENGTH(x)$Lisp - concat(s:S,x:%) == CONS(s,x)$Lisp - eq?(x,y) == EQ(x,y)$Lisp + concat(s:S,x:%) == %makepair(s,x) + eq?(x,y) == %eq(x,y) first x == SPADfirst(x)$Lisp elt(x,"first") == SPADfirst(x)$Lisp - empty() == NIL$Lisp - empty? x == NULL(x)$Lisp - rest x == CDR(x)$Lisp - elt(x,"rest") == CDR(x)$Lisp + empty() == %nil + empty? x == %lempty? x + rest x == %tail x + elt(x,"rest") == %tail x setfirst!(x,s) == empty? x => error "Cannot update an empty list" - Qfirst RPLACA(x,s)$Lisp + %head RPLACA(x,s)$Lisp setelt(x,"first",s) == empty? x => error "Cannot update an empty list" - Qfirst RPLACA(x,s)$Lisp + %head RPLACA(x,s)$Lisp setrest!(x,y) == empty? x => error "Cannot update an empty list" - Qrest RPLACD(x,y)$Lisp + %tail RPLACD(x,y)$Lisp setelt(x,"rest",y) == empty? x => error "Cannot update an empty list" - Qrest RPLACD(x,y)$Lisp + %tail RPLACD(x,y)$Lisp construct l == l pretend % parts s == s pretend List S reverse! x == NREVERSE(x)$Lisp @@ -89,15 +94,15 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where rest(x, n) == for i in 1..n repeat if Qnull x then error "index out of range" - x := Qrest x + x := %tail x x copy x == y := empty() for i in 0.. while not Qnull x repeat - if Qeq(i,cycleMax) and cyclic? x then error "cyclic list" - y := Qcons(Qfirst x,y) - x := Qrest x + if i = cycleMax and cyclic? x then error "cyclic list" + y := %makepair(%head x,y) + x := %tail x (NREVERSE(y)$Lisp)@% if S has CoercibleTo(OutputForm) then @@ -105,38 +110,38 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where -- displays cycle with overbar over the cycle y := empty()$List(OutputForm) s := cycleEntry x - while not Qeq(x, s) repeat + while not %eq(x, s) repeat y := concat((first x)::OutputForm, y) x := rest x y := reverse! y empty? s => bracket y -- cyclic case: z is cylic part z := list((first x)::OutputForm) - while not Qeq(s, rest x) repeat + while not %eq(s, rest x) repeat x := rest x z := concat((first x)::OutputForm, z) bracket concat!(y, overbar commaSeparate reverse! z) if S has SetCategory then x = y == - Qeq(x,y) => true + %eq(x,y) => true while not Qnull x and not Qnull y repeat - Qfirst x ~=$S Qfirst y => return false - x := Qrest x - y := Qrest y + %head x ~=$S %head y => return false + x := %tail x + y := %tail y Qnull x and Qnull y latex(x : %): String == s : String := "\left[" while not Qnull x repeat - s := concat(s, latex(Qfirst x)$S)$String - x := Qrest x + s := concat(s, latex(%head x)$S)$String + x := %tail x if not Qnull x then s := concat(s, ", ")$String concat(s, " \right]")$String member?(s,x) == while not Qnull x repeat - if s = Qfirst x then return true else x := Qrest x + if s = %head x then return true else x := %tail x false -- Lots of code from parts of AGGCAT, repeated here to @@ -148,8 +153,8 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where QRPLACD(x,rest y)$Lisp x z:=x - while not Qnull Qrest z repeat - z:=Qrest z + while not Qnull %tail z repeat + z:=%tail z QRPLACD(z,y)$Lisp x @@ -158,13 +163,13 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where removeDuplicates! l == p := l while not Qnull p repeat --- p := setrest!(p, remove!(#1 = Qfirst p, Qrest p)) +-- p := setrest!(p, remove!(#1 = %head p, %tail p)) -- far too expensive - builds closures etc. pp:=p - f:S:=Qfirst p - p:=Qrest p - while not Qnull (pr:=Qrest pp) repeat - if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp + f:S:=%head p + p:=%tail p + while not Qnull (pr:=%tail pp) repeat + if (%head pr)@S = f then QRPLACD(pp,%tail pr)$Lisp else pp:=pr l @@ -176,22 +181,22 @@ IndexedList(S:Type, mn:Integer): Exports == Implementation where merge!(f, p, q) == Qnull p => q Qnull q => p - Qeq(p, q) => error "cannot merge a list into itself" - if f(Qfirst p, Qfirst q) - then (r := t := p; p := Qrest p) - else (r := t := q; q := Qrest q) + %eq(p, q) => error "cannot merge a list into itself" + if f(%head p, %head q) + then (r := t := p; p := %tail p) + else (r := t := q; q := %tail q) while not Qnull p and not Qnull q repeat - if f(Qfirst p, Qfirst q) - then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p) - else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q) + if f(%head p, %head q) + then (QRPLACD(t, p)$Lisp; t := p; p := %tail p) + else (QRPLACD(t, q)$Lisp; t := q; q := %tail q) QRPLACD(t, if Qnull p then q else p)$Lisp r split!(p, n) == n < 1 => error "index out of range" p := rest(p, (n - 1)::NonNegativeInteger) - q := Qrest p - QRPLACD(p, NIL$Lisp)$Lisp + q := %tail p + QRPLACD(p,%nil)$Lisp q mergeSort(f, p, n) == |