mescc.scm: first a.out produced from main.c.

GNUmakefile

@@ -118,14 +118,15 @@ guile-paren: paren.test
 	echo '___P((()))' | guile -s $^ 
 
 mescc: all
-	echo ' EOF ' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax-cond.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm c-lexer.scm mescc.scm - main.c | ./mes > a.out
+	echo ' EOF ' | cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes syntax-cond.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm - main.c | ./mes > a.out
 	chmod +x a.out
 
-mescc.test: lib/lalr.scm c-lexer.scm mescc.scm
+mescc.test: lib/lalr.scm lib/rnrs/bytevectors.scm lib/srfi/srfi-1.scm lib/match.scm lib/elf.mes c-lexer.scm mescc.scm
 	cat $^ > $@
 
 guile-mescc: mescc.test
-	cat main.c | guile -s $^ 
+	cat main.c | guile -s $^ > a.out
+	chmod +x a.out
 
 hello.o: hello.S
 	as --32 -march=i386 -o $@ $^
@@ -134,6 +135,6 @@ hello: hello.o
 	ld -A i386 -m elf_i386 -nostdlib -nodefaultlibs -A i386 -o $@ $^
 #	ld -A i386 -m elf_i386 -A i386 -o $@ $^
 
-a.out: elf.mes GNUmakefile
+a.out: lib/elf.mes elf.mes GNUmakefile
-	cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes lib/rnrs/bytevectors.scm elf.mes | ./mes > a.out
+	cat base0.mes base0-$(CONDIF).mes base.mes quasiquote.mes let.mes scm.mes lib/rnrs/bytevectors.scm lib/elf.mes elf.mes | ./mes > a.out
 	chmod +x a.out

c-lexer.scm

