Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 04:25:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch '369-dev'

Browse source
This commit is contained in:
Justin Ethier 2020-06-05 16:03:04 -04:00
commit 0469d7c7aa
2 changed files with 30 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
scheme/base.sld
View file

@ -72,6 +72,11 @@
string<=? string<=?
string>? string>?
string>=? string>=?
fast-string=?
fast-string<?
fast-string<=?
fast-string>?
fast-string>=?
foldl foldl
foldr foldr
not not
@ -220,11 +225,11 @@
zero? zero?
list? list?
not not
string>=? fast-string>=?
string>? fast-string>?
string<=? fast-string<=?
string<? fast-string<?
string=? fast-string=?
) )
(begin (begin
;; Features implemented by this Scheme ;; Features implemented by this Scheme
@ -600,19 +605,17 @@
(define (char>=? c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs))) (define (char>=? c1 c2 . cs) (Cyc-bin-op-char >= c1 (cons c2 cs)))
; TODO: char-ci predicates (in scheme/char library) ; TODO: char-ci predicates (in scheme/char library)
(define (string=? str1 str2 . strs) (Cyc-bin-op fast-string=? str1 (cons str2 strs)))
(define (string<? str1 str2 . strs) (Cyc-bin-op fast-string<? str1 (cons str2 strs)))
(define (string<=? str1 str2 . strs) (Cyc-bin-op fast-string<=? str1 (cons str2 strs)))
(define (string>? str1 str2 . strs) (Cyc-bin-op fast-string>? str1 (cons str2 strs)))
(define (string>=? str1 str2 . strs) (Cyc-bin-op fast-string>=? str1 (cons str2 strs)))
(define (string=? str1 str2) (equal? (string-cmp str1 str2) 0)) (define (fast-string=? str1 str2) (equal? (string-cmp str1 str2) 0))
(define (string<? str1 str2) (< (string-cmp str1 str2) 0)) (define (fast-string<? str1 str2) (< (string-cmp str1 str2) 0))
(define (string<=? str1 str2) (<= (string-cmp str1 str2) 0)) (define (fast-string<=? str1 str2) (<= (string-cmp str1 str2) 0))
(define (string>? str1 str2) (> (string-cmp str1 str2) 0)) (define (fast-string>? str1 str2) (> (string-cmp str1 str2) 0))
(define (string>=? str1 str2) (>= (string-cmp str1 str2) 0)) (define (fast-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 (member-helper obj lst cmp-proc) (define (member-helper obj lst cmp-proc)
(cond (cond

20
scheme/cyclone/transforms.sld
View file

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