From da9d2247e0c17442021606e384c23b5d85006144 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sat, 27 Jan 2018 16:43:09 +0100
Subject: [PATCH] guile: Resurrect eval/apply in scheme.

* guile/mes.mes (eval-expand): Short-circuit make-closure.
* guile/mes.scm (environment): Update.
---
 guile/mes.mes |  23 ++++++-----
 guile/mes.scm | 103 ++++++++++++++++++++++++++------------------------
 2 files changed, 67 insertions(+), 59 deletions(-)

diff --git a/guile/mes.mes b/guile/mes.mes
index 38b1ac1a..4ec945c5 100644
--- a/guile/mes.mes
+++ b/guile/mes.mes
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2016,2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; mes.mes: This file is part of Mes.
 ;;;
@@ -89,6 +89,10 @@
    ;;((eq? (car fn) 'label) (apply-env (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a)))
    (#t (apply-env (eval-env fn a) x a))))
 
+;;return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (formals, body)));
+(define (make-closure formals body a)
+  (cons (cons '*closure* #f) (cons (cons '*circ* a) (cons formals body))))
+
 (define (eval-expand e a)
   (cond
    ((eq? e '*undefined*) e)
@@ -99,6 +103,7 @@
      ((eq? (car e) 'quote) (cadr e))
      ((eq? (car e) 'syntax) (cadr e))
      ((eq? (car e) 'begin) (eval-begin-env e a))
+     ((eq? (car e) 'lambda) e)
      ((eq? (car e) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a)))
      ((eq? (car e) '*closure*) e)
      ((eq? (car e) 'if) (eval-if-env (cdr e) a))
@@ -143,14 +148,14 @@
   (if (eval-env (car e) a) (eval-env (cadr e) a)
       (if (pair? (cddr e)) (eval-env (caddr e) a))))
 
-(define (eval-quasiquote e a)
-  (cond ((null? e) e)
-        ((atom? e) e)
-        ((eq? (car e) 'unquote) (eval-env (cadr e) a))
-        ((and (pair? (car e))
-              (eq? (caar e) 'unquote-splicing))
-         (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a)))
-        (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
+;; (define (eval-quasiquote e a)
+;;   (cond ((null? e) e)
+;;         ((atom? e) e)
+;;         ((eq? (car e) 'unquote) (eval-env (cadr e) a))
+;;         ((and (pair? (car e))
+;;               (eq? (caar e) 'unquote-splicing))
+;;          (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a)))
+;;         (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
 
 (define (sexp:define e a)
   (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))
diff --git a/guile/mes.scm b/guile/mes.scm
index ea0f32e2..1e4ca3f6 100755
--- a/guile/mes.scm
+++ b/guile/mes.scm
@@ -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 Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -107,7 +107,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
   (cond
    ((guile:pair? x) #f)
    ((guile:null? x) #f)
-   (#t x)))
+   (#t #t)))
 
 ;; PRIMITIVES
 (define car guile:car)
@@ -154,72 +154,75 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
 (define (lookup-macro e a)
   #f)
 
+(define guile:dot '#{.}#)
+
 (define environment
   (guile:map
    (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module))))
    '(
-    ((guile:list) . (guile:list))
-    (#t . #t)
-    (#f . #f)
+     (*closure* . #t)
+     ((guile:list) . (guile:list))
+     (#t . #t)
+     (#f . #f)
     
-    (*unspecified* . guile:*unspecified*)
+     (*unspecified* . guile:*unspecified*)
 
-    (atom? . atom?)
-    (car . car)
-    (cdr . cdr)
-    (cons . cons)
-    ;; (cond . evcon)
-    (eq? . eq?)
+     (atom? . atom?)
+     (car . car)
+     (cdr . cdr)
+     (cons . cons)
+     ;; (cond . evcon)
+     (eq? . eq?)
 
-    (null? . null?)
-    (pair? . guile:pair?)
-    ;;(quote . quote)
+     (null? . null?)
+     (pair? . guile:pair?)
+     ;; (quote . quote)
 
-    (evlis-env . evlis-env)
-    (evcon . evcon)
-    (pairlis . pairlis)
-    (assq . assq)
-    (assq-ref-env . assq-ref-env)
+     (evlis-env . evlis-env)
+     (evcon . evcon)
+     (pairlis . pairlis)
+     (assq . assq)
+     (assq-ref-env . assq-ref-env)
 
-    (eval-env . eval-env)
-    (apply-env . apply-env)
+     (eval-env . eval-env)
+     (apply-env . apply-env)
 
-    (read . read)
-    (display . guile:display)
-    (newline . guile:newline)
+     (read . read)
+     (display . guile:display)
+     (newline . guile:newline)
 
-    (builtin? . builtin?)
-    (number? . number?)
-    (call . call)
+     (builtin? . builtin?)
+     (number? . number?)
+     (call . call)
 
-    (< . guile:<)
-    (- . guile:-)
+     (< . guile:<)
+     (- . guile:-)
 
-    ;; DERIVED
-    (caar . caar)
-    (cadr . cadr)
-    (cdar . cdar)
-    (cddr . cddr)
-    (caadr . caadr)
-    (caddr . caddr)
-    (cdadr . cdadr)
-    (cadar . cadar)
-    (cddar . cddar)
-    (cdddr . cdddr)
+     ;; 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)
+     (append2 . append2)
+     (exit . guile:exit)
 
-    (*macro* . (guile:list))
-    (*dot* . '.)
+     (*macro* . (guile:list))
+     (*dot* . guile:dot)
 
-    ;;
-    (stderr . stderr))))
+     ;;
+     (stderr . stderr))))
 
 (define (main arguments)
-  (let ((program (read-input-file)))
-    ;;(stderr "program:~a\n" program)
-    (guile:display (eval-env program environment)))
+  (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)