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)