mescc: Refactor type system: struct/enum fields: (name . <type>).
[mes.git] / guile / mes.scm
index df50b988f5ff7b5e0cefdde276695040c88c3635..b9032657d4f289e09b85d9e7a74574d127f6bb70 100755 (executable)
@@ -4,7 +4,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
 !#
 
 ;;; Mes --- The Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,51 +27,66 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
 (define-module (mes)
   #:export (main))
 
-(set-current-module
- (make-module 10 `(,(resolve-interface
-                     '(guile)
-                     #:select '(
-                                ;; Debugging
-                                apply
-                                cons*
-                                current-error-port
-                                current-output-port
-                                display
-                                eof-object?
-                                exit
-                                force-output
-                                format
-                                newline
-                                read
-                                with-input-from-string
-
-                                ;; Guile admin
-                                module-define!
-                                resolve-interface
-
-                                ;; PRIMITIVE BUILTINS
-                                car
-                                cdr
-                                cons
-                                eq?
-                                null?
-                                pair?
-
-                                ;; READER
-                                char->integer
-                                integer->char
-                                read-char
-                                unread-char
-                                
-                                ;; non-primitive BUILTINS
-                                char?
-                                number?
-                                procedure?
-                                string?
-                                <
-                                -
-                                )
-                     #:renamer (symbol-prefix-proc 'guile:)))))
+(let ((guile (resolve-interface
+              '(guile)
+              #:select `(
+                         ;; Debugging
+                         apply
+                         cons*
+                         current-module
+                         display
+                         eof-object?
+                         eval
+                         exit
+                         force-output
+                         format
+                         list
+                         map
+                         newline
+                         read
+                         
+                         ;; Guile admin
+                         module-define!
+                         resolve-interface
+                         
+                         ;; PRIMITIVE BUILTINS
+                         car
+                         cdr
+                         cons
+                         eq?
+                         null?
+                         pair?
+                         *unspecified*
+                         
+                         ;; READER
+                         char->integer
+                         integer->char
+                         
+                         ;; non-primitive BUILTINS
+                         char?
+                         number?
+                         procedure?
+                         string?
+                         <
+                         -
+                         )
+              #:renamer (symbol-prefix-proc 'guile:)))
+      (guile-2.0 (resolve-interface '(guile) #:select '(define)))
+      (guile-2.2 (resolve-interface '(guile) #:select '(quasiquote unquote)))
+      (ports (resolve-interface
+              (if (equal? (effective-version) "2.0")'(guile) '(ice-9 ports))
+                  #:select '(
+                             ;; Debugging
+                             current-error-port
+                             current-output-port
+                             
+                             ;; READER
+                             ;;peek-char
+                             read-char
+                             unread-char)
+                  #:renamer (symbol-prefix-proc 'guile:))))
+  (set-current-module
+   (make-module 10 `(,guile ,guile-2.0 ,guile-2.2 ,ports))))
 
 (define (logf port string . rest)
   (guile:apply guile:format (guile:cons* port string rest))
@@ -85,14 +100,14 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
   (guile:apply logf (guile:cons* (guile:current-output-port) string rest)))
 
 (define (debug . x) #t)
-;;(define debug stderr)
+(define debug stderr)
 
 ;; TODO
 (define (atom? x)
   (cond
    ((guile:pair? x) #f)
    ((guile:null? x) #f)
-   (#t x)))
+   (#t #t)))
 
 ;; PRIMITIVES
 (define car guile:car)
@@ -108,8 +123,9 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
 (define call guile:apply)
 (define (peek-byte)
   (unread-byte (read-byte)))
+;;(define peek-byte guile:peek-char)
 (define (read-byte)
-  (guile:char->integer (guile:read-char)))
+  (char->integer (guile:read-char)))
 (define (unread-byte x)
   (guile:unread-char (guile:integer->char x))
   x)
@@ -118,113 +134,95 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
   (stderr "lookup x=~a\n" x)
   x)
 
+(define (char->integer c)
+  (if (guile:eof-object? c) -1 (guile:char->integer c)))
+
 (include "mes.mes")
+;; guile-2.2 only, guile-2.0 has no include?
+(include "reader.mes")
 
 (define (append2 x y)
   (cond ((null? x) y)
         (#t (cons (car x) (append2 (cdr x) y)))))
 
-(define (eval-environment e a)
-  (eval e (append2 a environment)))
-
-(define (apply-environment fn e a)
-  (apply-env fn e (append2 a environment)))
-
 ;; READER: TODO lookup
-(define (readenv a)
+(define (read)
   (let ((x (guile:read)))
     (if (guile:eof-object? x) '()
         x)))
 
+(define (lookup-macro e a)
+  #f)
+
+(define guile:dot '#{.}#)
+
 (define environment
-  `(
-    (() . ())
-    (#t . #t)
-    (#f . #f)
+  (guile:map
+   (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module))))
+   '(
+     (*closure* . #t)
+     ((guile:list) . (guile:list))
+     (#t . #t)
+     (#f . #f)
     
-    (*unspecified* . ,*unspecified*)
-
-    (atom? . ,atom?)
-    (car . ,car)
-    (cdr . ,cdr)
-    (cons . ,cons)
-    (cond . ,evcon)
-    (eq? . ,eq?)
-
-    (null? . ,null?)
-    (pair? . ,guile:pair?)
-    ;;(quote . ,quote)
-
-    (evlis . ,evlis)
-    (evcon . ,evcon)
-    (pairlis . ,pairlis)
-    (assq . ,assq)
-
-    (eval . ,eval-environment)
-    (apply-env . ,apply-environment)
-
-    (readenv . ,readenv)
-    (display . ,guile:display)
-    (newline . ,guile:newline)
-
-    (builtin? . ,builtin?)
-    (number? . ,number?)
-    (call . ,call)
-
-    (< . ,guile:<)
-    (- . ,guile:-)
-
-    ;; DERIVED
-    (caar . ,caar)
-    (cadr . ,cadr)
-    (cdar . ,cdar)
-    (cddr . ,cddr)
-    (caadr . ,caadr)
-    (caddr . ,caddr)
-    (cdadr . ,cdadr)
-    (cadar . ,cadar)
-    (cddar . ,cddar)
-    (cdddr . ,cdddr)
-
-    (append2 . ,append2)
-    (exit . ,guile:exit)
-
-    (*macro* . ())
-
-    ;;
-    (stderr . ,stderr)))
-
-(define (mes-define-lambda x a)
-  (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x)))))
-
-(define (mes-define x a)
-  (if (atom? (cadr x))
-      (cons (cadr x) (eval (caddr x) a))
-      (mes-define-lambda x a)))
-
-(define (mes-define-macro x a)
-  (cons '*macro*
-        (cons (mes-define-lambda x a)
-              (cdr (assq '*macro* a)))))
-
-(define (loop r e a)
-  (cond ((null? e) r)
-        ((eq? e 'exit)
-         (apply-env (cdr (assq 'loop a))
-                    (cons *unspecified* (cons #t (cons a '())))
-                    a))
-        ((atom? e) (loop (eval e a) (readenv a) a))
-        ((eq? (car e) 'define)
-         (loop *unspecified* (readenv a) (cons (mes-define e a) a)))
-        ((eq? (car e) 'define-macro)
-         (loop *unspecified* (readenv a) (cons (mes-define-macro e a) a)))
-        (#t (loop (eval e a) (readenv a) a))))
+     (*unspecified* . guile:*unspecified*)
+
+     (atom? . atom?)
+     (car . car)
+     (cdr . cdr)
+     (cons . cons)
+     ;; (cond . evcon)
+     (eq? . eq?)
+
+     (null? . null?)
+     (pair? . guile:pair?)
+     ;; (quote . quote)
+
+     (evlis-env . evlis-env)
+     (evcon . evcon)
+     (pairlis . pairlis)
+     (assq . assq)
+     (assq-ref-env . assq-ref-env)
+
+     (eval-env . eval-env)
+     (apply-env . apply-env)
+
+     (read . read)
+     (display . guile:display)
+     (newline . guile:newline)
+
+     (builtin? . builtin?)
+     (number? . number?)
+     (call . call)
+
+     (< . guile:<)
+     (- . guile:-)
+
+     ;; DERIVED
+     (caar . caar)
+     (cadr . cadr)
+     (cdar . cdar)
+     (cddr . cddr)
+     (caadr . caadr)
+     (caddr . caddr)
+     (cdadr . cdadr)
+     (cadar . cadar)
+     (cddar . cddar)
+     (cdddr . cdddr)
+
+     (append2 . append2)
+     (exit . guile:exit)
+
+     (*macro* . (guile:list))
+     (*dot* . guile:dot)
+
+     ;;
+     (stderr . stderr))))
 
 (define (main arguments)
-  (let ((a (append2 environment `((*a* . ,environment)))))
-    ;;(guile:display (eval (readenv a) a))
-    (guile:display (loop *unspecified* (readenv a) a))
-    )
+  (let ((program (cons 'begin (read-input-file))))
+    (stderr "program:~a\n" program)
+    (stderr "=> ~s\n" (eval-env program environment)))
   (guile:newline))
 
 (guile:module-define! (guile:resolve-interface '(mes)) 'main main)