artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

guile: Resurrect eval/apply in scheme.

Browse source 
* guile/mes.mes (eval-expand): Short-circuit make-closure.
* guile/mes.scm (environment): Update.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-27 16:43:09 +01:00
parent 3d93eea456
commit da9d2247e0
2 changed files with 67 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
guile/mes.mes
View file

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; 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. ;;; 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))) ;;((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)))) (#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) (define (eval-expand e a)
(cond (cond
((eq? e '*undefined*) e) ((eq? e '*undefined*) e)
@ -99,6 +103,7 @@
((eq? (car e) 'quote) (cadr e)) ((eq? (car e) 'quote) (cadr e))
((eq? (car e) 'syntax) (cadr e)) ((eq? (car e) 'syntax) (cadr e))
((eq? (car e) 'begin) (eval-begin-env e a)) ((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) 'lambda) (make-closure (cadr e) (cddr e) (assq '*closure* a)))
((eq? (car e) '*closure*) e) ((eq? (car e) '*closure*) e)
((eq? (car e) 'if) (eval-if-env (cdr e) a)) ((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 (eval-env (car e) a) (eval-env (cadr e) a)
(if (pair? (cddr e)) (eval-env (caddr e) a)))) (if (pair? (cddr e)) (eval-env (caddr e) a))))
(define (eval-quasiquote e a) ;; (define (eval-quasiquote e a)
(cond ((null? e) e) ;; (cond ((null? e) e)
((atom? e) e) ;; ((atom? e) e)
((eq? (car e) 'unquote) (eval-env (cadr e) a)) ;; ((eq? (car e) 'unquote) (eval-env (cadr e) a))
((and (pair? (car e)) ;; ((and (pair? (car e))
(eq? (caar e) 'unquote-splicing)) ;; (eq? (caar e) 'unquote-splicing))
(append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a))) ;; (append2 (eval-env (cadar e) a) (eval-quasiquote (cdr e) a)))
(#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a))))) ;; (#t (cons (eval-quasiquote (car e) a) (eval-quasiquote (cdr e) a)))))
(define (sexp:define e a) (define (sexp:define e a)
(if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a)) (if (atom? (cadr e)) (cons (cadr e) (eval-env (caddr e) a))

17
guile/mes.scm
View file

@ -4,7 +4,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
!# !#
;;; Mes --- The Maxwell Equations of Software ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -107,7 +107,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
(cond (cond
((guile:pair? x) #f) ((guile:pair? x) #f)
((guile:null? x) #f) ((guile:null? x) #f)
(#t x))) (#t #t)))
;; PRIMITIVES ;; PRIMITIVES
(define car guile:car) (define car guile:car)
@ -154,10 +154,13 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
(define (lookup-macro e a) (define (lookup-macro e a)
#f) #f)
(define guile:dot '#{.}#)
(define environment (define environment
(guile:map (guile:map
(lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module)))) (lambda (x) (cons (car x) (guile:eval (cdr x) (guile:current-module))))
'( '(
(*closure* . #t)
((guile:list) . (guile:list)) ((guile:list) . (guile:list))
(#t . #t) (#t . #t)
(#f . #f) (#f . #f)
@ -173,7 +176,7 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
(null? . null?) (null? . null?)
(pair? . guile:pair?) (pair? . guile:pair?)
;;(quote . quote) ;; (quote . quote)
(evlis-env . evlis-env) (evlis-env . evlis-env)
(evcon . evcon) (evcon . evcon)
@ -211,15 +214,15 @@ exec guile -L $(pwd) -e '(mes)' -s "$0" "$@"
(exit . guile:exit) (exit . guile:exit)
(*macro* . (guile:list)) (*macro* . (guile:list))
(*dot* . '.) (*dot* . guile:dot)
;; ;;
(stderr . stderr)))) (stderr . stderr))))
(define (main arguments) (define (main arguments)
(let ((program (read-input-file))) (let ((program (cons 'begin (read-input-file))))
;;(stderr "program:~a\n" program) (stderr "program:~a\n" program)
(guile:display (eval-env program environment))) (stderr "=> ~s\n" (eval-env program environment)))
(guile:newline)) (guile:newline))
(guile:module-define! (guile:resolve-interface '(mes)) 'main main) (guile:module-define! (guile:resolve-interface '(mes)) 'main main)