mescc.scm: compile simple, well-behaved for-loop.
[mes.git] / c-lexer.scm
index 1664c2390461b7b823c10cebc9ad534af6a51a37..7deadacbc56a0a2374873e3fa20230de0599a1e3 100644 (file)
@@ -26,7 +26,7 @@
 
 (cond-expand
   (guile
-   (use-modules ((ice-9 rdelim)))
+   ;;(use-modules ((ice-9 rdelim)))
 
    (define (syntax-error what loc form . args)
      (throw 'syntax-error #f what
    )
   (mes
 
+      
    )
   )
 
+(define (read-delimited delims port handle-delim)
+     (let ((stop (string->list delims)))
+       (let loop ((c (peek-char)) (lst '()))
+         (if (member c stop)
+             (list->string lst)
+             (begin
+               (read-char)
+               (loop (peek-char) (append lst (list c))))))))
+
+(define (read-line . rest ;; port handle-delim
+         )
+  (let ((line (read-delimited "\n\r" (current-input-port) 'peek)))
+    (read-char)
+    line))
 
 (define (port-source-location port)
   (make-source-location (port-filename port)
 
 (define (read-string loc)
   (let ((c (read-char)))
-    (let ((terms (string c #\\ #\nl #\cr)))
+    (let ((terms (string c #\\ #\newline #\return)))
       (define (read-escape)
         (let ((c (read-char)))
           (case c
             ((#\' #\" #\\) c)
-            ((#\b) #\bs)
-            ((#\f) #\np)
-            ((#\n) #\nl)
-            ((#\r) #\cr)
+            ((#\b) #\backspace)
+            ((#\f) #\page)
+            ((#\n) #\newline)
+            ((#\r) #\return)
             ((#\t) #\tab)
             ((#\v) #\vt)
             ((#\0)
                                 puncs))))))
     (lambda (loc)
       (let lp ((c (peek-char)) (tree punc-tree) (candidate #f))
-        (display "read-punctuation c=") (display c) (newline)
+        ;;(display "read-punctuation c=") (display c) (newline)
         (cond
          ((assv-ref tree c)
           (let ((node-tail (assv-ref tree c)))
 (define (next-token div?)
   (let ((c   (peek-char))
         (loc (port-source-location (current-input-port))))
-    (display "next-token c=") (display c) (newline)
+    ;;(display "next-token c=") (display c) (newline)
 
     (case c
-      ((#\ht #\vt #\np #\space #\x00A0) ; whitespace
+      ((#\tab #\vt #\page #\space ;;#\x00A0
+        ) ; whitespace
        (read-char)
        (next-token div?))
-      ((#\newline #\cr)                 ; line break
+      ((#\newline #\return)                 ; line break
        (read-char)
        (next-token div?))
       ((#\/)