* boot/includer.boot (%SourceLine): New datatype.

	(makeSourceLine): New.
	Use source line macro accessors.
	* boot/pile.boot: Likewise.
	* boot/scanner.boot: Likewise.

7 files changed, 68 insertions, 35 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 399977ef..a0ad08aa 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2012-05-23  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* boot/includer.boot (%SourceLine): New datatype.
+	(makeSourceLine): New.
+	Use source line macro accessors.
+	* boot/pile.boot: Likewise.
+	* boot/scanner.boot: Likewise.
+
 2012-05-22  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/br-search.boot: Use findChar and findString in lieu of STRPOS.
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index d36932d5..9b09f02b 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -116,13 +116,22 @@ bpIgnoredFromTo(pos1, pos2) ==
   shoeConsole lineString pos2
   shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
 
+--%
+structure %SourceLine ==
+  Record(str: %String, num: %Short) with
+    sourceLineString == (.str)
+    sourceLineNumber == (.num)
+
+macro makeSourceLine(s,n) ==
+  mk%SourceLine(s,n)
+
 -- Line inclusion support.
  
 lineNo p ==
-  CDAAR p
+  sourceLineNumber CAAR p
 
 lineString p == 
-  CAAAR p
+  sourceLineString CAAR p
 
 lineCharacter p == 
   rest p
@@ -147,7 +156,7 @@ bMap1(f,x)==
   [apply(f,[first x]),:bMap(f,rest x)]
 
 bDelay(f,x) ==
-  ["nonnullstream",:[f,:x]]
+  ["nonnullstream",f,:x]
  
 bAppend(x,y) ==
   bDelay(function bAppend1,[x,y])
@@ -187,7 +196,7 @@ bAddLineNumber(f1,f2) ==
 bAddLineNumber1(f1,f2)==
   bStreamNull f1 =>  ["nullstream"]
   bStreamNull f2 =>  ["nullstream"]
-  [[first f1,:first f2],:bAddLineNumber(rest f1,rest f2)]
+  [makeSourceLine(first f1,first f2),:bAddLineNumber(rest f1,rest f2)]
 
 
 shoePrefixLisp x == 
@@ -224,13 +233,13 @@ shoeInclude s ==
 shoeInclude1 s ==
   bStreamNull s => s
   [h,:t]  := s
-  string  := first h
+  string  := sourceLineString h
   command := shoeFin? string  => $bStreamNil
   command := shoeIf? string   => shoeThen([true],[STTOMC command],t)
   bAppend(shoeSimpleLine h,shoeInclude t)
  
 shoeSimpleLine(h) ==
-  string := first h
+  string := sourceLineString h
   shoePlainLine? string=> [h]
   command := shoeLisp? string => [h]
   command := shoeLine? string => [h]
@@ -249,7 +258,7 @@ shoeThen(keep,b,s) ==
 shoeThen1(keep,b,s)==
   bPremStreamNull s=> s
   [h,:t] := s
-  string := first h
+  string := sourceLineString h
   command := shoeFin? string  => bPremStreamNil(h)
   keep1 := first keep
   b1 := first b
@@ -275,7 +284,7 @@ shoeElse(keep,b,s) ==
 shoeElse1(keep,b,s)==
   bPremStreamNull s=> s
   [h,:t] := s
-  string := first h
+  string := sourceLineString h
   command := shoeFin? string => bPremStreamNil(h)
   b1 := first b
   keep1 := first keep
@@ -290,13 +299,13 @@ shoeElse1(keep,b,s)==
  
 shoeLineSyntaxError(h)==
   shoeConsole strconc('"INCLUSION SYNTAX ERROR IN LINE ",
-			     toString rest h)
-  shoeConsole first h
+			     toString sourceLineNumber h)
+  shoeConsole sourceLineString h
   shoeConsole '"LINE IGNORED"
  
 bPremStreamNil(h)==
