> 1 <

Автор Сообщение

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3865   2011-01-19 20:07 GMT+3 часа(ов)      
Добрый день!

Для реализации компилятора схемы на схеме потребовалось использовать first-class макросы (даже не знал что их нет в стандарте до этого - я больше на лисп до этого ориенторовался). Спросил на канале #scheme - но там почему-то не захотели отвечать.

Пожалуйста помогите - потому что без таких макросов код вырастет многократно. Очень нужна работающая реализация (и без всего лишнего ) таких макросов:

(macro FORMAL . BODY ) ==> MACRO - не вычисляются аргументы, а сначала сам макрос, и возвращается результат таких вычислений при каждом вызове

(macro? OBJECT) ==> BOOLEAN - создается обьект

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3866   2011-01-19 23:15 GMT+3 часа(ов)      
> (macro FORMAL . BODY )
Некорректная запись!

Читали статью "First-class (run-time) macros and meta-circular evaluation"?

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3867   2011-01-19 23:48 GMT+3 часа(ов)      
Да, записал я не совсем правильно, но смысл того что мне нужно понятен.
Да, статью видел - но не совсем понял почему там столько кода - неужели нельзя это реализовать проще?

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3868   2011-01-20 00:41 GMT+3 часа(ов)      
> Да, статью видел - но не совсем понял почему там столько кода - неужели нельзя это реализовать проще?
Сама идеология схемы не позволяет использовать first-class макросы, да это и ненужно! Как именно Вы собираетесь реализовывать компилятор? Компиляция в замыкания? Может все окажется гораздо проще, чем Вы себе напридумывали)

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3869   2011-01-20 00:55 GMT+3 часа(ов)      
да, именно компиляция в замыкания.

Вот, и Вы о том же! Почему лиспу можно такие макросы - а схеме нет?

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3870   2011-01-20 01:19 GMT+3 часа(ов)      
> Почему лиспу можно такие макросы - а схеме нет?
А какой из диалектов лиспа имеет полноценные first-class макросы?

В схеме можно выделить три стадии интерпретации:
1) Макротрансформация всего кода (всех S-выражений).
У Рэкета, например, это многофазный процесс.
2) Компиляция.
3) Вычисление.

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3871   2011-01-20 01:34 GMT+3 часа(ов)      
Полноценные first-class макросы довольно неуклюжая вещь. Во-первых, т.к. они не привязаны к определенному контексту, во-вторых они приводят к появлению неожиданных побочных эффектов (еще более неожиданных, нежели макросы лиспа).

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3873   2011-01-20 01:54 GMT+3 часа(ов)      
Хм. но без них код будет значительно больше...
misha
Может все окажется гораздо проще, чем Вы себе напридумывали)

А какая есть альтернатива? Кроме конечно "гигиенических" макросов?

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3874   2011-01-20 17:53 GMT+3 часа(ов)      
> Хм. но без них код будет значительно больше...
Вы будете s-выражения парсить, поэтому Вам не потребуется много макросов. Или Вы думаете, что настрогали макросов и готово?)

> А какая есть альтернатива? Кроме конечно "гигиенических" макросов?
Есть еще "грязные" макросы) но они присутствуют только у Рэкета.

отредактировал(а) misha: 2011-01-20 18:18 GMT+3 часа(ов)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3875   2011-01-20 17:58 GMT+3 часа(ов)      
Динамическая надстройка на Рэкете.
#lang racket
 
(require racket/splicing)
 
(struct macros (closure))
 
(define-for-syntax (mcrsymb->defsymb symb)
(string->symbol (car (regexp-match #rx"[^@].+[^@]"
(symbol->string symb)))))
 
