Issue #369 - Switch out inline string cmp ops

This commit is contained in:
Justin Ethier 2020-06-03 18:52:59 -04:00
parent dba2183191
commit 6ace99f5bb
2 changed files with 26 additions and 22 deletions

View file

@ -72,6 +72,11 @@
string<=?
string>?
string>=?
fast-string=?
fast-string<?
fast-string<=?
fast-string>?
fast-string>=?
foldl
foldr
not
@ -220,11 +225,11 @@
zero?
list?
not
string>=?
string>?
string<=?
string<?
string=?
fast-string>=?
fast-string>?
fast-string<=?
fast-string<?
fast-string=?
)
(begin
;; Features implemented by this Scheme
@ -601,18 +606,17 @@
; TODO: char-ci predicates (in scheme/char library)
; ; TODO: generalize to multiple arguments: (define (string<? str1 str2 . strs)
(define (string=? str1 str2) (equal? (string-cmp str1 str2) 0))
(define (string<? str1 str2) (< (string-cmp str1 str2) 0))
(define (string<=? str1 str2) (<= (string-cmp str1 str2) 0))
(define (string>? str1 str2) (> (string-cmp str1 str2) 0))
(define (string>=? str1 str2) (>= (string-cmp str1 str2) 0))
; ; TODO: generalize to multiple arguments: (define (string<? str1 str2 . strs)
; (define (string=?-2 str1 str2) (equal? (string-cmp str1 str2) 0))
; (define (string<?-2 str1 str2) (< (string-cmp str1 str2) 0))
; (define (string<=?-2 str1 str2) (<= (string-cmp str1 str2) 0))
; (define (string>?-2 str1 str2) (> (string-cmp str1 str2) 0))
; (define (string>=?-2 str1 str2) (>= (string-cmp str1 str2) 0))
(define (fast-string=? str1 str2) (equal? (string-cmp str1 str2) 0))
(define (fast-string<? str1 str2) (< (string-cmp str1 str2) 0))
(define (fast-string<=? str1 str2) (<= (string-cmp str1 str2) 0))
(define (fast-string>? str1 str2) (> (string-cmp str1 str2) 0))
(define (fast-string>=? str1 str2) (>= (string-cmp str1 str2) 0))
(define (member-helper obj lst cmp-proc)
(cond

View file

@ -1133,16 +1133,16 @@ if (acc) {
(cons 'write-string-1 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'write-string) (= (length ast) 3))
(cons 'write-string-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;((and (eq? (car ast) 'string>=?) (= (length ast) 3))
; (cons 'string>=?-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;((and (eq? (car ast) 'string>?) (= (length ast) 3))
; (cons 'string>?-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;((and (eq? (car ast) 'string<=?) (= (length ast) 3))
; (cons 'string<=?-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;((and (eq? (car ast) 'string<?) (= (length ast) 3))
; (cons 'string<?-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
;((and (eq? (car ast) 'string=?) (= (length ast) 3))
; (cons 'string=?-2 (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'string>=?) (= (length ast) 3))
(cons 'fast-string>=? (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'string>?) (= (length ast) 3))
(cons 'fast-string>? (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'string<=?) (= (length ast) 3))
(cons 'fast-string<=? (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'string<?) (= (length ast) 3))
(cons 'fast-string<? (map (lambda (a) (convert a renamed)) (cdr ast))))
((and (eq? (car ast) 'string=?) (= (length ast) 3))
(cons 'fast-string=? (map (lambda (a) (convert a renamed)) (cdr ast))))
;; Regular case, alpha convert everything
(else
(regular-case)))))