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.
Related
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.
Say I have a macro like this:
(define-syntax (choose stx)
(define data (syntax->datum stx))
(define args (cadr data))
(define body (cddr data))
(define output
`(apply (case (car ,args)
,(map (lambda (choice)
`((,(car choice)) ,(cadr choice)))
body)
(else (displayln "error")))
(cdr ,args)))
(println output)
#'(void))
If I use this on something like this (there could be more options):
(choose args
("run" runsomething)
("del" delsomethingelse))
It transforms it to
(apply
(case (car args)
((("run") runsomething)
(("del") delsomethingelse))
(else (displayln "error")))
(cdr args))
Which is not valid code, because the map gave it extra parentheses. Instead I want it to give me this:
(apply
(case (car args)
(("run") runsomething)
(("del") delsomethingelse)
(else (displayln "error")))
(cdr args))
How could I do something like this?
Use unquote-splicing (aka ,#) to get rid of the list surrounding map.
Example:
(define xs '(a b c))
`(1 2 ,xs 3 4) ; => '(1 2 (a b c) 3 4)
`(1 2 ,#xs 3 4) ; => '(1 2 a b c 3 4)
However I notice that you use syntax->datum on the input stx
of the syntax transformer. That removes lexical information, which
could end up causing problems. It recommend using either syntax-case
or syntax-parse, which use pattern matching to pick out the elements
of the input syntax and templates to generate the output.
(define-syntax (choose stx)
(syntax-case stx ()
[(_choose args
(datum fun-expr)
...)
#'(apply (case (car args)
[(datum) fun-expr]
...)
(cdr args))]))
(define (run-it . xs) (list 'ran-it xs))
(define (del-it . xs) (list 'delt-it xs))
(choose (list "run" 1 2 3)
("run" run-it)
("del" del-it))
Output: '(ran-it (1 2 3))
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)))
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.
since yesterday I've been trying to program a special case statement for scheme that would do the following:
(define (sort x)
(cond ((and (list? x) x) => (lambda (l)
(sort-list l)))
((and (pair? x) x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
instead of using all the and's and cond's statement, I would have:
(define (sort x)
(scase ((list? x) => (lambda (l)
(sort-list l)))
((pair? x) => (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else "here")))
What I could do so far, was this:
(define (sort x)
(scase (list? x) (lambda (l)
(sort-list l)))
(scase (pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p))))
with this code:
(define-syntax scase
(syntax-rules ()
((if condition body ...)
(if condition
(begin
body ...)))))
What I wanted to do now, is just allow the scase statement to have multiple arguments like this:
(scase ((list? (cons 2 1)) 'here)
((list? '(2 1)) 'working))
but I can't seem to figure out how I can do that. Maybe you guys could give me a little help?
Thanks in advance ;)
If this is an exercise in learning how to use syntax-rules, then disregard this answer.
I see a way to simplify your code that you are starting with.
(define (sort x)
(cond ((list? x)
(sort-list x))
((pair? x)
(if (> (car x) (cdr x))
(cons (cdr x) (car x))
x)))
(else "here")))
Since all the (and (list? x) x) => (lambda l ... does is see if x is a list, and then bind l to x, (since #f is not a list, and '() is not false, at least in Racket), you can just skip all that and just use x. You do not need to use => in case, and in this case it doesn't help. => is useful if you want to do an test that returns something useful if successful, or #f otherwise.
Now, if you want to use a macro, then you're going to need to clarify what you want it to do a bit better. I think that case already does what you want. Your existing macro is just if, so I'm not sure how to extend it.
I found the solution for my question, here it goes:
(define-syntax cases
(syntax-rules ()
((_ (e0 e1 e2 ...)) (if e0 (begin e1 e2 ...)))
((_ (e0 e1 e2 ...) c1 c2 ...)
(if e0 (begin e1 e2 ...) (cases c1 c2 ...)))))
Thank you all anyway :)
Here's a solution :
#lang racket
(require mzlib/defmacro)
(define-syntax scase
(syntax-rules (else)
((_ (else body1)) body1)
((_ (condition1 body1) (condition2 body2) ...)
(if condition1
body1
(scase (condition2 body2) ...)))))
(define (sort1 x)
((scase ((list? x) (lambda (l)
(sort l <)))
((pair? x) (lambda (p)
(if (> (car p) (cdr p))
(cons (cdr p) (car p))
p)))
(else (lambda (e) "here")))
x))
It works in DrRacket. I made three changes to your solution. First, i renamed your sort procedure to sort1 since sort is inbuilt in scheme ( I have used it inside sort1). Second, I have changed the sort1 itself so that the input given will be passed to the procedure returned by scase and you will directly get the sorted result. Third, I have modified the scase syntax extension, so that it will accept the else condition.
>(sort1 (list 3 1 2))
'(1 2 3)
> (sort1 (cons 2 1))
'(1 . 2)
> (sort1 'here)
"here"
I suggest you read "The Scheme Programming Language" by Kent Dybvig. There is an entire chapter on syntactic extensions.