-  shoeConsole strconc('"UNEXPECTED )fin IN LINE ",toString rest h)
-  shoeConsole first h
+  shoeConsole strconc('"UNEXPECTED )fin IN LINE ",toString sourceLineNumber h)
+  shoeConsole sourceLineString h
   shoeConsole '"REST OF FILE IGNORED"
   $bStreamNil
  
diff --git a/src/boot/pile.boot b/src/boot/pile.boot
index f789067d..f374fee9 100644
--- a/src/boot/pile.boot
+++ b/src/boot/pile.boot
@@ -57,14 +57,14 @@ shoePileInsert (s)==
  
 shoePileTree(n,s)==
   bStreamNull s => [false,n,[],s]
-  [h,t] := [first s,rest s]
+  [h,:t] := s
   hh := shoePileColumn h
   hh > n => shoePileForests(h,hh,t)
   [false,n,[],s]
  
 eqshoePileTree(n,s)==
   bStreamNull s => [false,n,[],s]
-  [h,t] := [first s,rest s]
+  [h,:t] := s
   hh := shoePileColumn h
   hh = n => shoePileForests(h,hh,t)
   [false,n,[],s]
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index f283d08a..91298559 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -64,7 +64,7 @@ shoeNextLine s==
   bStreamNull s => false
   $linepos := s
   [$f,:$r] := s
-  $ln := first $f
+  $ln := sourceLineString $f
   $n := firstNonblankPosition($ln,0)
   $sz := #$ln
   $n = nil => true
@@ -72,7 +72,7 @@ shoeNextLine s==
     a := makeString(7-($n rem 8),char " ")
     stringChar($ln,$n) := char " "
     $ln := strconc(a,$ln)
-    s1 := [[$ln,:rest $f],:$r]
+    s1 := [makeSourceLine($ln,sourceLineNumber $f),:$r]
     shoeNextLine s1
   true
  
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 7dce3190..02d2408b 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -59,9 +59,22 @@
    (|shoeConsole| (|lineString| |pos2|))
    (|shoeConsole| (CONCAT (|shoeSpaces| (|lineCharacter| |pos2|)) "|"))))
 
-(DEFUN |lineNo| (|p|) (CDAAR |p|))
+(DEFSTRUCT (|%SourceLine| (:COPIER |copy%SourceLine|)) |str| |num|)
 
