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))

103
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,72 +154,75 @@ 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))))
'( '(
((guile:list) . (guile:list)) (*closure* . #t)
(#t . #t) ((guile:list) . (guile:list))
(#f . #f) (#t . #t)
(#f . #f)
(*unspecified* . guile:*unspecified*) (*unspecified* . guile:*unspecified*)
(atom? . atom?) (atom? . atom?)
(car . car) (car . car)
(cdr . cdr) (cdr . cdr)
(cons . cons) (cons . cons)
;; (cond . evcon) ;; (cond . evcon)
(eq? . eq?) (eq? . eq?)
(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)
(pairlis . pairlis) (pairlis . pairlis)
(assq . assq) (assq . assq)
(assq-ref-env . assq-ref-env) (assq-ref-env . assq-ref-env)
(eval-env . eval-env) (eval-env . eval-env)
(apply-env . apply-env) (apply-env . apply-env)
(read . read) (read . read)
(display . guile:display) (display . guile:display)
(newline . guile:newline) (newline . guile:newline)
(builtin? . builtin?) (builtin? . builtin?)
(number? . number?) (number? . number?)
(call . call) (call . call)
(< . guile:<) (< . guile:<)
(- . guile:-) (- . guile:-)
;; DERIVED ;; DERIVED
(caar . caar) (caar . caar)
(cadr . cadr) (cadr . cadr)
(cdar . cdar) (cdar . cdar)
(cddr . cddr) (cddr . cddr)
(caadr . caadr) (caadr . caadr)
(caddr . caddr) (caddr . caddr)
(cdadr . cdadr) (cdadr . cdadr)
(cadar . cadar) (cadar . cadar)
(cddar . cddar) (cddar . cddar)
(cdddr . cdddr) (cdddr . cdddr)
(append2 . append2) (append2 . append2)
(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)