Extend Scheme reader, reduce C reader dependency.
[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 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 (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 x)))
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 environment
158   (guile:map
159    (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module))))
160    '(
161     ((guile:list) . (guile:list))
162     (#t . #t)
163     (#f . #f)
164     
165     (*unspecified* . guile:*unspecified*)
166
167     (atom? . atom?)
168     (car . car)
169     (cdr . cdr)
170     (cons . cons)
171     ;; (cond . evcon)
172     (eq? . eq?)
173
174     (null? . null?)
175     (pair? . guile:pair?)
176     ;;(quote . quote)
177
178     (evlis-env . evlis-env)
179     (evcon . evcon)
180     (pairlis . pairlis)
181     (assq . assq)
182     (assq-ref-cache . assq-ref-cache)
183
184     (eval-env . eval-env)
185     (apply-env . apply-env)
186
187     (read . read)
188     (display . guile:display)
189     (newline . guile:newline)
190
191     (builtin? . builtin?)
192     (number? . number?)
193     (call . call)
194
195     (< . guile:<)
196     (- . guile:-)
197
198     ;; DERIVED
199     (caar . caar)
200     (cadr . cadr)
201     (cdar . cdar)
202     (cddr . cddr)
203     (caadr . caadr)
204     (caddr . caddr)
205     (cdadr . cdadr)
206     (cadar . cadar)
207     (cddar . cddar)
208     (cdddr . cdddr)
209
210     (append2 . append2)
211     (exit . guile:exit)
212
213     (*macro* . (guile:list))
214     (*dot* . '.)
215
216     ;;
217     (stderr . stderr))))
218
219 (define (main arguments)
220   (let ((program (read-input-file)))
221     ;;(stderr "program:~a\n" program)
222     (guile:display (eval-env program environment)))
223   (guile:newline))
224
225 (guile:module-define! (guile:resolve-interface '(mes)) 'main main)