-(DEFUN |lineString| (|p|) (CAAAR |p|))
+(DEFMACRO |mk%SourceLine| (|str| |num|)
+  (LIST '|MAKE-%SourceLine| :|str| |str| :|num| |num|))
+
+(DEFMACRO |sourceLineString| (|bfVar#1|) (LIST '|%SourceLine-str| |bfVar#1|))
+
+(DEFMACRO |sourceLineNumber| (|bfVar#1|) (LIST '|%SourceLine-num| |bfVar#1|))
+
+(DEFMACRO |makeSourceLine| (|bfVar#2| |bfVar#1|)
+  (|applySubst| (LIST (CONS '|bfVar#2| |bfVar#2|) (CONS '|bfVar#1| |bfVar#1|))
+                '(|mk%SourceLine| |bfVar#2| |bfVar#1|)))
+
+(DEFUN |lineNo| (|p|) (|sourceLineNumber| (CAAR |p|)))
+
+(DEFUN |lineString| (|p|) (|sourceLineString| (CAAR |p|)))
 
 (DEFUN |lineCharacter| (|p|) (CDR |p|))
 
@@ -131,7 +144,7 @@
   (COND ((|bStreamNull| |f1|) (LIST '|nullstream|))
         ((|bStreamNull| |f2|) (LIST '|nullstream|))
         (T
-         (CONS (CONS (CAR |f1|) (CAR |f2|))
+         (CONS (|makeSourceLine| (CAR |f1|) (CAR |f2|))
                (|bAddLineNumber| (CDR |f1|) (CDR |f2|))))))
 
 (DEFUN |shoePrefixLisp| (|x|) (CONCAT ")lisp" |x|))
@@ -181,7 +194,7 @@
   (LET* (|command| |string| |t| |h|)
     (COND ((|bStreamNull| |s|) |s|)
           (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
+           (SETQ |string| (|sourceLineString| |h|))
            (COND ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
                  ((SETQ |command| (|shoeIf?| |string|))
                   (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
@@ -190,7 +203,7 @@
 (DEFUN |shoeSimpleLine| (|h|)
   (LET* (|command| |string|)
     (PROGN
-     (SETQ |string| (CAR |h|))
+     (SETQ |string| (|sourceLineString| |h|))
      (COND ((|shoePlainLine?| |string|) (LIST |h|))
            ((SETQ |command| (|shoeLisp?| |string|)) (LIST |h|))
            ((SETQ |command| (|shoeLine?| |string|)) (LIST |h|))
@@ -206,7 +219,7 @@
   (LET* (|b1| |keep1| |command| |string| |t| |h|)
     (COND ((|bPremStreamNull| |s|) |s|)
           (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
+           (SETQ |string| (|sourceLineString| |h|))
            (COND
             ((SETQ |command| (|shoeFin?| |string|)) (|bPremStreamNil| |h|))
             (T (SETQ |keep1| (CAR |keep|)) (SETQ |b1| (CAR |b|))
@@ -246,7 +259,7 @@
   (LET* (|keep1| |b1| |command| |string| |t| |h|)
     (COND ((|bPremStreamNull| |s|) |s|)
           (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
+           (SETQ |string| (|sourceLineString| |h|))
            (COND
             ((SETQ |command| (|shoeFin?| |string|)) (|bPremStreamNil| |h|))
             (T (SETQ |b1| (CAR |b|)) (SETQ |keep1| (CAR |keep|))
@@ -267,15 +280,17 @@
 (DEFUN |shoeLineSyntaxError| (|h|)
   (PROGN
    (|shoeConsole|
-    (CONCAT "INCLUSION SYNTAX ERROR IN LINE " (WRITE-TO-STRING (CDR |h|))))
-   (|shoeConsole| (CAR |h|))
+    (CONCAT "INCLUSION SYNTAX ERROR IN LINE "
+            (WRITE-TO-STRING (|sourceLineNumber| |h|))))
+   (|shoeConsole| (|sourceLineString| |h|))
    (|shoeConsole| "LINE IGNORED")))
 
 (DEFUN |bPremStreamNil| (|h|)
   (PROGN
    (|shoeConsole|
-    (CONCAT "UNEXPECTED )fin IN LINE " (WRITE-TO-STRING (CDR |h|))))
-   (|shoeConsole| (CAR |h|))
+    (CONCAT "UNEXPECTED )fin IN LINE "
+            (WRITE-TO-STRING (|sourceLineNumber| |h|))))
+   (|shoeConsole| (|sourceLineString| |h|))
    (|shoeConsole| "REST OF FILE IGNORED")
    |$bStreamNil|))
 
diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp
index 6eb0c938..fb2da17f 100644
--- a/src/boot/strap/pile.clisp
+++ b/src/boot/strap/pile.clisp
@@ -24,19 +24,17 @@
              (CONS (LIST (ELT |a| 2)) (ELT |a| 3))))))))
 
 (DEFUN |shoePileTree| (|n| |s|)
-  (LET* (|hh| |t| |h| |LETTMP#1|)
+  (LET* (|hh| |t| |h|)
     (COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
-          (T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
-           (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
+          (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
            (SETQ |hh| (|shoePileColumn| |h|))
            (COND ((< |n| |hh|) (|shoePileForests| |h| |hh| |t|))
                  (T (LIST NIL |n| NIL |s|)))))))
 
 (DEFUN |eqshoePileTree| (|n| |s|)
-  (LET* (|hh| |t| |h| |LETTMP#1|)
+  (LET* (|hh| |t| |h|)
     (COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
-          (T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
-           (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
+          (T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
            (SETQ |hh| (|shoePileColumn| |h|))
            (COND ((EQUAL |hh| |n|) (|shoePileForests| |h| |hh| |t|))
                  (T (LIST NIL |n| NIL |s|)))))))
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 3c056e11..070235e3 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -28,7 +28,7 @@
     (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|))
     (COND ((|bStreamNull| |s|) NIL)
           (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
-           (SETQ |$ln| (CAR |$f|))
+           (SETQ |$ln| (|sourceLineString| |$f|))
            (SETQ |$n| (|firstNonblankPosition| |$ln| 0))
            (SETQ |$sz| (LENGTH |$ln|))
            (COND ((NULL |$n|) T)
@@ -36,7 +36,10 @@
                   (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |)))
                   (SETF (SCHAR |$ln| |$n|) (|char| '| |))
                   (SETQ |$ln| (CONCAT |a| |$ln|))
-                  (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
+                  (SETQ |s1|
+                          (CONS
+                           (|makeSourceLine| |$ln| (|sourceLineNumber| |$f|))
+                           |$r|))
                   (|shoeNextLine| |s1|))
                  (T T))))))