artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Support equal? with arbitrary number of arguments.

Browse source 
* module/mes/base.mes (equal2?): Rename from equal?.
  (equal?): Implement.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-01 23:00:01 +01:00
parent 72a4f7eba2
commit 4dfad613bf
1 changed files with 11 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
module/mes/base.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2017,2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of Mes. ;;; This file is part of Mes.
;;; ;;;
@ -90,17 +90,23 @@
(define (and=> value procedure) (and value (procedure value))) (define (and=> value procedure) (and value (procedure value)))
(define eqv? eq?) (define eqv? eq?)
(define (equal? a b) ;; FIXME: only 2 arg (define (equal2? a b)
(if (and (null? a) (null? b)) #t (if (and (null? a) (null? b)) #t
(if (and (pair? a) (pair? b)) (if (and (pair? a) (pair? b))
(and (equal? (car a) (car b)) (and (equal2? (car a) (car b))
(equal? (cdr a) (cdr b))) (equal2? (cdr a) (cdr b)))
(if (and (string? a) (string? b)) (if (and (string? a) (string? b))
(eq? (string->symbol a) (string->symbol b)) (eq? (string->symbol a) (string->symbol b))
(if (and (vector? a) (vector? b)) (if (and (vector? a) (vector? b))
(equal? (vector->list a) (vector->list b)) (equal2? (vector->list a) (vector->list b))
(eq? a b)))))) (eq? a b))))))
(define (equal? . x)
(if (or (null? x) (null? (cdr x))) #t
(if (null? (cddr x)) (equal2? (car x) (cadr x))
(and (equal2? (car x) (cadr x))
(apply equal? (cdr x))))))
(define (list? x) (define (list? x)
(or (null? x) (or (null? x)
(and (pair? x) (list? (cdr x))))) (and (pair? x) (list? (cdr x)))))