module/srfi/srfi-1.mes

   1 ;;; -*-scheme-*-
   2
   3 ;;; Mes --- Maxwell Equations of Software
   4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;
   6 ;;; srfi-1.mes: This file is part of Mes.
   7 ;;;
   8 ;;; Mes is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; Mes is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;; srfi-1.mes is the miminimal srfi-1 needed to run mescc.
  24
  25 ;;; Code:
  26
  27 (define (find pred lst)
  28   (let loop ((lst lst))
  29     (if (null? lst) #f
  30         (if (pred (car lst)) (car lst)
  31             (loop (cdr lst))))))
  32
  33 (define (filter pred lst)
  34   (let loop ((lst lst))
  35     (if (null? lst) '()
  36         (if (pred (car lst))
  37             (cons (car lst) (loop (cdr lst)))
  38             (loop (cdr lst))))))
  39
  40 (define (append-map f lst)
  41   (apply append (map f lst)))
  42
  43 ;;; nyacc requirements
  44
  45 (define (fold proc init lst1 . rest)
  46   (if (null? rest)
  47       (let loop ((lst lst1) (result init))
  48         (if (null? lst) result
  49             (loop (cdr lst) (proc (car lst) result))))
  50       '*FOLD-n-NOT-SUPPORTED))
  51
  52 (define (fold-right proc init lst1 . rest)
  53   (if (null? rest)
  54       (let loop ((lst lst1))
  55         (if (null? lst) init
  56             (proc (car lst) (loop (cdr lst)))))
  57       '*FOLD-RIGHT-n-NOT-SUPPORTED))
  58
  59 (define (remove pred lst) (filter (lambda (x) (not (pred x))) lst))
  60
  61 (define (append-reverse rev-head tail)
  62   (let loop ((rev-head rev-head) (tail tail))
  63     (if (null? rev-head) tail
  64         (loop (cdr rev-head) (cons (car rev-head) tail)))))
  65
  66 (define (reverse! lst)
  67   (let loop ((lst lst) (result '()))
  68     (if (null? lst) result
  69         (let ((tail (cdr lst)))
  70           (set-cdr! lst result)
  71           (loop tail lst)))))
  72
  73 (mes-use-module (srfi srfi-1.upstream))