I'm trying to write let over lambda defmacro/g! in guile scheme. I have this:
(use-modules (srfi srfi-1))
(define (flatten x)
(let rec ((x x) (acc '()))
(cond ((null? x) acc)
((not (pair? x)) (cons x acc))
(else
(rec (car x)
(rec (cdr x) acc))))))
(define (g!-symbol? s)
(and (symbol? s)
(let ((symbol-string (symbol->string s)))
(and (> (string-length symbol-string) 2)
(equal? (string-downcase (substring symbol-string 0 2)) "g!")))))
(define-macro (define-macro/g! name-args . body)
(let ((syms (delete-duplicates
(filter g!-symbol? (flatten body)))))
`(define-macro ,name-args
(let ,(map
(lambda (s)
`(,s (gensym ,(substring (symbol->string s) 2))))
syms)
,#body))))
but when I try to macro expand define-macro/g! using this:
(use-modules (language tree-il))
(tree-il->scheme (macroexpand '(define-macro/g! (foo . body) `(let ((g!car ,(car body))) g!car))))
I've got this:
$15 = (if #f #f)
why I've got this result? How can I expand define-macro/g!?
I need to use this code:
(define macro '(define-macro/g! (foo . body) `(let ((g!car ,(car body))) g!car)))
(tree-il->scheme (macroexpand macro 'c '(compile load eval)))
Related
(define CHAR-CANVAS%
(class canvas%
(define/override (on-char evt)
(let ((c (send evt get-key-code)) (dc(send this get-dc)))
(send dc clear)
(print c)
(cond
((equal? c 'release)(void))
((member c '( #\a #\i #\u #\e #\o #\q #\é #\x))
(begin(set! tampon-key (cons c tampon-key)) (send dc draw-text (cadr (member (list->string (reverse tampon-key)) alphabet )) 30 30)
(send R-k-text insert (cadr (member (list->string (reverse tampon-key)) alphabet ))) (set! tampon-key '())))
((equal? c #\;)(begin(send R-k-text insert "。") (set! tampon-key '())))
((equal? c #\,)(begin(send R-k-text insert "、") (set! tampon-key '())))
((equal? c #\()(begin(send R-k-text insert "「") (set! tampon-key '())))
((equal? c #\))(begin(send R-k-text insert " 」") (set! tampon-key '())))
((equal? c #\&)(begin(send R-k-text insert "々") (set! tampon-key '())))
((not(member c '(#\b #\c #\d #\f #\g #\j #\k #\m #\n #\p #\r #\i #\h #\t #\s #\w #\y #\a #\e #\o #\z #\u)))(void))
((begin (set! tampon-key (cons c tampon-key))(print tampon-key))))
))
(super-new)))
It works very well (it is for writing in hiragana katakana and other characters)
I want to add to this same canvas
a feature which tells me the position of the cursor on a text
is it possible? if yes
what is the code to add?
(define/override (on-char evt)......
Or do I need a another canvas?
in this case what will be my code?
(define/override (on-char evt)......
this in order to do something similar to a "RIKAICHAN"
(define (transform-syll->mot L-romanji L-hiragana)
(let ((a '())(b'()))
(set! a (map list->string (reverse L-romanji)))
(set! b (map char->string (string->list "たべます")))
(list a b)))
(define (foo-w1 tw) ;transforme syllabe en fichier wav (if exist)
(let ((l '()))
(while (not (null? tw))
(set! l(cons (string-append (car tw )".wav")l))
(set! tw (cdr tw)))
(reverse l)))
(define (transform-mot->son L-romanji L-hiragana)
(let* ((x (transform-syll->mot L-romanji L-hiragana))
(a (car x)))
(current-directory "/Users/izuko/Desktop/japonais-new/jap-syll")
(rs-append* (map rs-read (foo-w1 a)))))
(define syllabe-R '())
(define syllabe-H '())
(define clip "")
(define Bt-dir
(new button%
(parent GP-1 )
(label "Direct")
(callback (lambda (obj evt)
(begin (set! alphabet hiragana)
(set! lecture-feld (send R-k-tex-rech get-text))
(set! LECT-HI* (cons lecture-feld LECT-HI*))
(set! LECT-ID* (cons lecture-feld LECT-ID*))
(send R-k-text insert lecture-feld)
(set! syllabe-R (transform-syll->mot tampon-wort lecture-feld))
(set! clip (transform-mot->son tampon-wort lecture-feld))
(play clip))))))
I have problem with macros in my lisp interpreter writtein in JavaScript. the problem is in this code:
(define log (. console "log"))
(define (alist->object alist)
"(alist->object alist)
Function convert alist pairs to JavaScript object."
(if (pair? alist)
((. alist "toObject"))))
(define (klist->alist klist)
"(klist->alist klist)
Function convert klist in form (:foo 10 :bar 20) into alist
in form ((foo . 10) (bar . 20))."
(let iter ((klist klist) (result '()))
(if (null? klist)
result
(if (and (pair? klist) (pair? (cdr klist)) (key? (car klist)))
(begin
(log ":::" (cadr klist))
(log "data" (. (cadr klist) "data"))
(iter (cddr klist) (cons (cons (key->string (car klist)) (cadr klist)) result)))))))
(define (make-empty-object)
(alist->object '()))
(define empty-object (make-empty-object))
(define klist->object (pipe klist->alist alist->object))
;; main function that give problems
(define (make-tags expr)
(log "make-tags" expr)
`(h ,(key->string (car expr))
,(klist->object (cadr expr))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
(define-macro (with-tags expr)
(make-tags expr))
I call this macro using this code:
(define (view state actions)
(with-tags (:div ()
(list (:h1 () (value (cdr (assoc 'count (. state "counter")))))
(:button (:onclick (lambda () (--> actions (down 1)))) "-")
(:button (:onclick (lambda () (--> actions (up 1)))) "+")))))
which should expand to almost the same code:
(define (view state actions)
(h "div" (make-empty-object)
(list->array (list
(h "h1" (make-empty-object) (value (cdr (assoc 'count (. state "counter")))))
(h "button" (klist->object `(:onclick ,(lambda () (--> actions (down 1))))) "-")
(h "button" (klist->object `(:onclick ,(lambda () (--> actions (up 1))))) "+")))))
This function works. I have problem with expanded code using my macro that call the main function, don't know how LIPS should behave when it find:
(:onclick (lambda () (--> actions (down 1))))
inside code and you try to process it like this:
,(klist->object (cadr expr))
Right now my lisp works that lambda is marked as data (have data flag set to true this is a hack to prevent of recursive evaluation of some code from macros) and klist->object function get lambda code as list, instead of function.
How this should work in Scheme or Common Lisp? Should klist->object get function object (lambda get evaluated) or list structure with lambda as first symbol? If second then how I sould write my function and macro to evaluate lambda should I use eval (kind of hack to me).
Sorry don't know how to test this, with more bug free LISP.
EDIT:
I've tried to apply the hint from #jkiiski in guile (because in my lisp it was not working)
;; -*- sheme -*-
(define nil '())
(define (key? symbol)
"(key? symbol)
Function check if symbol is key symbol, have colon as first character."
(and (symbol? symbol) (eq? ":" (substring (symbol->string symbol) 0 1))))
(define (key->string symbol)
"(key->string symbol)
If symbol is key it convert that to string - remove colon."
(if (key? symbol)
(substring (symbol->string symbol) 1)))
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
(define (klist->alist klist)
"(klist->alist klist)
Function convert klist in form (:foo 10 :bar 20) into alist
in form ((foo . 10) (bar . 20))."
(pair-map (lambda (first second)
(if (key? first)
(cons (key->string first) second))) klist))
(define (h props . rest)
(display props)
(display rest)
(cons (cons 'props props) (cons (cons 'rest rest) nil)))
(define (make-tags expr)
`(h ,(key->string (car expr))
(klist->alist (list ,#(cadr expr)))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
(define-macro (with-tags expr)
(make-tags expr))
(define state '((count . 10)))
(define xxx (with-tags (:div ()
(list (:h1 () (cdr (assoc 'count state)))
(:button (:onclick (lambda () (display "down"))) "-")
(:button (:onclick (lambda () (display "up"))) "+")))))
but got error:
ERROR: Unbound variable: :onclick
I've found solution for my lisp, Here is code:
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
(define (make-tags expr)
(log "make-tags" expr)
`(h ,(key->string (car expr))
(alist->object (quasiquote
;; create alist with unquote for values and keys as strings
,#(pair-map (lambda (car cdr)
(cons (cons (key->string car) (list 'unquote cdr))))
(cadr expr))))
,(if (not (null? (cddr expr)))
(if (and (pair? (caddr expr)) (let ((s (caaddr expr))) (and (symbol? s) (eq? s 'list))))
`(list->array (list ,#(map make-tags (cdaddr expr))))
(caddr expr)))))
So in my code I'm writing some kind of meta macro I'm writing quasiquote as list that will get evaluated the same as if I use in my original code:
(klist->object `(:onclick ,(lambda () (--> actions (down 1)))))
I'm using alist->object and new function pair-map, so I can unquote the value and convert key symbol to string.
is this how it should be implemented in scheme? not sure If I need to fix my lisp or macros are working correctly there.
The problem with flet is that the functions bound therein must be defined inline. In other words, there's no way to do this:
(new-flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (function-generator)))
(a #'b 10))
I considered defining such a macro myself, but the problem is that flet seems to be the only way to set local function values. symbol-function always gets the global definition only, and function can't be used with setf. Anyone have an idea how this can be done fairly cleanly, if at all?
You can easily build a trampoline
(defun function-generator (x)
(lambda (y) (* x y)))
(let ((fg (function-generator 42)))
(flet ((a (f x) (funcall f (* x 2)))
(b (x) (funcall fg x)))
(a #'b 10)))
A macro implementation of new-flet with this approach is
(defmacro new-flet (bindings &body body)
(let ((let-bindings (list))
(flet-bindings (list))
(args (gensym)))
(dolist (binding bindings)
(let ((name (gensym)))
(push `(,name ,(second binding))
let-bindings)
(push `(,(first binding) (&rest ,args)
(apply ,name ,args))
flet-bindings)))
`(let ,(nreverse let-bindings)
(flet ,(nreverse flet-bindings)
,#body))))
that expands in your example case as
(macroexpand-1 '(new-flet ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(a #'b 10)))
==> (LET ((#:G605 (LAMBDA (F X)
(FUNCALL F (* X 2))))
(#:G606 (FUNCTION-GENERATOR)))
(FLET ((A (&REST #:G604)
(APPLY #:G605 #:G604))
(B (&REST #:G604)
(APPLY #:G606 #:G604)))
(A #'B 10)))
Is
(let* ((a (lambda (f x) (funcall f (* x 2))))
(b (function-generator)))
(funcall a b 10))
a fairly clean solution to your problem?
How about binding the variables with let, so that they're setfable, and then using an flet as the body of the let so that they're funcallable and (function …)-able, too. E.g., where I've given a silly little function instead of (generate-function):
(let ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(flet ((a (&rest args)
(apply a args))
(b (&rest args)
(apply b args)))
(a #'b 10)))
We can wrap this up in a macro relatively easily:
(defmacro let/flet (bindings &body body)
(let ((args (gensym (string '#:args-))))
`(let ,bindings
(flet ,(loop :for (name nil) :in bindings
:collect `(,name (&rest ,args) (apply ,name ,args)))
,#body))))
Now
(let/flet ((a (lambda (f x)
(funcall f (* x 2))))
(b (lambda (&rest args)
(print (list* 'print-from-b args)))))
(a #'b 10))
expands into the first block of code. Note that you can also use (a b 10) in the body as well, since the binding of b is the same as the value of #'b. You can use setf on the variable as well:
(let/flet ((a (lambda (x)
(print (list 'from-a x)))))
(a 23)
(setf a (lambda (x)
(print (list 'from-new-a x x))))
(a 23))
prints
(FROM-A 23)
(FROM-NEW-A 23 23)
If anyone's interested in a labels equivalent, here it is:
(defmacro my-labels ((&rest definitions) &rest body)
(let ((gensyms (loop for d in definitions collect (gensym)))
(names (loop for d in definitions collect (car d)))
(fdefs (loop for f in definitions collect (cadr f)))
(args (gensym)))
`(let (,#(loop for g in gensyms collect (list g)))
(labels (,#(loop for g in gensyms for n in names
collect `(,n (&rest ,args) (apply ,g ,args))))
,#(loop for g in gensyms for f in fdefs
collect `(setf ,g ,f))
,#body))))
This is sort of like Scheme's letrec.
I'm wondering how to implement mutable versions of cadr, caddr, and the likes in Racket without defining each one separately? ie. not
(define (mcadr exp)
(mcar (mcdr exp)))
It seems that for mutable lists or pairs, Racket only supports mcar and mcdr but not the "expanded" versions. Do I need to know and be good at macros to be able to do this?
Here's a macro solution:
#lang racket/base
(require racket/mpair (for-syntax racket/base))
(define-syntax (define-combinations stx)
(syntax-case stx ()
[(_ n) (integer? (syntax-e #'n))
(let ([n (syntax-e #'n)])
(define options (list (cons "a" #'mcar) (cons "d" #'mcdr)))
(define (add-options r)
(apply append
(map (λ (opt)
(map (λ (l) (cons (string-append (car opt) (car l))
(list (cdr opt) (cdr l))))
r))
options)))
(define combinations
(cdddr
(let loop ([n n] [r '(("" . x))])
(if (zero? n) r (append r (loop (sub1 n) (add-options r)))))))
(define (make-name combo)
(let ([s (string->symbol (string-append "mc" (car combo) "r"))])
(datum->syntax stx s stx)))
(with-syntax ([(body ...) (map cdr combinations)]
[(name ...) (map make-name combinations)])
#'(begin (define (name x) body) ...)))]))
(define-combinations 4)
(mcaddr (mlist 1 2 3 4 5))
You could do:
(define mcaar (compose mcar mcar))
(define mcadr (compose mcar mcdr))
;; ...
(define mcddddr (compose mcdr mcdr mcdr mcdr))
But there is no real getting around the repetition. Even in the Racket source (look in racket/src/list.c), the repetition is there, albeit prettified a little with C macros.
Given the following definition of the LISP eval function - what is required to add the defmacro function? (Or even just evaluate a macro)
(defun null. (x)
(eq x '()))
(defun and. (x y)
(cond (x (cond (y 't) ('t '())))
('t '())))
(defun not. (x)
(cond (x '())
('t 't)))
(defun append. (x y)
(cond ((null. x) y)
('t (cons (car x) (append. (cdr x) y)))))
(defun list. (x y)
(cons x (cons y '())))
(defun pair. (x y)
(cond ((and. (null. x) (null. y)) '())
((and. (not. (atom x)) (not. (atom y)))
(cons (list. (car x) (car y))
(pair. (cdr x) (cdr y))))))
(defun assoc. (x y)
(cond ((eq (caar y) x) (cadar y))
('t (assoc. x (cdr y)))))
(defun eval. (e a)
(cond
((atom e) (assoc. e a))
((atom (car e))
(cond
((eq (car e) 'quote) (cadr e))
((eq (car e) 'atom) (atom (eval. (cadr e) a)))
((eq (car e) 'eq) (eq (eval. (cadr e) a)
(eval. (caddr e) a)))
((eq (car e) 'car) (car (eval. (cadr e) a)))
((eq (car e) 'cdr) (cdr (eval. (cadr e) a)))
((eq (car e) 'cons) (cons (eval. (cadr e) a)
(eval. (caddr e) a)))
((eq (car e) 'cond) (evcon. (cdr e) a))
('t (eval. (cons (assoc. (car e) a)
(cdr e))
a))))
((eq (caar e) 'label)
(eval. (cons (caddar e) (cdr e))
(cons (list. (cadar e) (car e)) a)))
((eq (caar e) 'lambda)
(eval. (caddar e)
(append. (pair. (cadar e) (evlis. (cdr e) a))
a)))))
(defun evcon. (c a)
(cond ((eval. (caar c) a)
(eval. (cadar c) a))
('t (evcon. (cdr c) a))))
(defun evlis. (m a)
(cond ((null. m) '())
('t (cons (eval. (car m) a)
(evlis. (cdr m) a)))))
(eval '(car '(a a)) )
The representation of an anonymous macro is by convention a list of the form (macro lambda ...). Try evaling these in your favorite Lisp interpreter (tested in Emacs):
> (defmacro triple (x) `(+ ,x ,x ,x))
triple
> (symbol-function 'triple)
(macro lambda (x) (\` (+ (\, x) (\, x) (\, x))))
Although things don't work that way in Emacs, the only thing left to do is to give the adequate semantics to such a form. That is, when eval. sees ((macro lambda (x) EXPR) FORM), it must
Replace every occurence of x in FORM with EXPR without evaluating EXPR first (as opposed to what happens in a function call);
eval. the result of above.
You can achieve this by adding a clause to the outermost cond in eval. that deals with the ((macro lambda ...) ...) case. Here is a crude prototype:
((eq (caar e) 'macro)
(cond
((eq (cadar e) 'lambda)
(eval. (eval. (car (cdddar e))
(cons (list. (car (caddar e)) (cadr e)) a))
a))))
This code only works for single-argument macros. Fixing that involves writing an auxiliary function substlis. that works like evlis. but without looping to eval.; that is left as an exercise to the reader :-)
To test, define cadr. as a macro thusly:
(defmacro cadr. (x)
(list. 'car (list. 'cdr x)))
After this you would have
> (symbol-function 'cadr.)
(macro lambda (x) (list. (quote car) (list. (quote cdr) x)))
You can construct a form that applies this (macro lambda ...) to an expression, and eval that construction within a context that contains a definition for list. (because it is not considered primitive by the eval. interpreter). For instance,
(let ((e '((macro lambda (x) (list (quote car) (list (quote cdr) x)))
(cons (quote x) (cons (quote y) nil))))
(bindings `((list ,(symbol-function 'list.)))))
(eval. e bindings))
y
Tada!
This is also quite good:
https://web.archive.org/web/20120702032624/http://jlongster.com/2012/02/18/its-not-about-macros-its-about-read.html
"You can implement a macro system in 30 lines of Lisp. All you need is read, and it's easy."
https://gist.github.com/1712455