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

guile runs macro-based mes:define-syntax, mes runs but yields *undefined*.

Browse source
This commit is contained in:
Jan Nieuwenhuizen 2016-07-17 00:03:14 +02:00
parent be12facd6d
commit d21d4aecfc
3 changed files with 63 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
GNUmakefile
View file

@ -48,5 +48,8 @@ run: all
syntax: all syntax: all
cat scm.mes syntax.mes | ./mes cat scm.mes syntax.mes | ./mes
guile-syntax:
guile -s syntax.mes
macro: all macro: all
cat macro.mes | ./mes cat macro.mes | ./mes

16
macro.mes
View file

@ -16,22 +16,24 @@
(display b) (display b)
(newline))) (newline)))
(display "f-define-macro...") (display "f-define-macro: ")
(fm 'dinges) (fm 'dinges)
(a c) (a c)
(newline) (newline)
(define-macro (m a) (define-macro (m a)
`(define-macro (,a) ;;;(,a b) b: todo `(define-macro ;;(,a)
(display "b") ;; (display b) ;; todo (,a b)
(display "b")
(display b) ;; todo
(newline))) (newline)))
(display "define-macro...") (display "define-macro: ")
(m dinges) (m dinges)
(newline)
(display "running dinges...") (display "running dinges: ")
(dinges) (dinges c)
(newline) (newline)
(newline) (newline)

112
syntax.mes
View file

