preserving port line number under all input operations

lib/chibi/ast.c

@@ -120,6 +120,18 @@ static sexp sexp_get_opcode_variadic_p (sexp ctx sexp_api_params(self, n), sexp
   return sexp_make_boolean(sexp_opcode_variadic_p(op));
 }
 
+static sexp sexp_get_port_line (sexp ctx sexp_api_params(self, n), sexp p) {
+  sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, p);
+  return sexp_make_fixnum(sexp_port_line(p));
+}
+
+static sexp sexp_set_port_line (sexp ctx sexp_api_params(self, n), sexp p, sexp i) {
+  sexp_assert_type(ctx, sexp_portp, SEXP_IPORT, p);
+  sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i);
+  sexp_port_line(p) = sexp_unbox_fixnum(i);
+  return SEXP_VOID;
+}
+
 static sexp sexp_type_of (sexp ctx sexp_api_params(self, n), sexp x) {
   if (sexp_pointerp(x))
     return sexp_object_type(ctx, x);
@@ -296,6 +308,8 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
   sexp_define_foreign(ctx, env, "opcode-num-params", 1, sexp_get_opcode_num_params);
   sexp_define_foreign(ctx, env, "opcode-return-type", 1, sexp_get_opcode_ret_type);
   sexp_define_foreign(ctx, env, "opcode-param-type", 2, sexp_get_opcode_param_type);
+  sexp_define_foreign(ctx, env, "port-line", 1, sexp_get_port_line);
+  sexp_define_foreign(ctx, env, "port-line-set!", 2, sexp_set_port_line);
   sexp_define_foreign(ctx, env, "optimize", 1, sexp_optimize);
   sexp_define_foreign(ctx, env, "type-of", 1, sexp_type_of);
   sexp_define_foreign(ctx, env, "type-name", 1, sexp_type_name_op);

lib/chibi/ast.module

@@ -28,6 +28,7 @@
    opcode-variadic?
    procedure-code procedure-vars procedure-name
    bytecode-name bytecode-literals
+   port-line port-line-set!
    type? type-name type-cpl type-parent type-slots
    object-size integer->immediate gc
    string-contains)

lib/chibi/io/io.scm

@@ -1,5 +1,5 @@
 ;; io.scm -- various input/output utilities
-;; Copyright (c) 2010 Alex Shinn.  All rights reserved.
+;; Copyright (c) 2010-2011 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -14,6 +14,13 @@
       ((>= i to))
     (string-set! dst j (string-ref src i))))
 
+(define (string-count ch str . o)
+  (let ((start (if (pair? o) (car o) 0))
+        (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))))
+    (do ((i start (+ i 1))
+         (c 0 (if (eqv? ch (string-ref str i)) (+ c 1) c)))
+        ((>= i end) c))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; reading and writing
 
@@ -26,6 +33,7 @@
   (let ((in (if (pair? o) (car o) (current-input-port)))
         (n (if (and (pair? o) (pair? (cdr o))) (car (cdr o)) 8192)))
     (let ((res (%read-line n in)))
+      (port-line-set! in (+ 1 (port-line in)))
       (if (not res)
           eof
           (let ((len (string-length res)))
@@ -38,9 +46,19 @@
 (define (read-string n . o)
   (let ((in (if (pair? o) (car o) (current-input-port))))
     (let ((res (%read-string n in)))
-      (if (if (pair? res) (= 0 (car res)) #t)
+      (cond
-          eof
+       ((if (pair? res) (= 0 (car res)) #t)
-          (cadr res)))))
+        eof)
+       (else
+        (port-line-set! in (+ (string-count #\newline (cadr res))
+                              (port-line in)))
+        (cadr res))))))
+
+(define (read-string! str n . o)
+  (let* ((in (if (pair? o) (car o) (current-input-port)))
+         (res (%read-string! str n in)))
+    (port-line-set! in (+ (string-count #\newline str 0 n) (port-line in)))
+    res))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; higher order port operations

lib/chibi/io/io.stub

@@ -5,7 +5,7 @@
 (define-c size_t (%read-string "fread")
   ((result (array char arg2)) (value 1 size_t) size_t (default (current-input-port) input-port)))
 
-(define-c size_t (read-string! "fread")
+(define-c size_t (%read-string! "fread")
   (string (value 1 size_t) size_t (default (current-input-port) input-port)))
 
 (define-c size_t (write-string "fwrite")

tools/chibi-doc

@@ -387,4 +387,4 @@ div#notes {position: relative; top: 2em; left: 550px; max-width: 200px; height:
          (convert (current-input-port))
          (call-with-input-file (car args) convert)))
     (else
-     (error "usage: chibi-scribble [<input-file>]"))))
+     (error "usage: chibi-doc [<input-file>]"))))

vm.c

@@ -1486,8 +1486,10 @@ sexp sexp_vm (sexp ctx, sexp proc) {
       } else
 #endif
         _ARG1 = SEXP_EOF;
-    } else
+    } else {
+      if (i == '\n') sexp_port_line(_ARG1)++;
       _ARG1 = sexp_make_character(i);
+    }
     break;
   case SEXP_OP_PEEK_CHAR:
     if (! sexp_iportp(_ARG1))