diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/algebra/strap/CHAR.lsp | 6 | ||||
| -rw-r--r-- | src/algebra/strap/ISTRING.lsp | 22 | ||||
| -rw-r--r-- | src/algebra/string.spad.pamphlet | 36 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 2 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 13 |
6 files changed, 61 insertions, 26 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index fccf085c..188cc62e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2010-12-31 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/g-opt.boot ($VMsideEffectFreeOperators): Include new + builtin functions %strlt, %streq, %strcopy, and %strconc. + * interp/g-util.boot: Expand them. + * algebra/string.spad.pamphlet (String): Remove uses of + Lisp-level functions CHAR, EQUAL, CHAR=, ans SXHASH. + 2010-12-30 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/vmlisp.lisp (QSTRING): Remove. diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index bfbc88e1..a36914df 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -122,6 +122,11 @@ (DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|) |CHAR;latex;$S;30|)) +(PUT '|CHAR;latex;$S;30| '|SPADreplace| + '(XLAM (|c|) + (|%strconc| "\\mbox{`" + (|%strconc| (MAKE-FULL-CVEC 1 |c|) "'}")))) + (DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|) |CHAR;char;S$;31|)) @@ -227,6 +232,7 @@ (SPADCALL |c| (|spadConstant| $ 52) (|getShellEntry| $ 42))) (DEFUN |CHAR;latex;$S;30| (|c| $) + (DECLARE (IGNORE $)) (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) (DEFUN |CHAR;char;S$;31| (|s| $) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 60503702..1b686d19 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -23,23 +23,22 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) |ISTRING;=;2$B;5|)) -(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL) +(PUT '|ISTRING;=;2$B;5| '|SPADreplace| '|%streq|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|) |ISTRING;<;2$B;6|)) -(PUT '|ISTRING;<;2$B;6| '|SPADreplace| - '(XLAM (|s| |t|) (CGREATERP |t| |s|))) +(PUT '|ISTRING;<;2$B;6| '|SPADreplace| '|%strlt|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|) |ISTRING;concat;3$;7|)) -(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC) +(PUT '|ISTRING;concat;3$;7| '|SPADreplace| '|%strconc|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) |ISTRING;copy;2$;8|)) -(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ) +(PUT '|ISTRING;copy;2$;8| '|SPADreplace| '|%strcopy|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|) |%Thing|) @@ -60,6 +59,9 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|) |ISTRING;latex;$S;14|)) +(PUT '|ISTRING;latex;$S;14| '|SPADreplace| + '(XLAM (|s|) (|%strconc| "\\mbox{``" (|%strconc| |s| "''}")))) + (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|) |%Thing|) |ISTRING;replace;$Us2$;15|)) @@ -121,7 +123,7 @@ (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Short|) |ISTRING;hash;$Si;32|)) -(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| 'SXHASH) +(PUT '|ISTRING;hash;$Si;32| '|SPADreplace| '|%hash|) (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|) (|%IntegerSection| 0)) @@ -145,11 +147,11 @@ (DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (DECLARE (IGNORE $)) - (EQUAL |s| |t|)) + (NOT (NULL (STRING= |s| |t|)))) (DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (DECLARE (IGNORE $)) - (CGREATERP |t| |s|)) + (NOT (NULL (STRING< |s| |t|)))) (DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (DECLARE (IGNORE $)) @@ -180,6 +182,7 @@ (SPADCALL (ELT $ 40) |s| (|getShellEntry| $ 37))) (DEFUN |ISTRING;latex;$S;14| (|s| $) + (DECLARE (IGNORE $)) (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) (DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) @@ -572,7 +575,8 @@ '(|NonNegativeInteger|) #0#)) |ISTRING;match?;2$CB;34|) (EXIT (COND - ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|)) + ((EQL |p| (- |m| 1)) + (NOT (NULL (STRING= |pattern| |target|)))) (T (SEQ (COND ((SPADCALL |p| |m| (|getShellEntry| $ 87)) diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet index 4c8ce1c5..e25719f6 100644 --- a/src/algebra/string.spad.pamphlet +++ b/src/algebra/string.spad.pamphlet @@ -270,7 +270,7 @@ CharacterClass: Join(SetCategory, ConvertibleTo String, -- Those that are required -- QESET MAKE-FULL-CVEC EQ QSLESSP QSGREATERP -- Those that can are included for efficiency only --- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP +-- COPY SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP ++ Description: ++ This domain implements low-level strings @@ -284,11 +284,15 @@ IndexedString(mn:Integer): Export == Implementation where Export == StringAggregate() Implementation == add -- These assume Character's Rep is Small I - Qelt ==> CHAR$Lisp - Qequal ==> EQUAL$Lisp Qsetelt ==> QESET$Lisp - Cheq ==> CHAR_=$Lisp import %strlength: % -> N from Foreign Builtin + import %streq: (%,%) -> Boolean from Foreign Builtin + import %strlt: (%,%) -> Boolean from Foreign Builtin + import %ceq: (Character, Character) -> Boolean from Foreign Builtin + import %schar: (%,I) -> Character from Foreign Builtin + import %strconc: (%,%) -> % from Foreign Builtin + import %strcopy: % -> % from Foreign Builtin + import %hash : % -> SingleInteger from Foreign Builtin c: Character cc: CharacterClass @@ -298,10 +302,10 @@ IndexedString(mn:Integer): Export == Implementation where empty() == MAKE_-FULL_-CVEC(0@I)$Lisp empty?(s) == %strlength s = 0 #s == %strlength s - s = t == Qequal(s, t) - s < t == CGREATERP(t,s)$Lisp - concat(s:%,t:%) == STRCONC(s,t)$Lisp - copy s == COPY_-SEQ(s)$Lisp + s = t == %streq(s,t) + s < t == %strlt(s,t) + concat(s:%,t:%) == %strconc(s,t) + copy s == %strcopy s insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..)) coerce(s:%):OutputForm == outputForm(s pretend String) minIndex s == mn @@ -319,13 +323,13 @@ IndexedString(mn:Integer): Export == Implementation where r := new((m-(h-l+1)+n)::N, space$C) k: NonNegativeInteger := 0 for i in 0..l-1 repeat - Qsetelt(r, k, Qelt(s, i)) + Qsetelt(r, k, %schar(s, i)) k := k + 1 for i in 0..n-1 repeat - Qsetelt(r, k, Qelt(t, i)) + Qsetelt(r, k, %schar(t, i)) k := k + 1 for i in h+1..m-1 repeat - Qsetelt(r, k, Qelt(s, i)) + Qsetelt(r, k, %schar(s, i)) k := k + 1 r @@ -340,7 +344,7 @@ IndexedString(mn:Integer): Export == Implementation where (startpos := startpos - mn) < 0 => error "index out of bounds" np > nw - startpos => false for ip in 0..np-1 for iw in startpos.. repeat - not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false + not %ceq(%schar(part, ip), %schar(whole, iw)) => return false true position(s:%, t:%, startpos:I) == @@ -353,13 +357,13 @@ IndexedString(mn:Integer): Export == Implementation where (startpos := startpos - mn) < 0 => error "index out of bounds" startpos >= %strlength t => mn - 1 for r in startpos..%strlength t - 1 repeat - if Cheq(Qelt(t, r), c) then return r + mn + if %ceq(%schar(t, r), c) then return r + mn mn - 1 position(cc: CharacterClass, t: %, startpos: I) == (startpos := startpos - mn) < 0 => error "index out of bounds" startpos >= %strlength t => mn - 1 for r in startpos..%strlength t - 1 repeat - if member?(Qelt(t,r), cc) then return r + mn + if member?(%schar(t,r), cc) then return r + mn mn - 1 suffix?(s, t) == @@ -432,7 +436,7 @@ IndexedString(mn:Integer): Export == Implementation where elt(s:%, i:I) == i < mn or i > maxIndex(s) => error "index out of range" - Qelt(s, i - mn) + %schar(s, i - mn) elt(s:%, sg:U) == l := lo(sg) - mn @@ -441,7 +445,7 @@ IndexedString(mn:Integer): Export == Implementation where SUBSTRING(s, l, max(0, h-l+1))$Lisp hash s == - SXHASH(s)$Foreign(Builtin) + %hash s match(pattern,target,wildcard) == stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index a25c25a3..4eadc1a3 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -451,7 +451,7 @@ $VMsideEffectFreeOperators == %nil %pair? %lconcat %llength %lfirst %lsecond %lthird %lreverse %lempty? %hash %ismall? %string? %f2s %ccst %ceq %clt %cle %cgt %cge %c2i %i2c %s2c %sname - %strlength %i2s + %strlength %streq %i2s %schar %strlt %strconc %strcopy %vref %vlength %before?) ++ List of simple VM operators diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 9f5502b3..fb08a56a 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -349,6 +349,13 @@ expandFlt ['%flt,x,y] == expandFgt ['%fgt,x,y] == expandFlt ['%flt,y,x] +-- String operations +expandStreq ['%streq,x,y] == + expandToVMForm ['%not,['%peq,['STRING_=,x,y],'%nil]] + +expandStrlt ['%strlt,x,y] == + expandToVMForm ['%not,['%peq,['STRING_<,x,y],'%nil]] + -- Local variable bindings expandBind ['%bind,inits,:body] == body := expandToVMForm body @@ -515,6 +522,9 @@ for x in [ -- string unary functions ['%string?, :'STRINGP], ['%strlength, :'LENGTH], + ['%schar, :'CHAR], + ['%strconc, :'STRCONC], + ['%strcopy, :'COPY_-SEQ], -- general utility ['%hash, :'SXHASH], @@ -554,6 +564,9 @@ for x in [ ['%fneg, :function expandFneg], ['%fprec, :function expandFprec], + ['%streq, :function expandStreq], + ['%strlt, :function expandStrlt], + ['%peq, :function expandPeq], ['%before?, :function expandBefore?], |