@ -1,4 +1,4 @@
(define else #t) ;;(define else #t)
(define (syntax-error message thing) (define (syntax-error message thing)
(display "syntax-error:") (display "syntax-error:")
(display message) (display message)
@ -6,7 +6,7 @@
;;(display thing) ;;(display thing)
(newline)) (newline))
(display "define-syntax...") (display "mes:define-syntax...")
;;(define (caddr x) (car (cdr (cdr x)))) ;;(define (caddr x) (car (cdr (cdr x))))
;; (define (caddr x) ;; (define (caddr x)
@ -14,7 +14,7 @@
;; (display x) ;; (display x)
;; (newline)) ;; (newline))
;; (define-macro define-syntax ;; (define-macro mes:define-syntax
;; (lambda (form expander) ;; (lambda (form expander)
;; (expander `(define-macro ,(cadr form) ;; (expander `(define-macro ,(cadr form)
;; (let ((transformer ,(caddr form))) ;; (let ((transformer ,(caddr form)))
@ -37,12 +37,12 @@
;; eq?) ;; eq?)
;; expander))))) ;; expander)))))
;; (define-macro (define-syntax form expander) ;; (define-macro (mes:define-syntax form expander)
;; `(expander (dinges form expander) ;; `(expander (dinges form expander)
;; expander)) ;; expander))
(define-macro (define-syntax macro-name transformer . stuff) (define-macro (mes:define-syntax macro-name transformer . stuff)
;; (display "define-syntax:") ;; (display "mes:define-syntax:")
;; (newline) ;; (newline)
;; (display `(define-macro (,macro-name . args) ;; (display `(define-macro (,macro-name . args)
;; (,transformer (cons ',macro-name args) ;; (,transformer (cons ',macro-name args)
@ -50,15 +50,13 @@
;; eq?))) ;; eq?)))
;; (newline) ;; (newline)
`(define-macro (,macro-name . args) `(define-macro (,macro-name . args)
( (,transformer (cons ',macro-name args)
,transformer (cons ',macro-name args)
(lambda (x) x) (lambda (x) x)
eq? eq?)
) ;;"blaat"
) ))
)
;; (define-macro (define-syntax form expander) ;; (define-macro (mes:define-syntax form expander)
;; (expander `(define-macro ,(cadr form) ;; (expander `(define-macro ,(cadr form)
;; (let ((transformer ,(caddr form))) ;; (let ((transformer ,(caddr form)))
;; (lambda (form expander) ;; (lambda (form expander)
@ -68,7 +66,7 @@
;; expander)))) ;; expander))))
;; expander)) ;; expander))
;; (define-macro (define-syntax form expander) ;; (define-macro (mes:define-syntax form expander)
;; (expander `(define-macro ((cadr form) form expander) ;; (expander `(define-macro ((cadr form) form expander)
;; (let ((transformer (caddr form))) ;; (let ((transformer (caddr form)))
;; (expander (transformer form ;; (expander (transformer form
@ -80,24 +78,12 @@
(newline) (newline)
(display "define-syntax syntax-rules...") (display "mes:define-syntax syntax-rules...")
(newline) (newline)
;; (define-macro (syntax-rules exp r c))
;; (define-syntax syntax-rules (mes:define-syntax syntax-rules
;; (let ()
;; (lambda (exp r c)
;; (display "hallo")
;; (display "newline"))))
;; (define-syntax syntax-rules
;; (lambda (exp r c)
;; (display "hallo")
;; (display "newline")))
(define-syntax syntax-rules
(let () (let ()
;;begin
(define name? symbol?) (define name? symbol?)
@ -113,6 +99,8 @@
(define indicators-for-zero-or-more (list (string->symbol "...") '---)) (define indicators-for-zero-or-more (list (string->symbol "...") '---))
(display "BOOO")
(lambda (exp r c) (lambda (exp r c)
(define %input (r '%input)) ;Gensym these, if you like. (define %input (r '%input)) ;Gensym these, if you like.
@ -128,7 +116,7 @@
`(lambda (,%input ,%rename ,%compare) `(lambda (,%input ,%rename ,%compare)
(let ((,%tail (cdr ,%input))) (let ((,%tail (cdr ,%input)))
(cond ,@(map process-rule rules) (cond ,@(map process-rule rules)
(else (#t ;;else
(syntax-error (syntax-error
"use of macro doesn't match definition" "use of macro doesn't match definition"
,%input)))))) ,%input))))))
@ -164,7 +152,7 @@
,@(process-match `(cdr ,%temp) (cdr pattern)))))) ,@(process-match `(cdr ,%temp) (cdr pattern))))))
((or (null? pattern) (boolean? pattern) (char? pattern)) ((or (null? pattern) (boolean? pattern) (char? pattern))
`((eq? ,input ',pattern))) `((eq? ,input ',pattern)))
(else (#t ;;else
`((equal? ,input ',pattern))))) `((equal? ,input ',pattern)))))
(define (process-segment-match input pattern) (define (process-segment-match input pattern)
@ -196,7 +184,8 @@
((pair? pattern) ((pair? pattern)
(append (process-pattern (car pattern) `(car ,path) mapit) (append (process-pattern (car pattern) `(car ,path) mapit)
(process-pattern (cdr pattern) `(cdr ,path) mapit))) (process-pattern (cdr pattern) `(cdr ,path) mapit)))
(else '()))) (#t ;;else
'())))
;; Generate code to compose the output expression according to template ;; Generate code to compose the output expression according to template
@ -228,9 +217,10 @@
((pair? template) ((pair? template)
`(cons ,(process-template (car template) rank env) `(cons ,(process-template (car template) rank env)
,(process-template (cdr template) rank env))) ,(process-template (cdr template) rank env)))
(else `(quote ,template)))) (#t ;;else
`(quote ,template))))
; Return an association list of (var . rank) ;; Return an association list of (var . rank)
(define (meta-variables pattern rank vars) (define (meta-variables pattern rank vars)
(cond ((name? pattern) (cond ((name? pattern)
@ -242,9 +232,10 @@
((pair? pattern) ((pair? pattern)
(meta-variables (car pattern) rank (meta-variables (car pattern) rank
(meta-variables (cdr pattern) rank vars))) (meta-variables (cdr pattern) rank vars)))
(else vars))) (#t ;;else
vars)))
; Return a list of meta-variables of given higher rank ;; Return a list of meta-variables of given higher rank
(define (free-meta-variables template rank env free) (define (free-meta-variables template rank env free)
(cond ((name? template) (cond ((name? template)
@ -263,9 +254,13 @@
rank env rank env
(free-meta-variables (cdr template) (free-meta-variables (cdr template)
rank env free))) rank env free)))
(else free))) (#t ;;else
free)))
;;c ;ignored c ;ignored
(display "HELLO")
(newline)
;; Kludge for Scheme48 linker. ;; Kludge for Scheme48 linker.
;; `(cons ,(make-transformer rules) ;; `(cons ,(make-transformer rules)
@ -274,28 +269,25 @@
(make-transformer rules)))) (make-transformer rules))))
;; (define-syntax or (mes:define-syntax mes:or
;; (syntax-rules () (syntax-rules ()
;; ((or) #f) ((mes:or) #f)
;; ((or e) e) ((mes:or e) e)
;; ((or e1 e ...) (let ((temp e1)) ((mes:or e1 e ...) (let ((temp e1))
;; (if temp temp (or e ...)))))) (if temp temp (or e ...))))))
;; (define-syntax xwhen (display "(mes:or #f (= 0 1) 'hello-syntax-world): ")
;; (syntax-rules () (display (mes:or #f (= 0 1) 'hello-syntax-world))
;; ((when condition exp ...) (display (mes:or #f '==>baaa))
;; (if condition (newline)
;; (begin exp ...)))))
;; (display "define-when: ") (mes:define-syntax mes:when
;; (display (syntax-rules ()
;; (define-syntax xwhen ((when condition exp ...)
;; (syntax-rules () (if condition
;; ((when condition exp ...) (begin exp ...)))))
;; (if condition
;; (begin exp ...)))))) (display (mes:when #t "when:hello syntax world"))
;; (newline)
;; (display (xwhen #t "hello syntax world"))
;; (define-macro (when cond exp . rest) ;; (define-macro (when cond exp . rest)
;; `(if ,cond ;; `(if ,cond
@ -305,6 +297,4 @@
;; (define-macro (when clause . rest) ;; (define-macro (when clause . rest)
;; (list 'cond (list clause (list 'let '() rest)))) ;; (list 'cond (list clause (list 'let '() rest))))
(newline) (newline)
'boo 'syntax-dun
EOF
'()