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

move mes language additions to scm.mes.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-09 15:16:30 +02:00
parent 1c6ac2b9b6
commit 59bd723a8d
3 changed files with 28 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
GNUmakefile
View file

@ -9,7 +9,7 @@ all: mes boot.mes
check: all check: all
./mes.test ./mes.test
./mes.test ./mes ./mes.test ./mes
./mes < test.mes cat scm.mes test.mes | ./mes
boot.mes: mes.mes scm.mes test.mes boot.mes: mes.mes scm.mes test.mes
cat $^ > $@ cat $^ > $@
@ -18,4 +18,4 @@ boot: all
./mes < boot.mes ./mes < boot.mes
run: all run: all
./mes < test.mes cat scm.mes test.mes | ./mes

26
scm.mes
View file

@ -21,6 +21,8 @@
;; The Maxwell Equations of Software -- John McCarthy page 13 ;; The Maxwell Equations of Software -- John McCarthy page 13
;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf ;; http://www.softwarepreservation.org/projects/LISP/book/LISP%201.5%20Programmers%20Manual.pdf
(define (list . rest) rest)
(define (scm-define x a) (define (scm-define x a)
(cond ((atom (cadr x)) (cons (cadr x) (eval (caddr x) a))) (cond ((atom (cadr x)) (cons (cadr x) (eval (caddr x) a)))
(#t (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x))))))) (#t (cons (caadr x) (cons 'lambda (cons (cdadr x) (cddr x)))))))
@ -54,3 +56,27 @@
;;(display 'loop:read-loop2-exiting...) ;;(display 'loop:read-loop2-exiting...)
;;(newline) ;;(newline)
EOF EOF
(define (+ x y) (- x (- 0 y)))
(define-macro (and x y)
(cond (x y)
(#t #f)))
(define-macro (or x y)
(cond (x x)
(#t y)))
(define (split-params bindings params)
(cond ((null bindings) params)
(#t (split-params (cdr bindings)
(append params (cons (caar bindings) '()))))))
(define (split-values bindings values)
(cond ((null bindings) values)
(#t (split-values (cdr bindings)
(append values (cdar bindings) '())))))
(define-macro (let bindings . body)
(cons (cons 'lambda (cons (split-params bindings '()) body))
(split-values bindings '())))

46
test.mes
View file

@ -35,23 +35,10 @@
(display (- 12 3)) (display (- 12 3))
(newline) (newline)
(define (+ x y) (- x (- 0 y)))
(display (+ 3 4)) (display (+ 3 4))
(newline) (newline)
(define-macro (and x y)
(cond (x y)
(#t #f)))
(define-macro (or x y)
(cond (x x)
(#t y)))
;; EOF2
;; EOF
;; EOF2
(display 'and-0-1:) (display 'and-0-1:)
(display (and 0 1)) (display (and 0 1))
(newline) (newline)
@ -66,39 +53,6 @@
(display (or #f 2)) (display (or #f 2))
(newline) (newline)
(define (split-params bindings params)
(cond ((null bindings) params)
(#t (split-params (cdr bindings)
(append params (cons (caar bindings) '()))))))
(define (split-values bindings values)
(cond ((null bindings) values)
(#t (split-values (cdr bindings)
(append values (cdar bindings) '())))))
(define-macro (let1 bindings body)
(cons (cons 'lambda (cons (split-params bindings '()) (cons body '())))
(split-values bindings '())))
(let1 ((a 3)
(b 4))
((lambda ()
(display 'let-a:3-b:4)
(newline)
(display 'a:)
(display a)
(newline)
(display 'b:)
(display b)
(newline))))
(display 'let1-dun)
(newline)
(define-macro (let bindings . body)
(cons (cons 'lambda (cons (split-params bindings '()) body))
(split-values bindings '())))
(let ((p 5) (let ((p 5)
(q 6)) (q 6))
(display 'let-p:3-q:4) (display 'let-p:3-q:4)