3 ;;; Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
6 ;;; This file is part of Mes.
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.
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.
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/>.
23 ;;; read-0.mes - bootstrap reader. This file is read by a minimal
24 ;;; core reader. It only supports s-exps and line-comments; quotes,
25 ;;; character literals, string literals cannot be used here.
33 (assq x (current-module)))
35 (define (cond-expand-expander clauses)
36 (if (defined? (car (car clauses)))
38 (cond-expand-expander (cdr clauses))))
40 (define-macro (cond-expand . clauses)
41 (cons 'begin (cond-expand-expander clauses)))
45 (define (pair? x) (eq? (core:type x) <cell:pair>))
46 (define (not x) (if x #f #t))
48 (define (display x . rest)
49 (if (null? rest) (core:display x)
50 (core:display-port x (car rest))))
52 (define (write x . rest)
53 (if (null? rest) (core:write x)
54 (core:write-port x (car rest))))
56 (define (list->string lst)
57 (core:make-cell <cell:string> lst 0))
59 (define (integer->char x)
60 (core:make-cell <cell:char> 0 x))
62 (define (newline . rest)
63 (core:display (list->string (list (integer->char 10)))))
65 (define (string->list s)
68 (define (cadr x) (car (cdr x)))
71 (if (null? lst) (list)
72 (cons (f (car lst)) (map1 f (cdr lst)))))
75 (if (null? lst) (list)
76 (cons (f (car lst)) (map f (cdr lst)))))
78 (define (cons* . rest)
79 (if (null? (cdr rest)) (car rest)
80 (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
82 (define (apply f h . t)
83 (if (null? t) (core:apply f h (current-module))
84 (apply f (apply cons* (cons h t)))))
86 (define (append . rest)
88 (if (null? (cdr rest)) (car rest)
89 (append2 (car rest) (apply append (cdr rest))))))
93 (define-macro (and . x)
95 (if (null? (cdr x)) (car x)
96 (list (quote if) (car x) (cons (quote and) (cdr x))
99 (define-macro (or . x)
101 (if (null? (cdr x)) (car x)
102 (list (list (quote lambda) (list (quote r))
103 (list (quote if) (quote r) (quote r)
104 (cons (quote or) (cdr x))))
107 (define-macro (module-define! module name value)
108 ;;(list 'define name value)
111 (define-macro (mes-use-module module)
116 (define (primitive-eval e) (core:eval e (current-module)))
117 (define eval core:eval)
119 (define (current-output-port) 1)
120 (define (current-error-port) 2)
121 (define (port-filename port) "<stdin>")
122 (define (port-line port) 0)
123 (define (port-column port) 0)
124 (define (ftell port) 0)
125 (define (false-if-exception x) x)
127 (define (cons* . rest)
128 (if (null? (cdr rest)) (car rest)
129 (cons (car rest) (core:apply cons* (cdr rest) (current-module)))))
131 (define (apply f h . t)
132 (if (null? t) (core:apply f h (current-module))
133 (apply f (apply cons* (cons h t)))))
135 (define-macro (cond . clauses)
136 (list 'if (pair? clauses)
141 (list (list 'if 'test
142 (if (pair? (cdr (car clauses)))
143 (if (eq? (car (cdr (car clauses))) '=>)
144 (append2 (cdr (cdr (car clauses))) '(test))
145 (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
146 (list (cons 'lambda (cons '() (cons 'test (cdr (car clauses)))))))
147 (if (pair? (cdr clauses))
148 (cons 'cond (cdr clauses)))))))
149 (car (car clauses)))))
153 (define-macro (load file)
155 (list 'if (list 'and (list getenv "MES_DEBUG")
156 (list not (list equal2? (list getenv "MES_DEBUG") "0"))
157 (list not (list equal2? (list getenv "MES_DEBUG") "1")))
159 (list core:display-error ";;; read ")
160 (list core:display-error file)
161 (list core:display-error "\n")))
162 (list 'primitive-load file)))
164 (define-macro (include file) (list 'load file))
166 (define (append . rest)
168 (if (null? (cdr rest)) (car rest)
169 (append2 (car rest) (apply append (cdr rest))))))
171 (define (string->list s)
174 (define %prefix (getenv "MES_PREFIX"))
176 (if (not %prefix) "mes/module/"
178 (append (string->list %prefix) (string->list "/module/" )))))
180 (include (list->string
181 (append2 (string->list %moduledir) (string->list "mes/type-0.mes"))))
183 (define (symbol->string s)
184 (apply string (symbol->list s)))
186 (define (string-append . rest)
187 (apply string (apply append (map1 string->list rest))))
189 (define %version (if (eq? (car (string->list "@VERSION@")) #\@) "git"
191 (define (effective-version) %version)
193 (if (list 'and (list getenv "MES_DEBUG")
194 (list not (list equal2? (list getenv "MES_DEBUG") "0"))
195 (list not (list equal2? (list getenv "MES_DEBUG") "1")))
197 (core:display-error ";;; %moduledir=")
198 (core:display-error %moduledir)
199 (core:display-error "\n")))
201 (define-macro (include-from-path file)
202 (list 'load (list string-append %moduledir file)))
204 (define (string-join lst infix)
206 (if (null? (cdr lst)) (car lst)
207 (string-append (car lst) infix (string-join (cdr lst) infix)))))
209 (include-from-path "mes/module.mes")
211 (mes-use-module (mes base))
212 (mes-use-module (mes quasiquote))
213 (mes-use-module (mes let))
214 (mes-use-module (mes scm))
215 (mes-use-module (srfi srfi-1))
216 (mes-use-module (srfi srfi-13))
217 (mes-use-module (mes fluids))
218 (mes-use-module (mes catch))
219 (mes-use-module (mes posix))
221 (define-macro (include-from-path file)
222 (let loop ((path (cons* %moduledir "module" (string-split (or (getenv "GUILE_LOAD_PATH")) #\:))))
223 (cond ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 2)) string->number))
224 (core:display-error (string-append "include-from-path: " file " [PATH:" (string-join path ":") "]\n")))
225 ((and=> (getenv "MES_DEBUG") (compose (lambda (o) (> o 1)) string->number))
226 (core:display-error (string-append "include-from-path: " file "\n"))))
227 (if (null? path) (error "include-from-path: not found: " file)
228 (let ((file (string-append (car path) "/" file)))
229 (if (access? file R_OK) `(load ,file)
230 (loop (cdr path)))))))
232 (define-macro (define-module module . rest)
233 `(if ,(and (pair? module)
234 (= 1 (length module))
235 (symbol? (car module)))
236 (define (,(car module) . arguments) (main (command-line)))))
238 (define-macro (use-modules . rest) #t)
240 (mes-use-module (mes getopt-long))
244 (let ((tty? (isatty? 0)))
245 (define (parse-opts args)
248 (compiled-path (single-char #\C) (value #t))
250 (help (single-char #\h))
252 (load-path (single-char #\L) (value #t))
253 (main (single-char #\e) (value #t))
254 (source (single-char #\s) (value #t))
255 (version (single-char #\V)))))
256 (getopt-long args option-spec #:stop-at-first-non-option #t)))
257 (define (source-arg? o)
259 (let* ((s-index (list-index source-arg? %argv))
260 (args (if s-index (list-head %argv (+ s-index 2)) %argv))
261 (options (parse-opts args))
262 (main (option-ref options 'main #f))
263 (source (option-ref options 'source #f))
264 (files (if s-index (list-tail %argv (+ s-index 1))
265 (option-ref options '() '())))
266 (help? (option-ref options 'help #f))
267 (usage? (and (not help?) (null? files) (not tty?) (not main)))
268 (version? (option-ref options 'version #f)))
271 (display (string-append "mes (Mes) " %version "\n"))
273 (and (or help? usage?)
274 (display "Usage: mes [OPTION]... [FILE]...
275 Evaluate code with Mes, interactively or from a script.
277 [-s] FILE load source code from FILE, and exit
278 -- stop scanning arguments; run interactively
280 The above switches stop argument processing, and pass all
281 remaining arguments as the value of (command-line).
283 --dump dump binary program to stdout
284 -e,--main=MAIN after reading script, apply MAIN to command-line arguments
285 -h, --help display this help and exit
286 --load load binary program [module/mes/boot-0.32-mo]
287 -L,--load-path=DIR add DIR to the front of the module load path
288 -v, --version display version information and exit
290 Ignored for Guile compatibility:
294 -C,--compiled-path=DIR
295 " (or (and usage? (current-error-port)) (current-output-port)))
296 (exit (or (and usage? 2) 0)))
298 (if main (set! %main main))
299 (and=> (option-ref options 'load-path #f)
301 (setenv "GUILE_LOAD_PATH" (string-append dir ":" (getenv "GUILE_LOAD_PATH")))))
303 (let* ((file (car files))
304 (port (if (equal? file "-") 0
305 (open-input-file file))))
307 (set-current-input-port port)))
308 ((and (null? files) tty?)
310 (mes-use-module (mes repl))
311 (set-current-input-port 0)
315 (primitive-load (open-input-string %main))