From 671a7d7ba8aa7bfae12d5eb254f184b2210a9c64 Mon Sep 17 00:00:00 2001 From: Samuel Chase Date: Mon, 13 May 2013 02:08:43 +0530 Subject: [PATCH] Implemented string< boot.lisp: implemented char-code string.lisp: implemented string< strings.lisp: added tests. The added tests pass. --- src/boot.lisp | 3 +++ src/string.lisp | 10 ++++++++-- tests/strings.lisp | 4 ++++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/src/boot.lisp b/src/boot.lisp index 47f4309..5f44fa6 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -375,6 +375,9 @@ (defun char= (x y) (eql x y)) +(defun char< (x y) + (< (char-code x) (char-code y))) + (defun integerp (x) (and (numberp x) (= (floor x) x))) diff --git a/src/string.lisp b/src/string.lisp index 92c78dc..aebad3a 100644 --- a/src/string.lisp +++ b/src/string.lisp @@ -26,8 +26,14 @@ (return-from string= nil)))))) (defun string< (s1 s2) - -1) - + (let ((len-1 (length s1)) + (len-2 (length s2))) + (cond ((= len-2 0) nil) + ((= len-1 0) 0) + (t (dotimes (i len-1 nil) + (when (char< (char s1 i) (char s2 i)) + (return-from string< i))))))) + (define-setf-expander char (string index) (let ((g!string (gensym)) (g!index (gensym)) diff --git a/tests/strings.lisp b/tests/strings.lisp index eab8a6b..cb6cd83 100644 --- a/tests/strings.lisp +++ b/tests/strings.lisp @@ -18,6 +18,10 @@ (test (not (string= "foo" "foox"))) (test (= (string< "one" "two") 0)) +(test (= (string< "oob" "ooc") 2)) +(test (null (string< "" ""))) +(test (null (string< "a" ""))) +(test (= (string< "" "a") 0)) ;;; BUG: The compiler will macroexpand the forms below (char str N) ;;; will expand to internal SBCL code instead of our (setf char). It -- 1.7.10.4