327b4d90abf1124eeb1e3c844559b047fb4fbb4a
[mes.git] / mes.scm
1 #! /bin/sh
2 # -*-scheme-*-
3 exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
4 !#
5
6 ;;; Mes --- The Maxwell Equations of Software
7 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
8 ;;;
9 ;;; This file is part of GNU Guix.
10 ;;;
11 ;;; Mes is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or (at
14 ;;; your option) any later version.
15 ;;;
16 ;;; Mes is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ;;; GNU General Public License for more details.
20 ;;;
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
23
24 ;; The Maxwell Equations of Software -- John McCarthy page 13
25 ;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf
26
27 (define-module (mes)
28   #:export (main))
29
30 (set-current-module
31  (make-module 10 `(,(resolve-interface
32                      '(guile)
33                      #:select '(
34                                 ;; Debugging
35                                 apply
36                                 cons*
37                                 current-error-port
38                                 current-output-port
39                                 display
40                                 eof-object?
41                                 exit
42                                 force-output
43                                 format
44                                 newline
45                                 read
46                                 with-input-from-string
47
48                                 ;; Guile admin
49                                 module-define!
50                                 resolve-interface
51
52                                 ;; PRIMITIVES
53                                 car
54                                 cdr
55                                 cons
56                                 eq?
57                                 null?
58                                 pair?
59
60                                 ;; ADDITIONAL PRIMITIVES
61                                 apply
62                                 number?
63                                 procedure?
64                                 <
65                                 -
66                                 )
67                      #:renamer (symbol-prefix-proc 'guile:)))))
68
69 (define (logf port string . rest)
70   (guile:apply guile:format (guile:cons* port string rest))
71   (guile:force-output port)
72   #t)
73
74 (define (stderr string . rest)
75   (guile:apply logf (guile:cons* (guile:current-error-port) string rest)))
76
77 (define (stdout string . rest)
78   (guile:apply logf (guile:cons* (guile:current-output-port) string rest)))
79
80 (define (debug . x) #t)
81 ;;(define debug stderr)
82
83 ;; TODO
84 (define (atom x)
85   (cond
86    ((guile:pair? x) #f)
87    ((guile:null? x) #f)
88    (#t x)))
89
90 ;; PRIMITIVES
91 (define car guile:car)
92 (define cdr guile:cdr)
93 (define cons guile:cons)
94 (define eq guile:eq?)
95 (define null guile:null?)
96 (define pair guile:pair?)
97 (define builtin guile:procedure?)
98 (define number guile:number?)
99 (define call guile:apply)
100
101 (include "mes.mes")
102
103 (define (append x y)
104   (cond ((null x) y)
105         (#t (cons (car x) (append (cdr x) y)))))
106
107 (define (eval-environment e a)
108   (eval e (append a environment)))
109
110 (define (apply-environment fn e a)
111   (apply fn e (append a environment)))
112
113 (define (readenv a)
114   (let ((x (guile:read)))
115     (if (guile:eof-object? x) '()
116         x)))
117
118 (define environment
119   `(
120     (() . ())
121     (#t . #t)
122     (#f . #f)
123     
124     (*unspecified* . ,*unspecified*)
125
126     (atom . ,atom)
127     (car . ,car)
128     (cdr . ,cdr)
129     (cons . ,cons)
130     (cond . ,evcon)
131     (eq . ,eq)
132
133     (null . ,null)
134     (pair . ,guile:pair?)
135     ;;(quote . ,quote)
136
137     (evlis . ,evlis)
138     (evcon . ,evcon)
139     (pairlis . ,pairlis)
140     (assoc . ,assoc)
141
142     (eval . ,eval-environment)
143     (apply . ,apply-environment)
144
145     (readenv . ,readenv)
146     (display . ,guile:display)
147     (newline . ,guile:newline)
148
149     (builtin . ,builtin)
150     (number . ,number)
151     (call . ,call)
152
153     (< . ,guile:<)
154     (- . ,guile:-)
155
156     ;; DERIVED
157     (caar . ,caar)
158     (cadr . ,cadr)
159     (cdar . ,cdar)
160     (cddr . ,cddr)
161     (caadr . ,caadr)
162     (caddr . ,caddr)
163     (cdadr . ,cdadr)
164     (cadar . ,cadar)
165     (cddar . ,cddar)
166     (cdddr . ,cdddr)
167
168     (append . ,append)
169     (exit . ,guile:exit)
170
171     (*macro* . ())
172
173     ;;
174     (stderr . ,stderr)))
175
176 (define (mes-define-lambda x a)
177   (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x)))))
178
179 (define (mes-define x a)
180   (if (atom (cadr x))
181       (cons (cadr x) (eval (caddr x) a))
182       (mes-define-lambda x a)))
183
184 (define (mes-define-macro x a)
185   (cons '*macro*
186         (cons (mes-define-lambda x a)
187               (cdr (assoc '*macro* a)))))
188
189 (define (loop r e a)
190   (cond ((null e) r)
191         ((eq e 'exit)
192          (apply (cdr (assoc 'loop a))
193                 (cons *unspecified* (cons #t (cons a '())))
194                 a))
195         ((atom e) (loop (eval e a) (readenv a) a))
196         ((eq (car e) 'define)
197          (loop *unspecified* (readenv a) (cons (mes-define e a) a)))
198         ((eq (car e) 'define-macro)
199          (loop *unspecified* (readenv a) (cons (mes-define-macro e a) a)))
200         (#t (loop (eval e a) (readenv a) a))))
201
202 (define (main arguments)
203   (let ((a (append environment `((*a* . ,environment)))))
204     ;;(guile:display (eval (readenv a) a))
205     (guile:display (loop *unspecified* (readenv a) a))
206     )
207   (guile:newline))
208
209 (guile:module-define! (guile:resolve-interface '(mes)) 'main main)