From 0df19c03c721d4ef214b335445a530dbfa66d570 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 13 May 2011 09:29:07 +0000
Subject: 	* boot/utility.boot (charPosition): New. 	*
 boot/scanner.boot (shoeAccumulateLines): Use it. 	(shoeS): Likewise.

---
 src/ChangeLog                |  6 ++++++
 src/boot/scanner.boot        |  7 +++----
 src/boot/strap/scanner.clisp | 19 ++++++++++---------
 src/boot/strap/utility.clisp | 11 +++++++++++
 src/boot/utility.boot        | 11 +++++++++++
 5 files changed, 41 insertions(+), 13 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index 1b5e08d8..cdae0388 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2011-05-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/utility.boot (charPosition): New.
+	* boot/scanner.boot (shoeAccumulateLines): Use it.
+	(shoeS): Likewise.
+
 2011-05-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* boot/initial-env.lisp (MAKE-HASHTABLE): Remove.
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index e1f6bd0b..841d26db 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -135,8 +135,7 @@ shoeAccumulateLines(s,string)==
     command and #command>0 =>
       stringChar(command,0) = char ";" =>
 		  shoeAccumulateLines($r,string)
-      a:=STRPOS('";",command,0,nil)
-      a=>
+      a := charPosition(char ";",command,0) =>
 	shoeAccumulateLines($r,
 	   strconc(string,subString(command,0,a-1)))
       shoeAccumulateLines($r,strconc(string,command))
@@ -314,8 +313,8 @@ shoeS()==
     SoftShoeError([$linepos,:$n],'"quote added")
     '""
   n := $n
-  strsym := STRPOS ('"_"",$ln,$n,nil) or $sz
-  escsym := STRPOS ('"__",$ln,$n,nil) or $sz
+  strsym := charPosition(char "_"",$ln,$n) or $sz
+  escsym := charPosition(char "__",$ln,$n) or $sz
   mn := MIN(strsym,escsym)
   mn=$sz =>
     $n:=$sz
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 2a01edc0..208c588a 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -131,13 +131,12 @@
             (COND
               ((CHAR= (SCHAR |command| 0) (|char| '|;|))
                (|shoeAccumulateLines| |$r| |string|))
-              (T (SETQ |a| (STRPOS ";" |command| 0 NIL))
-                 (COND
-                   (|a| (|shoeAccumulateLines| |$r|
-                            (CONCAT |string|
-                                    (|subString| |command| 0 (- |a| 1)))))
-                   (T (|shoeAccumulateLines| |$r|
-                          (CONCAT |string| |command|)))))))
+              ((SETQ |a| (|charPosition| (|char| '|;|) |command| 0))
+               (|shoeAccumulateLines| |$r|
+                   (CONCAT |string|
+                           (|subString| |command| 0 (- |a| 1)))))
+              (T (|shoeAccumulateLines| |$r|
+                     (CONCAT |string| |command|)))))
            (T (|shoeAccumulateLines| |$r| |string|))))
         (T (CONS |s| |string|))))))
 
@@ -347,8 +346,10 @@
         ((NOT (< |$n| |$sz|))
          (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
         (T (SETQ |n| |$n|)
-           (SETQ |strsym| (OR (STRPOS "\"" |$ln| |$n| NIL) |$sz|))
-           (SETQ |escsym| (OR (STRPOS "_" |$ln| |$n| NIL) |$sz|))
+           (SETQ |strsym|
+                 (OR (|charPosition| (|char| '|"|) |$ln| |$n|) |$sz|))
+           (SETQ |escsym|
+                 (OR (|charPosition| (|char| '_) |$ln| |$n|) |$sz|))
            (SETQ |mn| (MIN |strsym| |escsym|))
            (COND
              ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 02f52e9f..7bfc9387 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -302,3 +302,14 @@
     ((OR (CHARACTERP |x|) (INTEGERP |x|)) (|removeScalar| |l| |x|))
     (T (|removeValue| |l| |x|))))
 
+(DEFUN |charPosition| (|c| |s| |k|)
+  (PROG (|n|)
+    (RETURN
+      (PROGN
+        (SETQ |n| (LENGTH |s|))
+        (LOOP
+          (COND
+            ((NOT (< |k| |n|)) (RETURN NIL))
+            ((CHAR= (SCHAR |s| |k|) |c|) (RETURN |k|))
+            (T (SETQ |k| (+ |k| 1)))))))))
+
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 0219af77..c5a6591f 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -248,3 +248,14 @@ remove(l,x) ==
   symbol? x => removeSymbol(l,x)
   char? x or integer? x => removeScalar(l,x)
   removeValue(l,x)
+
+--% search
+
+++ Return the index of the character `c' in the string `s', if present.
+++ Otherwise, return nil.
+charPosition(c,s,k) ==
+  n := # s
+  repeat
+    k >= n => return nil
+    stringChar(s,k) = c => return k
+    k := k + 1
-- 
cgit v1.2.3