mes: Support map and for-each with lists of unequal length.

* mes/module/mes/base.mes (map): Support lists of unequal length.
* mes/module/mes/scm.mes (for-each): Likewise.
* module/mescc/compile.scm (expr->register): Fix compile warning.
* tests/scm.test ("map 1,2", "map 2,1", "for-each 1,2", "for-each
2,1": Test it.

mes/module/mes/base.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -126,7 +126,9 @@
         (#t #f)))
 
 (define (map f h . t)
-  (if (null? h) '()
+  (if (or (null? h)
+          (and (pair? t) (null? (car t)))
+          (and (pair? t) (pair? (cdr t)) (null? (cadr t)))) '()
       (if (null? t) (cons (f (car h)) (map f (cdr h)))
           (if (null? (cdr t))
               (cons (f (car h) (caar t)) (map f (cdr h) (cdar t)))

mes/module/mes/scm.mes

@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -56,9 +56,12 @@
        ,@body
        (loop ,@(cddar init)))))
 
-(define (for-each f l . r)
+(define (for-each f l . xr)
-  (if (pair? l) (if (null? r) (begin (f (car l)) (for-each f (cdr l)))
+  (if (and (pair? l)
-                    (if (null? (cdr r)) (begin (f (car l) (caar r)) (for-each f (cdr l) (cdar r)))))))
+           (or (null? xr)
+               (pair? (car xr))))
+      (if (null? xr) (begin (f (car l)) (for-each f (cdr l)))
+          (if (null? (cdr xr)) (begin (f (car l) (caar xr)) (for-each f (cdr l) (cdar xr)))))))
 
 (define core:error error)
 

module/mescc/compile.scm

@@ -1,5 +1,5 @@
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -911,6 +911,7 @@
 
         ((p-expr (fixed ,value))
          (let* ((value (cstring->int value))
+                (reg-size (->size "*" info))
                 (info (allocate-register info))
                 (info (append-text info (wrap-as (as info 'value->r value)))))
            (if (or #t (> value 0) (= reg-size 4)) info

tests/scm.test

@@ -9,7 +9,7 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot
 ;;; -*-scheme-*-
 
 ;;; GNU Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Mes.
 ;;;
@@ -46,7 +46,23 @@ exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests boot
 (pass-if "map" (sequal? (map identity '(1 2 3 4)) '(1 2 3 4)))
 (pass-if "map 2 " (sequal? (map (lambda (i a) (cons i a)) '(1 2 3 4) '(a b c d))
                            '((1 . a) (2 . b) (3 . c) (4 . d))))
+
+(pass-if-equal "map 1,2"
+               '((0 . a))
+               (map (lambda (x y) (cons x y)) '(0) '(a b)))
+
+(pass-if-equal "map 2,1"
+               '((0 . a))
+               (map (lambda (x y) (cons x y)) '(0 1) '(a)))
+
 (pass-if "for-each" (sequal? (let ((acc '())) (for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3 4)) acc) '(4 3 2 1)))
+
+(pass-if "for-each 1,2"
+         (for-each (lambda (x y) (cons x y)) '(0) '(a b)))
+
+(pass-if "for-each 2,1"
+         (for-each (lambda (x y) (cons x y)) '(0 1) '(a)))
+
 (define xxxa 0)
 (pass-if "set! " (seq? (begin (set! xxxa 1) xxxa) 1))
 (pass-if "set! 2" (seq? (let ((a 0)) (set! a 1) a) 1))