guile: Resurrect eval/apply in scheme.
* guile/mes.mes (eval-expand): Short-circuit make-closure. * guile/mes.scm (environment): Update.
This commit is contained in:
Jan Nieuwenhuizen
parent
3d93eea456
commit
da9d2247e0
|
|
@ -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))
|
||||
|
|
|
|||
103
guile/mes.scm
103
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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue