doc: Release udpate.
[mes.git] / guile / 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,2018 Jan (janneke) 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 (let ((guile (resolve-interface
31               '(guile)
32               #:select `(
33                          ;; Debugging
34                          apply
35                          cons*
36                          current-module
37                          display
38                          eof-object?
39                          eval
40                          exit
41                          force-output
42                          format
43                          list
44                          map
45                          newline
46                          read
47                          
48                          ;; Guile admin
49                          module-define!
50                          resolve-interface
51                          
52                          ;; PRIMITIVE BUILTINS
53                          car
54                          cdr
55                          cons
56                          eq?
57                          null?
58                          pair?
59                          *unspecified*
60                          
61                          ;; READER
62                          char->integer
63                          integer->char
64                          
65                          ;; non-primitive BUILTINS
66                          char?
67                          number?
68                          procedure?
69                          string?
70                          <
71                          -
72                          )
73               #:renamer (symbol-prefix-proc 'guile:)))
74       (guile-2.0 (resolve-interface '(guile) #:select '(define)))
75       (guile-2.2 (resolve-interface '(guile) #:select '(quasiquote unquote)))
76       (ports (resolve-interface
77               (if (equal? (effective-version) "2.0")'(guile) '(ice-9 ports))
78                   #:select '(
79                              ;; Debugging
80                              current-error-port
81                              current-output-port
82                              
83                              ;; READER
84                              ;;peek-char
85                              read-char
86                              unread-char)
87                   #:renamer (symbol-prefix-proc 'guile:))))
88   (set-current-module
89    (make-module 10 `(,guile ,guile-2.0 ,guile-2.2 ,ports))))
90
91 (define (logf port string . rest)
92   (guile:apply guile:format (guile:cons* port string rest))
93   (guile:force-output port)
94   #t)
95
96 (define (stderr string . rest)
97   (guile:apply logf (guile:cons* (guile:current-error-port) string rest)))
98
99 (define (stdout string . rest)
100   (guile:apply logf (guile:cons* (guile:current-output-port) string rest)))
101
102 (define (debug . x) #t)
103 (define debug stderr)
104
105 ;; TODO
106 (define (atom? x)
107   (cond
108    ((guile:pair? x) #f)
109    ((guile:null? x) #f)
110    (#t #t)))
111
112 ;; PRIMITIVES
113 (define car guile:car)
114 (define cdr guile:cdr)
115 (define cons guile:cons)
116 (define eq? guile:eq?)
117 (define null? guile:null?)
118 (define pair? guile:pair?)
119 (define builtin? guile:procedure?)
120 (define char? guile:char?)
121 (define number? guile:number?)
122 (define string? guile:number?)
123 (define call guile:apply)
124 (define (peek-byte)
125   (unread-byte (read-byte)))
126 ;;(define peek-byte guile:peek-char)
127 (define (read-byte)
128   (char->integer (guile:read-char)))
129 (define (unread-byte x)
130   (guile:unread-char (guile:integer->char x))
131   x)
132 (define (lookup x a)
133   ;; TODO
134   (stderr "lookup x=~a\n" x)
135   x)
136
137 (define (char->integer c)
138   (if (guile:eof-object? c) -1 (guile:char->integer c)))
139
140 (include "mes.mes")
141 ;; guile-2.2 only, guile-2.0 has no include?
142 (include "reader.mes")
143
144 (define (append2 x y)
145   (cond ((null? x) y)
146         (#t (cons (car x) (append2 (cdr x) y)))))
147
148 ;; READER: TODO lookup
149 (define (read)
150   (let ((x (guile:read)))
151     (if (guile:eof-object? x) '()
152         x)))
153
154 (define (lookup-macro e a)
155   #f)
156
157 (define guile:dot '#{.}#)
158
159 (define environment
160   (guile:map
161    (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module))))
162    '(
163      (*closure* . #t)
164      ((guile:list) . (guile:list))
165      (#t . #t)
166      (#f . #f)
167     
168      (*unspecified* . guile:*unspecified*)
169
170      (atom? . atom?)
171      (car . car)
172      (cdr . cdr)
173      (cons . cons)
174      ;; (cond . evcon)
175      (eq? . eq?)
176
177      (null? . null?)
178      (pair? . guile:pair?)
179      ;; (quote . quote)
180
181      (evlis-env . evlis-env)
182      (evcon . evcon)
183      (pairlis . pairlis)
184      (assq . assq)
185      (assq-ref-env . assq-ref-env)
186
187      (eval-env . eval-env)
188      (apply-env . apply-env)
189
190      (read . read)
191      (display . guile:display)
192      (newline . guile:newline)
193
194      (builtin? . builtin?)
195      (number? . number?)
196      (call . call)
197
198      (< . guile:<)
199      (- . guile:-)
200
201      ;; DERIVED
202      (caar . caar)
203      (cadr . cadr)
204      (cdar . cdar)
205      (cddr . cddr)
206      (caadr . caadr)
207      (caddr . caddr)
208      (cdadr . cdadr)
209      (cadar . cadar)
210      (cddar . cddar)
211      (cdddr . cdddr)
212
213      (append2 . append2)
214      (exit . guile:exit)
215
216      (*macro* . (guile:list))
217      (*dot* . guile:dot)
218
219      ;;
220      (stderr . stderr))))
221
222 (define (main arguments)
223   (let ((program (cons 'begin (read-input-file))))
224     (stderr "program:~a\n" program)
225     (stderr "=> ~s\n" (eval-env program environment)))
226   (guile:newline))
227
228 (guile:module-define! (guile:resolve-interface '(mes)) 'main main)