@@ -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
@@ -37,9 +37,19 @@
    )
   (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 (port-source-location port)
   (make-source-location (port-filename port)
                         (port-line port)

elf.mes

@@ -1,198 +1,26 @@
 ;;; -*-scheme-*-
 
-(define (int->bv32 value)
+;;; Mes --- Maxwell Equations of Software
-  (let ((bv (make-bytevector 4)))
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-    (bytevector-u32-native-set! bv 0 value)
+;;;
-    bv))
+;;; scm.mes: This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
-(define (int->bv16 value)
+(define (i386:puts data length)
-  (let ((bv (make-bytevector 2)))
-    (bytevector-u16-native-set! bv 0 value)
-    bv))
-
-(define elf32-addr int->bv32)
-(define elf32-half int->bv16)
-(define elf32-off int->bv32)
-(define elf32-word int->bv32)
-
-(define (make-elf text data)
- (define vaddress #x08048000)
-
- (define ei-magic `(#x7f ,@(string->list "ELF")))
- (define ei-class '(#x01)) ;; 32 bit
- (define ei-data '(#x01)) ;; little endian
- (define ei-version '(#x01))
- (define ei-osabi '(#x00))
- (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
- (define e-ident
-   (append
-    ei-magic
-    ei-class
-    ei-data
-    ei-version
-    ei-osabi
-    ei-pad))
-
- (define ET-EXEC 2)
- (define EM-386 3)
- (define EV-CURRENT 1)
-
- (define p-filesz (elf32-word 0))
- (define p-memsz (elf32-word 0))
- (define PF-X 1)
- (define PF-W 2)
- (define PF-R 4)
- (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
- (define p-align (elf32-word 1))
-
- (define (program-header type offset text)
-   (append
-    (elf32-word type)
-    (elf32-off offset)
-    (elf32-addr (+ vaddress offset))
-    (elf32-addr (+ vaddress offset))
-    (elf32-word (length text))
-    (elf32-word (length text))
-    p-flags
-    p-align
-    ))
-
- (define (section-header name type offset text)
-   (append
-    (elf32-word name)
-    (elf32-word type)
-    (elf32-word 3) ;; write/alloc must for data hmm
-    (elf32-addr (+ vaddress offset))
-    (elf32-off offset) 
-    (elf32-word (length text))
-    (elf32-word 0)
-    (elf32-word 0)
-    (elf32-word 1)
-    (elf32-word 0)))
-
-
- (define e-type (elf32-half ET-EXEC))
- (define e-machine (elf32-half EM-386))
- (define e-version (elf32-word EV-CURRENT))
- (define e-entry (elf32-addr 0))
- ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
- ;;(define e-phoff (elf32-off 0))
- (define e-shoff (elf32-off 0))
- (define e-flags (elf32-word 0))
- ;;(define e-ehsize (elf32-half 0))
- (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
- (define e-phnum (elf32-half 1))
- (define e-shentsize (elf32-half (length (section-header 0 0 0 '()))))
- (define e-shnum (elf32-half 5))
- (define e-shstrndx (elf32-half 4))
-
- (define (elf-header size entry sections)
-   (append
-    e-ident
-    e-type
-    e-machine
-    e-version
-    (elf32-addr (+ vaddress entry)) ;; e-entry
-    (elf32-off size) ;; e-phoff
-    (elf32-off sections) ;; e-shoff
-    e-flags
-    (elf32-half size) ;; e-ehsize
-    e-phentsize
-    e-phnum
-    e-shentsize
-    e-shnum
-    e-shstrndx
-    ))
-
- (define elf-header-size
-   (length (elf-header 0 0 0)))
-
- (define program-header-size
-   (length (program-header 0 0 '())))
-
- (define text-offset
-   (+ elf-header-size program-header-size))
-
- (define (program-headers)
-   (append
-    (program-header 1 text-offset (text 0))
-    ))
-
-
- (define note
-   (string->list
-    (string-append
-     "MES"
-     ;;"Mes -- Maxwell Equations of Software\n"
-     ;;"https://gitlab.com/janneke/mes"
-     )
-    ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
-    ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
-    ))
-
- (define tab
   `(
-     #x00 ,@(string->list ".shstrtab")
+     #xba ,@(int->bv32 length)      ;; mov    $0xe,%edx
-          #x00 ,@(string->list ".text")
-          #x00 ,@(string->list ".data")
-          #x00 ,@(string->list ".note")
-          #x00 #x00 #x00 #x00
-          ))
-
- (define text-length
-   (length (text 0)))
-
- (define data-offset
-   (+ text-offset text-length))
-
- (define data-address (+ data-offset vaddress))
-
- (define data-length
-   (length data))
-
- (define note-length
-   (length note))
-
- (define note-offset
-   (+ data-offset data-length))
-
- (define tab-offset
-   (+ note-offset note-length))
-
- (define tab-length
-   (length tab))
-
- (define section-headers-offset
-   (+ tab-offset tab-length))
-
-
- (define SHT-PROGBITS 1)
- (define SHT-STRTAB 3)
- (define SHT-NOTE 7)
- (define (section-headers)
-   (append
-    (section-header 0 0 0 '())
-    (section-header 11 SHT-PROGBITS text-offset (text 0))
-    (section-header 17 SHT-PROGBITS data-offset data)
-    (section-header 23 SHT-NOTE note-offset note)
-    (section-header 1 SHT-STRTAB tab-offset tab)
-    ))
-
- (define exe
-   (append
-    (elf-header elf-header-size text-offset section-headers-offset)
-    (program-headers)
-    (text data-address)
-    data
-    note
-    tab
-    (section-headers)
-    ))
- exe)
-
-(define (i386:puts data)
-  `(
-     #xba #x0e #x00 #x00 #x00       ;; mov    $0xe,%edx
           #xb9 ,@(int->bv32 data)        ;; mov    $data,%ecx
           #xbb #x01 #x00 #x00 #x00       ;; mov    $0x1,%ebx
           #xb8 #x04 #x00 #x00 #x00       ;; mov    $0x4,%eax
@@ -206,15 +34,14 @@
          #xcd #x80                      ;; int    $0x80
          ))
 
-(define (text data)
-  (append
-   (i386:puts data)
-   (i386:exit 0)
-   ))
-
 (define data
   (string->list "Hello, world!\n"))
 
+(define (text d)
+  (append
+   (i386:puts d (length data))
+   (i386:exit 0)
+   ))
+
 (define (write-any x) (write-char (if (char? x) x (integer->char x))))
 (map write-any (make-elf text data))
-

lib/elf.mes

@@ -0,0 +1,209 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; scm.mes: This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+(define (int->bv32 value)
+  (let ((bv (make-bytevector 4)))
+    (bytevector-u32-native-set! bv 0 value)
+    bv))
+
+(define (int->bv16 value)
+  (let ((bv (make-bytevector 2)))
+    (bytevector-u16-native-set! bv 0 value)
+    bv))
+
+(define elf32-addr int->bv32)
+(define elf32-half int->bv16)
+(define elf32-off int->bv32)
+(define elf32-word int->bv32)
+
+(define (make-elf text data)
+ (define vaddress #x08048000)
+
+ (define ei-magic `(#x7f ,@(string->list "ELF")))
+ (define ei-class '(#x01)) ;; 32 bit
+ (define ei-data '(#x01)) ;; little endian
+ (define ei-version '(#x01))
+ (define ei-osabi '(#x00))
+ (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
+ (define e-ident
+   (append
+    ei-magic
+    ei-class
+    ei-data
+    ei-version
+    ei-osabi
+    ei-pad))
+
+ (define ET-EXEC 2)
+ (define EM-386 3)
+ (define EV-CURRENT 1)
+
+ (define p-filesz (elf32-word 0))
+ (define p-memsz (elf32-word 0))
+ (define PF-X 1)
+ (define PF-W 2)
+ (define PF-R 4)
+ (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
+ (define p-align (elf32-word 1))
+
+ (define (program-header type offset text)
+   (append
+    (elf32-word type)
+    (elf32-off offset)
+    (elf32-addr (+ vaddress offset))
+    (elf32-addr (+ vaddress offset))
+    (elf32-word (length text))
+    (elf32-word (length text))
+    p-flags
+    p-align
+    ))
+
+ (define (section-header name type offset text)
+   (append
+    (elf32-word name)
+    (elf32-word type)
+    (elf32-word 3) ;; write/alloc must for data hmm
+    (elf32-addr (+ vaddress offset))
+    (elf32-off offset) 
+    (elf32-word (length text))
+    (elf32-word 0)
+    (elf32-word 0)
+    (elf32-word 1)
+    (elf32-word 0)))
+
+
+ (define e-type (elf32-half ET-EXEC))
+ (define e-machine (elf32-half EM-386))
+ (define e-version (elf32-word EV-CURRENT))
+ (define e-entry (elf32-addr 0))
+ ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
+ ;;(define e-phoff (elf32-off 0))
+ (define e-shoff (elf32-off 0))
+ (define e-flags (elf32-word 0))
+ ;;(define e-ehsize (elf32-half 0))
+ (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
+ (define e-phnum (elf32-half 1))
+ (define e-shentsize (elf32-half (length (section-header 0 0 0 '()))))
+ (define e-shnum (elf32-half 5))
+ (define e-shstrndx (elf32-half 4))
+
+ (define (elf-header size entry sections)
+   (append
+    e-ident
+    e-type
+    e-machine
+    e-version
+    (elf32-addr (+ vaddress entry)) ;; e-entry
+    (elf32-off size) ;; e-phoff
+    (elf32-off sections) ;; e-shoff
+    e-flags
+    (elf32-half size) ;; e-ehsize
+    e-phentsize
+    e-phnum
+    e-shentsize
+    e-shnum
+    e-shstrndx
+    ))
+
+ (define elf-header-size
+   (length (elf-header 0 0 0)))
+
+ (define program-header-size
+   (length (program-header 0 0 '())))
+
+ (define text-offset
+   (+ elf-header-size program-header-size))
+
+ (define (program-headers)
+   (append
+    (program-header 1 text-offset (text 0))
+    ))
+
+
+ (define note
+   (string->list
+    (string-append
+     "MES"
+     ;;"Mes -- Maxwell Equations of Software\n"
+     ;;"https://gitlab.com/janneke/mes"
+     )
+    ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
+    ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
+    ))
+
+ (define tab
+   `(
+     #x00 ,@(string->list ".shstrtab")
+          #x00 ,@(string->list ".text")
+          #x00 ,@(string->list ".data")
+          #x00 ,@(string->list ".note")
+          #x00 #x00 #x00 #x00
+          ))
+
+ (define text-length
+   (length (text 0)))
+
+ (define data-offset
+   (+ text-offset text-length))
+
+ (define data-address (+ data-offset vaddress))
+
+ (define data-length
+   (length data))
+
+ (define note-length
+   (length note))
+
+ (define note-offset
+   (+ data-offset data-length))
+
+ (define tab-offset
+   (+ note-offset note-length))
+
+ (define tab-length
+   (length tab))
+
+ (define section-headers-offset
+   (+ tab-offset tab-length))
+
+
+ (define SHT-PROGBITS 1)
+ (define SHT-STRTAB 3)
+ (define SHT-NOTE 7)
+ (define (section-headers)
+   (append
+    (section-header 0 0 0 '())
+    (section-header 11 SHT-PROGBITS text-offset (text 0))
+    (section-header 17 SHT-PROGBITS data-offset data)
+    (section-header 23 SHT-NOTE note-offset note)
+    (section-header 1 SHT-STRTAB tab-offset tab)
+    ))
+
+ (define exe
+   (append
+    (elf-header elf-header-size text-offset section-headers-offset)
+    (program-headers)
+    (text data-address)
+    data
+    note
+    tab
+    (section-headers)
+    ))
+ exe)

main.c

@@ -1,4 +1,5 @@
 int main ()
 {
-  return 0;
+  puts ("Hello, [messi] world!");
+  return 1;
 }

mescc.scm

@@ -10,7 +10,7 @@
 
    (lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
            =
-           Identifier NumericLiteral
+           Identifier NumericLiteral StringLiteral
            break case continue goto label
            return switch
            if else
@@ -237,11 +237,11 @@
     (lbrace rbrace) : '(compound)
     (lbrace declaration-list rbrace) : `(compound ,@$2)
     (lbrace statement-list rbrace) :  `(compound ,@$2)
-    (lbrace declaration-list statement-list rbrace) : `(compound ,@$2 ,@$3))
+    (lbrace declaration-list statement-list rbrace) : `(compound ,@$2 ,$3))
 
    (statement-list
     (statement) : `(,$1)
-    (statement-list statement) : `(,@$1 ,@$2))
+    (statement-list statement) : `(,@$1 ,$2))
    
    ;; selection_statement:
    ;; 		   IF lparen x rparen statement			{ ; }
@@ -277,7 +277,9 @@
     (x comma assignment-expression) : `($1 ,@$2))
    		
    (assignment-expression
-    (primary-expression) : $1     ;;(conditional-expression)
+     ;;(conditional-expression)
+    ;;(primary-expression) : $1
+    (postfix-expression) : $1
     (unary-expression assignment-operator assignment-expression) : `(,$2 ,$1 ,$3))
 
    (assignment-operator
@@ -355,7 +357,8 @@
    ;; 		;
 
    (unary-expression
-    (primary-expression) : $1)
+    (postfix-expression) : $1
+    )
    ;; unary_expression:  postfix_expression
    ;; 		|  INCOP unary_expression		{ ; }
    ;; 		|  DECOP unary_expression		{ ; }
@@ -369,6 +372,11 @@
    ;; 		|  NOT cast_expression			{ ; }
    ;; 		;
 
+   (postfix-expression
+    (primary-expression) : $1
+    (postfix-expression lparen rparen) : `(call ,$1 (arguments))
+    (postfix-expression lparen argument-expression-list rparen) : `(call ,$1 ,$3))
+
    ;; postfix_expression: primary_expression
    ;; 		|  postfix_expression lbracket x rbracket
    ;; 		|  postfix_expression lparen rparen
@@ -381,7 +389,9 @@
 
    (primary-expression
     (Identifier): $1
-    (NumericLiteral) : $1)
+    (NumericLiteral) : $1
+    (StringLiteral) : $1
+    )
    ;; primary_expression: Identifier
    ;; INT_LITERAL
    ;; CHAR_LITERAL
@@ -390,12 +400,34 @@
    ;; lparen x rparen
    ;; 		
 
-   ;; argument_expression_list: assignment_expression
+   (argument-expression-list
-   ;; 		| argument_expression_list comma assignment_expression
+    (assignment-expression) : `(arguments ,$1)
-   ;; 		;
+    (argument-expression-list comma assignment-expression): `(,@$1 ,@(cdr $2)))))
 
+(define (i386:puts data)
+  `(
+     #xba #x0e #x00 #x00 #x00       ;; mov    $0xe,%edx
+          #xb9 ,@(int->bv32 data)        ;; mov    $data,%ecx
+          #xbb #x01 #x00 #x00 #x00       ;; mov    $0x1,%ebx
+          #xb8 #x04 #x00 #x00 #x00       ;; mov    $0x4,%eax
+          #xcd #x80                      ;; int    $0x80
           ))
 
+(define (i386:exit code)
+  `(
+    #xbb ,@(int->bv32 code)        ;; mov    $code,%ebx
+         #xb8 #x01 #x00 #x00 #x00       ;; mov    $0x1,%eax
+         #xcd #x80                      ;; int    $0x80
+         ))
+
+(define (i386:puts data length)
+  `(
+     #xba ,@(int->bv32 length)           ;; mov    $length,%edx
+          #xb9 ,@(int->bv32 data)        ;; mov    $data,%ecx
+          #xbb #x01 #x00 #x00 #x00       ;; mov    $0x1,%ebx
+          #xb8 #x04 #x00 #x00 #x00       ;; mov    $0x4,%eax
+          #xcd #x80                      ;; int    $0x80
+          ))
 
 (define mescc
   (let ((errorp
@@ -405,14 +437,68 @@
     (lambda ()
       (c-parser (c-lexer errorp) errorp))))
 
-(display "program: " (current-error-port))
+(define (write-any x) (write-char (if (char? x) x (integer->char x))))
-(display (mescc) (current-error-port))
-(newline (current-error-port))
 
-(define (write-int x) (write-char (integer->char x)))
+(define (ast:function? o)
-(define elf-header '(#x7f #\E #\L #\F #x01))
+  (and (pair? o) (eq? (car o) 'function)))
 
-(define elf-header '(#x7f #x45 #x4c #x46 #x01))
+(define (.name o)
-;;(map write-char elf-header)
+  (cadr o))
-(map write-int elf-header)
+
-(newline)
+;; (define (.statement o)
+;;   (match o
+;;     (('function name signature statement) statement)
+;;     (_ #f)))
+
+;; (define (statement->data o)
+;;   (match o
+;;     (('call 'puts ('arguments string)) (string->list string))
+;;     (_ '())))
+
+;; (define (statement->text o)
+;;   (match o
+;;     (('call 'puts ('arguments string)) (list (lambda (data) (i386:puts data (string-length string)))))
+;;     (('return code) (list (lambda (data) (i386:exit code))))
+;;     (_ '())))
+
+(define (.statement o)
+  (and (pair? o)
+       (eq? (car o) 'function)
+       (cadddr o)))
+
+(define (statement->data o)
+  (or (and (pair? o)
+           (eq? (car o) 'call)
+           (string->list (cadr (caddr o))))
+      '()))
+
+(define (statement->text o)
+  (cond
+   ((and (pair? o) (eq? (car o) 'call))
+    (let ((string (cadr (caddr o))))
+      (list (lambda (data) (i386:puts data (string-length string))))))
+   ((and (pair? o) (eq? (car o) 'return))
+    (list (lambda (data) (i386:exit (cadr o)))))
+   (else '())))
+
+(let* ((ast (mescc))
+       (functions (filter ast:function? (cdr ast)))
+       (main (find (lambda (x) (eq? (.name x) 'main)) functions))
+       (statements (cdr (.statement main))))
+  (display "program: " (current-error-port))
+  (display ast (current-error-port))
+  (newline (current-error-port))
+  (let loop ((statements statements) (text '()) (data '()))
+    (display "text:" (current-error-port))
+    (display text (current-error-port))
+    (newline (current-error-port))
+    (if (null? statements)
+        (map write-any (make-elf (lambda (data)
+                                   (append-map (lambda (f) (f data)) text)) data))
+        (let* ((statement (car statements)))
+          (display "statement:" (current-error-port))
+          (display statement (current-error-port))
+          (newline (current-error-port))
+          (loop (cdr statements)
+                (append text (statement->text statement))
+                (append data (statement->data statement)))))))

scm.mes

@@ -18,6 +18,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
 
+(define (cadddr x) (car (cdddr x)))
+
 (define (list . rest) rest)
 
 (define-macro (case val . args)
@@ -186,11 +188,11 @@
   (display newline))
 
 (define (syntax-error message . rest)
-  (display "syntax-error:")
+  (display "syntax-error:" (current-error-port))
-  (display message)
+  (display message (current-error-port))
-  (display ":")
+  (display ":" (current-error-port))
-  (display rest)
+  (display rest (current-error-port))
-  (newline))
+  (newline (current-error-port)))
 
 (define (list-ref lst k)
   (let loop ((lst lst) (k k))