Add REPL.
[mes.git] / base.mes
1 ;;; -*-scheme-*-
2
3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; base.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 (define (identity x) x)
22 (define else #t)
23
24 ;; IF based
25 (define-macro (or . x)
26   (if (null? x) #f ;; IF
27       (if (null? (cdr x)) (car x) ;; IF
28           (list 'if (car x) (car x)
29                 (cons* 'or (cdr x))))))
30
31 (define-macro (and . x)
32   (if (null? x) #t ;; IF
33       (if (null? (cdr x)) (car x) ;; IF
34           (list 'if (car x) (cons 'and (cdr x)) ;; IF
35                 #f))))
36
37 (define (not x)
38   (if x #f #t))
39
40 (define (equal? a b) ;; FIXME: only 2 arg
41   (if (and (null? a) (null? b)) #t ;; IF
42       (if (and (pair? a) (pair? b))
43           (and (equal? (car a) (car b))
44                (equal? (cdr a) (cdr b)))
45           (if (and (string? a) (string? b)) ;; IF
46               (eq? (string->symbol a) (string->symbol b))
47               (if (and (vector? a) (vector? b)) ;; IF
48                   (equal? (vector->list a) (vector->list b))
49                   (eq? a b))))))
50
51 (define (memq x lst)
52   (if (null? lst) #f ;; IF
53       (if (eq? x (car lst)) lst ;; IF
54           (memq x (cdr lst)))))
55
56 (define guile? (not (pair? (current-module))))
57
58 (define (map f l . r)
59   (if (null? l) '() ;; IF
60       (if (null? r) (cons (f (car l)) (map f (cdr l))) ;; IF
61           (if (null? (cdr r)) ;; IF
62               (cons (f (car l) (caar r)) (map f (cdr l) (cdar r)))))))
63
64 (define-macro (simple-let bindings . rest)
65   (cons (cons 'lambda (cons (map car bindings) rest))
66         (map cadr bindings)))
67
68 (define-macro (let bindings . rest)
69   (cons* 'simple-let bindings rest))
70
71 (define (list? x)
72   (or (null? x)
73       (and (pair? x) (list? (cdr x)))))
74
75 (define (procedure? p)
76   (cond ((builtin? p) #t)
77         ((and (pair? p) (eq? (car p) 'lambda)))
78         ((and (pair? p) (eq? (car p) '*closure*)))
79         (#t #f)))