From 90b384def3a8cba784cd89785b396380b7f5f7d6 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 2 Mar 2019 14:33:58 +0100 Subject: [PATCH] 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 | 6 ++++-- mes/module/mes/scm.mes | 11 +++++++---- module/mescc/compile.scm | 3 ++- tests/scm.test | 18 +++++++++++++++++- 4 files changed, 30 insertions(+), 8 deletions(-) diff --git a/mes/module/mes/base.mes b/mes/module/mes/base.mes index 9591ffad..790c7228 100644 --- a/mes/module/mes/base.mes +++ b/mes/module/mes/base.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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))) diff --git a/mes/module/mes/scm.mes b/mes/module/mes/scm.mes index 20243ff7..a0cd0516 100644 --- a/mes/module/mes/scm.mes +++ b/mes/module/mes/scm.mes @@ -1,7 +1,7 @@ ;;; -*-scheme-*- ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of GNU Mes. ;;; @@ -56,9 +56,12 @@ ,@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) diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm index 7df0afc6..5118ff51 100644 --- a/module/mescc/compile.scm +++ b/module/mescc/compile.scm @@ -1,5 +1,5 @@ ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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 diff --git a/tests/scm.test b/tests/scm.test index 88c6b0db..c82a6d0e 100755 --- a/tests/scm.test +++ b/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 +;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen ;;; ;;; 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))