(define-for-syntax (rplc lst)
(map (lambda (a)
(if (and (pair? a)
(not (memq (car a)
'(quote quasiquote unquote
unquote-splicing syntax
quasisyntax unsyntax
unsyntax-splicing))))
(cond
[(eq? (car a) 'macro-apply)
`(unsyntax ,(cdr a))]
[(and (symbol? (car a))
(regexp-match? #rx"@.+@" (symbol->string (car a))))
`#,(apply (macros-closure ,(mcrsymb->defsymb (car a)))
',(cdr a))]
[else (rplc a)])
a))
lst))
 
(define-syntax (dynamic-context so)
(syntax-case so ()
[(_ expr ...)
(with-syntax ([exprs
(datum->syntax
so
(map (lambda (e)
`(eval-syntax #',e))
(rplc (syntax->datum #'(expr ...)))))]
[anchor (datum->syntax so (gensym))])
#'(begin
(define-namespace-anchor anchor)
(parameterize ([current-namespace
(namespace-anchor->namespace anchor)])
. exprs)))]))
 
(define-syntax (defun so)
(syntax-case so ()
[(_ id formals body ...)
#'(eval-syntax #`(define (id . formals)
body ...))]))
 
(define-syntax (defmacro so)
(syntax-case so ()
[(_ id formals body ...)
#'(eval-syntax #`(define id
(macros (lambda formals
body ...))))]))
 
(define-syntax (setq so)
(syntax-case so ()
[(_ id exp)
#'(eval-syntax #`(define id exp))]))
 
(define-syntax (incf so)
(syntax-case so ()
[(_ id) #'(begin (set! id (add1 id)) id)]))
 
;; Test
(dynamic-context
 
(define x 56)
(define (m) (incf x))
(defun x=57 () (macro-apply (lambda () (incf x))))
(defun x=58 () (macro-apply m))
 
(defmacro sum (a b)
(printf "sum(~a,~a)\n" a b)
`(+ ,a ,b))
 
(setq val (@sum@ x 1))
 
(defmacro inc-x () (incf x))
(defun x=59 () (@inc-x@))
 
(splicing-let
([i 0])
(defun ++i ()
(printf "i = ~a\n" i)
(incf i))
(defun $i () i)
(defun i=1 () (macro-apply ++i))
(defun i=2 () (macro-apply ++i)))
; top-level
(defun i=3 () (macro-apply ++i))
 
)
 

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3876   2011-01-20 18:13 GMT+3 часа(ов)      
Т.к. я не реализовал macro-environment, поэтому для идентификации first-class макроса в подходящем контексте (внутри defun, defmacro, setq) необходимо его имя заключить между двух @, т.е. @имя@.

defmacro - определяет first-class макрос.

macro-apply - позволяет использовать процедуру, как макрос (внутри defun, defmacro, setq).

macros? - можно использовать как предикат для идентификации first-class макросов.
Например,
> (macros? inc-x)
#t

отредактировал(а) misha: 2011-01-20 18:23 GMT+3 часа(ов)

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3878   2011-01-20 22:03 GMT+3 часа(ов)      
Огромное спасибо! Все коротко и очень наглядно

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3880   2011-01-22 01:37 GMT+3 часа(ов)      
Так как предыдущая надстройка не совсем адекватна), поэтому я создал эту:
#lang racket
 
(require (for-meta 1 racket/local))
 
(struct macros (closure))
 
(define-for-syntax *DEBUG* #t)
 
(define-for-syntax (debug-write-lines header lines)
(when *DEBUG*
(for-each (lambda (e)
(when header
(display header))
(write e)
(newline))
lines)))
 
(define-for-syntax (s-parser s-exp)
(local
[(define (mcrsymb->defsymb symb)
(string->symbol (car (regexp-match #rx"[^@].+[^@]"
(symbol->string symb)))))
 
(define (list-ok? list)
(and (pair? list)
(list? list)
(not (memq (car list)
'(quote quasiquote unquote
unquote-splicing syntax
quasisyntax unsyntax
unsyntax-splicing)))))
(define (s-parser0 s-exp)
(if (list-ok? s-exp)
(map (lambda (s-exp)
(if (list-ok? s-exp)
(cond
[(eq? (car s-exp) 'macro-apply)
`(eval ,(s-parser (cdr s-exp)))]
[(and (symbol? (car s-exp))
(regexp-match? #rx"@.+@"
(symbol->string
(car s-exp))))
`(eval '((macros-closure
,(mcrsymb->defsymb (car s-exp)))
,@(s-parser0 (cdr s-exp))))]
[else (s-parser s-exp)])
`',s-exp ))
s-exp)
`',s-exp))]
(if (list-ok? s-exp)
(cond
[(eq? (car s-exp) 'macro-apply)
`(eval ,(s-parser (cdr s-exp)))]
[(and (symbol? (car s-exp))
(regexp-match? #rx"@.+@" (symbol->string (car s-exp))))
`(eval '((macros-closure ,(mcrsymb->defsymb (car s-exp)))
,@(s-parser0 (cdr s-exp))))]
[else
(cons 'list (s-parser0 s-exp))])
`',s-exp)))
 
(define-syntax (dynamic-context so)
(syntax-case so ()
[(_ expr ...)
(with-syntax ([exprs
(datum->syntax
so
(let ([l (map (lambda (e)
`(eval ,(s-parser e)))
(syntax->datum #'(expr ...)))])
(debug-write-lines "dynamic-context: " l)
l))]
[anchor (datum->syntax so (gensym))])
#'(begin
(define-namespace-anchor anchor)
(parameterize ([current-namespace
(namespace-anchor->namespace anchor)])
. exprs)))]))
 
(define-syntax (incf so)
(syntax-case so ()
[(_ id) #'(begin (set! id (add1 id)) id)]))
 
(dynamic-context
 
(define defmacro
(macros (lambda (name formals expr . body)
`(define ,name (macros
(lambda ,formals
,expr . ,body))))))
 
(define x 56)
(define (m) (incf x))
(define (x=57) (macro-apply (lambda () (incf x))))
 
(@defmacro@ macro-apply (f . args)
(eval `(,f ,@args)))
 
(define (x=58) (@macro-apply@ m))
 
(define sum
(macros (lambda (a b)
(printf "sum(~a,~a)\n" a b)
`(+ ,a ,b))))
 
(define val=59 (@sum@ x 1))
 
(@defmacro@ sum2 (a b)
(printf "sum2(~a,~a)\n" a b)
`(+ ,a ,b))
 
(define val=60 (@sum2@ x 2))
 
(@defmacro@ defun (name formals expr . body)
`(define (,name . ,formals)
,expr . ,body))
 
(@defmacro@ let (variables exp . body)
`((lambda ,(map car variables)
,exp . ,body)
,@(map cadr variables)))
 
(@let@ ([i 2][n 5])
(printf "i+n = ~a\n" (+ i n)))
 
(@let@ ([i 0])
(@defun@ ++i ()
(printf "i = ~a\n" i)
(incf i))
(++i))
 
)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3882   2011-01-24 21:24 GMT+3 часа(ов)      
Почти завершённый вариант динамической надстройки:
#lang racket
 
(struct macros (closure))
 
(define-syntax (and/exc stx)
(syntax-case stx ()
[(_ expr ...)
#'(with-handlers ([void (lambda (e) #f)])
(and expr ...))]))
 
(define-syntax (incf stx)
(syntax-case stx ()
[(_ id) #'(begin (set! id (add1 id)) id)]))
 
(define-syntax (dynamic-context stx)
(syntax-case stx ()
[(_ expr ...)
(with-syntax ([exprs
(datum->syntax
stx
(map (lambda (e)
`(dynamic-eval ',e))
(syntax->datum #'(expr ...))))]
[anchor (datum->syntax stx (gensym))])
#'(begin
(define-namespace-anchor anchor)
(parameterize ([current-namespace
(namespace-anchor->namespace anchor)])
. exprs)))]))
 
(define (dynamic-eval s-exp)
(eval (eval (dynamic-trans s-exp))))
 
(define (*list-ok?* list)
(and (pair? list)
(list? list)
(not (memq (car list)
'(quote quasiquote unquote
unquote-splicing syntax
quasisyntax unsyntax
unsyntax-splicing)))))
 
(define (dynamic-trans s-exp)
(cond
[(not (*list-ok?* s-exp))
`',s-exp]
[(and/exc (macros? (eval (car s-exp))))
`((macros-closure ,(car s-exp))
,@(map dynamic-trans (cdr s-exp)))]
[else
(cons 'list (map dynamic-trans s-exp))]))
 
(dynamic-context
 
(require racket/splicing)
 
(define defmacro
(macros (lambda (name formals expr . body)
`(define ,name (macros
(lambda ,formals
,expr . ,body))))))
 
(defmacro macro-apply (f . args)
(eval (cons f args)))
 
(define x 56)
(define (m) (incf x))
 
(define x=57 (macro-apply (lambda () (incf x))))
 
(define (x=58) (macro-apply m))
 
(define sum
(macros (lambda (a b)
(printf "sum(~a,~a)\n" a b)
`(+ ,a ,b))))
 
(define val=59 (sum x 1))
 
(defmacro sum2 (a b)
(printf "sum2(~a,~a)\n" a b)
`(+ ,a ,b))
 
(define val=60 (sum2 x 2))
 
(defmacro defun (name formals expr . body)
`(define (,name . ,formals)
,expr . ,body))
 
(let ([i 2][n 5])
(printf "i+n = ~a\n" (+ i n)))
 
(splicing-let ([i 0])
(defun ++i ()
(printf "i = ~a\n" i)
(incf i))
(++i))
 
(defmacro my-let (variables exp . body)
`((lambda ,(map car variables)
,exp . ,body)
,@(map cadr variables)))
 
(my-let ([x 1][y 2])
(printf "x+y = ~a\n" (+ x y)))
 
(macros? defun)
 
)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3883   2011-01-24 21:40 GMT+3 часа(ов)      
Поначалу мне казалось, что так не получится, но как оказалось, макросистема Рэкета гораздо более мощная)
Вы, наверное, уже догадались, что внутри dynamic-context first-class макросы живут своей полноценной жизнью!)

XVilka

Members


Статус

10 сообщений
http://www.droid-developers.org
Где: Russia Moscow
Род занятий:
Возраст: 32

#3895   2011-02-02 02:38 GMT+3 часа(ов)      
Огромное спасибо! Такой вариант и короток, но намного мощнее первоначального!

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3900   2011-02-02 18:45 GMT+3 часа(ов)      
Новый defmacro:
(define (dynamic-eval-0 s-exp)
(eval (dynamic-trans s-exp)))
 
(dynamic-context
 
(define defmacro
(macros
(lambda (name formals expr . body)
`(define ,name
(macros
(lambda ,formals
(dynamic-eval-0
(begin ,expr . ,body))))))))
 
)

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3908   2011-02-06 01:18 GMT+3 часа(ов)      
Классический defun:
#lang dynamic-racket
 
(let ([i 10])
(defun get-i() i))
 
> (get-i)
10

misha

Moderators


Статус

1275 сообщений
http://racket-lang.org/
Где: Yemen
Род занятий:
Возраст:

#3909   2011-02-06 01:33 GMT+3 часа(ов)      
Напоминаю, dynamic-racket - это язык созданный на основе моей динамической надстройки.
dynamic-racket состоит из dynamic-racket/base + dynamic-racket/common(библиотека).
> 1 <


Онлайн :

0 пользователь(ей), 23 гость(ей) :




Реклама на сайте: