mes: Support map and for-each with lists of unequal length.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 2 Mar 2019 13:33:58 +0000 (14:33 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 2 Mar 2019 13:33:58 +0000 (14:33 +0100)
* 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
mes/module/mes/scm.mes
module/mescc/compile.scm
tests/scm.test

index 9591ffad38b179a337513b57de8d4b10e74cecdb..790c7228a0133a78c79237abd319bb3619fe275f 100644 (file)
@@ -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.
 ;;;
         (#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)))
index 20243ff77a7e93d0cf1e57ac9a3d2aa775473dff..a0cd051626accc2925ebcc8b588e1a509c0cc63c 100644 (file)
@@ -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.
 ;;;
        ,@body
        (loop ,@(cddar init)))))
 
-(define (for-each f l . r)
-  (if (pair? l) (if (null? r) (begin (f (car l)) (for-each f (cdr l)))
-                    (if (null? (cdr r)) (begin (f (car l) (caar r)) (for-each f (cdr l) (cdar r)))))))
+(define (for-each f l . xr)
+  (if (and (pair? l)
+           (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)
 
index 7df0afc6deff5a641fe9859ee2b225162b8cdc37..5118ff51ad11ef7fc2d5452b9dc189cbb7c9fc40 100644 (file)
@@ -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.
 ;;;
 
         ((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
index 88c6b0dbca664e3856df7dc0937cecd86520e81f..c82a6d0e86959be4af8381eff9c566a714baa948 100755 (executable)
@@ -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))