Post your dirty little macros.
(define-macro (reverse-args function . args)
`(,function ,@(reverse args)))
(define-macro (thunk body0 . body) `(λ () ,body0 ,@body))
(define-macro (maximize! place number)
`(set! ,place (max ,place ,number)))
(define-macro (minimize! place number)
`(set! ,place (min ,place ,number)))
(define-macro (withret . body)
`((λ () (call/cc (λ (return) ,@body)))))
here are some more from my common-lisp.scm
;prog1
(define-syntax begin0
(syntax-rules ()
((begin0 expr0 expr+ ...)
(call-with-values (λ () expr0)
(lambda return
(begin expr+ ... (apply values return)))))))
(define-macro (setf! . assignments)
`(begin ,@(map (λ (a) (cons 'set! a)) assignments)))
(define-macro (push! x place)
`(set! ,place (cons ,x ,place)))
(define-macro (pop! place)
`(begin0 (car ,place) (set! ,place (cdr ,place))))
(define-syntax incf!
(syntax-rules ()
((incf! place) (incf! place 1))
((incf! place n)
(set! place (+ place n)))))
(define-syntax decf!
(syntax-rules ()
((decf! place) (decf! place 1))
((decf! place n) (incf! place (- n)))))
(define-syntax dolist
(syntax-rules ()
((dolist (var list) body body+ ...)
(dolist (var list (values)) body body+ ...))
((dolist (var list value) body body+ ...)
(begin (for-each (λ (var) body body+ ...) list) value))))
(define-syntax dotimes
(syntax-rules ()
((dotimes (variable n) body body+ ...)
(dotimes (variable n (values)) body body+ ...))
((dotimes (variable n value) body body+ ...)
(do ((variable 0 (1+ variable)))
((= variable n) value)
body body+ ...))))Sometimes you need dirty unhygienic macros but your scheme doesn't provide them
(define-syntax define-macro
(syntax-rules ()
((define-macro (name . args) body ...)
(define-syntax name
(rsc-macro-transformer
(let ((transformer (lambda args body ...)))
(lambda (exp env)
(apply transformer (cdr exp)))))))))also, what's a better name for the withret macro
almost done now, just have to work with improper lists
I have found the slides there clear and simple to understand macros: https://people.csail.mit.edu/jhbrown/scheme/
these improper lists are killing me
this might be unrelated, but how do I make emacs treat my own custom syntax as if it were a let?
I'm tired of using my macros and then having my code indented to far to the right
>>8
just put this in your .emacs
(put '<your syntax here> 'scheme-indent-function 'defun)Just wrote this
(define-macro (dostring of . body)
(case (length of)
((2) (if (list? (car of))
`(dostring (,@of (values)) ,@body)
`(dostring ((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) (values)) ,@body)))
((3) (if (list? (car of))
`(reverse-args begin ,(caddr of)
(reverse-args string-for-each-index ,(cadr of)
(lambda (,(cadar of))
(let ((,(caar of) (string-ref ,(cadr of) ,(cadar of)))) ,@body))))
`(dostring ((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) ,(caddr of)) ,@body)))))an example
(dostring (char "apple")
(format #t "~a : ~a~%" char char-index)) ; keeps track of indexWat.
>>10
I've extended to vectors now
(define-module (do-stuff)
#:use-module (macro-help)
#:use-module (srfi srfi-4 gnu)
#:export-syntax (dolist dotimes do-sequence do-string do-vector))
(define-syntax dolist
(syntax-rules ()
((dolist (var list) body ...)
(dolist (var list (values)) body ...))
((dolist (var list value) body ...)
(begin (for-each (λ (var) body ...) list) value))))
(define-macro (dotimes of . body)
(case (length of)
((2) `(dotimes (,@of (values)) ,@body))
((3) (let ((expr (uniqsym)))
`(let ((,expr ,(cadr of)))
(do ((,(car of) 0 (1+ ,(car of))))
((= ,(car of) ,expr) ,(caddr of)) ,@body))))))
(define-macro (do-sequence for-each-index seq-ref of . body)
(case (length of)
((2) (if (list? (car of))
`(do-sequence ,for-each-index ,seq-ref (,@of (values)) ,@body)
`(do-sequence ,for-each-index ,seq-ref
((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) (values)) ,@body)))
((3) (if (list? (car of))
`(reverse-args begin ,(caddr of)
(reverse-args ,for-each-index ,(cadr of)
(lambda (,(cadar of))
(let ((,(caar of) (,seq-ref ,(cadr of) ,(cadar of)))) ,@body))))
`(do-sequence ,for-each-index ,seq-ref
((,(car of) ,(symbolicate (car of) '-index))
,(cadr of) ,(caddr of)) ,@body)))))
(define-macro (do-string of . body)
`(do-sequence string-for-each-index string-ref ,of ,@body))
; im not proud of this
(define-public (which-vector-length v)
(cond ((vector? v) vector-length)
((bitvector? v) bitvector-length)
((u8vector? v) u8vector-length)
((s8vector? v) s8vector-length)
((u16vector? v) u16vector-length)
((s16vector? v) s16vector-length)
((u32vector? v) u32vector-length)
((s32vector? v) s32vector-length)
((u64vector? v) u64vector-length)
((s64vector? v) s64vector-length)
((f32vector? v) f32vector-length)
((f64vector? v) f64vector-length)
((c32vector? v) c32vector-length)
((c64vector? v) c64vector-length)))
(define-public (which-vector-ref v)
(cond ((vector? v) vector-ref)
((bitvector? v) bitvector-ref)
((u8vector? v) u8vector-ref)
((s8vector? v) s8vector-ref)
((u16vector? v) u16vector-ref)
((s16vector? v) s16vector-ref)
((u32vector? v) u32vector-ref)
((s32vector? v) s32vector-ref)
((u64vector? v) u64vector-ref)
((s64vector? v) s64vector-ref)
((f32vector? v) f32vector-ref)
((f64vector? v) f64vector-ref)
((c32vector? v) c32vector-ref)
((c64vector? v) c64vector-ref)))
(define-public (vector-for-each-index proc vector)
(dotimes (i ((which-vector-length vector) vector)) (proc i)))
(define-macro (do-vector of . body)
(let ((cwrs (uniqsym)))
`(let ((,cwrs (λ (v i) ((which-vector-ref v) v i))))
(do-sequence vector-for-each-index ,cwrs ,of ,@body))))>>12
If your scheme has an object system a la CLOS, try using that.
What scheme are you using?
>>13
it's guile, and it does have a system a la CLOS
idk if it defines a generic vector-length or vector-ref though
>>13
(class-methods <vector>)
returns nothing
maybe guile 3 will define a lot of stuff for goops
>>15
That's unfortunate. Have you considered filing a bug?
>>16
I don't think it's a bug, it's just they haven't implemented such things yet.
>>17
that's a bug imo.
>>18
fortunately, i've just found that array-length and array-ref is a "generic" procedure of those
but not generic in the sense of CLOS generic functions
Here are some tracing macros if you're working in a REPL which odes not include these. I wouldn't be surprised if there was a more elegant way to define ‘trace-lambda’, or a better name for ‘multi’. It also might be useful to wrap ‘args’ in ‘multi’ with parenthesis so it can work with functions which take an arbitrary number of arguments, at the expense of a slightly more ugly syntax for an already rather ugly macro.
(define-syntax multi
(syntax-rules ()
((_ f args ...)
(begin (f args) ...))))
(define-syntax trace-lambda
(syntax-rules ()
((_ name (args ...) body ...)
(lambda (args ...)
(define name
(let ((indent " "))
(lambda (args ...)
(multi display indent "(" (quote name))
(multi display " " args) ...
(display ")\n")
(let ((old-indent indent)
(return
(begin
(set! indent (string-append indent ": "))
body ...)))
(set! indent old-indent)
(multi display indent return "\n")
return))))
(name args ...)))))
(define-syntax trace-define
(syntax-rules ()
((_ (name args ...) body ...)
(define name (trace-lambda name (args ...) body ...)))))
(define-syntax trace-let
(syntax-rules ()
((_ name ((keys values) ...) body ...)
((trace-lambda name (keys ...) body ...) values ...))))
(define-syntax trace
(syntax-rules ()
((_ exp) (let ((result exp)) (display exp) exp))))Here's part of a Forth-like interpreter that I wrote for one of the exercises on Exercism:
(define-syntax $~
(lambda (x)
(syntax-case x (-> :)
((_ st : (var ...) -> (body ...))
(with-syntax ((len (length (syntax->datum #'(var ...))))
(((name . pos) ...)
(map cons
(map (lambda (i) (datum->syntax #'i i)) (syntax->datum #'(var ...)))
(reverse (iota (length (syntax->datum #'(var ...)))))))
((rbody ...)
(reverse (map (lambda (i) (datum->syntax #'i i))
(syntax->datum #'(body ...))))))
#'(let ((name (list-ref st pos))
...
(rest (list-tail st len)))
(append (list rbody ...) rest)))))))
(define (eval stack instr)
(cond
((eq? instr '+) ($~ stack : (a b) -> ((+ a b))))
((eq? instr '-) ($~ stack : (a b) -> ((- a b))))
((eq? instr '*) ($~ stack : (a b) -> ((* a b))))
((eq? instr '/) ($~ stack : (a b) -> ((truncate (/ a b)))))
((eq? instr 'dup) ($~ stack : (a) -> (a a)))
((eq? instr 'drop) ($~ stack : (a) -> ()))
((eq? instr 'swap) ($~ stack : (a b) -> (b a)))
((eq? instr 'over) ($~ stack : (a b) -> (a b a)))
((number? instr) (cons instr stack))
(else (error 'forth "unknown operation"))))>>20
Is there any reason for multi to be a macro? Currently it is the same as
(define (multi f . args)
(for-each f args))If you wrapped it in extra parentheses, it would be just for-each. For example:
(for-each
(lambda (a b) (display (+ a b)) (newline))
'(1 2 3) '(4 5 6))Unless I am missing something.
>>22
christ, no you're not missing anything, I knew it didn't need to be a macro, and it seemed a little fishy, but for some reason I completely missed that it was just ‘for-each’, fail.
>>21
This is a truly gorgeous macro.
> 20
These are amazing, thank you!
FWIW here are my DEFINE-SYNTAX versions of the above-mentioned PUSH!, POP!, INCF!, DECF!. They are trivial but this might be useful for beginners to see how to translate from DEFINE-MACRO:
(define-syntax push!
(syntax-rules ()
((push! item seq)
(begin (set! seq (cons item seq))
seq))))
(define-syntax pop!
(syntax-rules ()
((pop! seq)
(let ((result (car seq)))
(begin (set! seq (cdr seq))
result)))))
(define-syntax incf!
(syntax-rules ()
((incf! var)
(begin (set! var (+ 1 var))
var))))
(define-syntax decf!
(syntax-rules ()
((decf! var)
(begin (set! var (- var 1))
var))))These are amazing
Thanks! Since you're using it here's an improved version taking into consideration >>22,23 and using a global variable to allow for nested tracings (be careful!), I've put it in a pastebin since I already posted it once: http://0x0.st/iOhT.txt
Your macros are pretty /cozy/ btw.
>>26
So many mistakes these days, I'll try to fix this in the morning.
>>27
Here's probably the final version: http://0x0.st/iOCV.txt
>>28
The work of a bad engineer is never done, here's an implementation as a portable R7RS library so you don't have to fear the shadows anymore than neccessary: http://0x0.st/iVss.scm
(define-syntax let1*
(syntax-rules ()
((_ (((var0 val0) proc0 ...)) body ...)
((lambda (var0) proc0 ... body ...) val0))
((_ (((var0 val0) proc0 ...) ((var1 val1) proc1 ...) ...) body ...)
((lambda (var0)
proc0 ...
(let1* (((var1 val1) proc1 ...) ...) body ...))
val0))))
(define (multiple-dwellings)
(let1* (((fletcher (amb 1 2 3 4 5))
(require (not (= fletcher 1)))
(require (not (= fletcher 5))))
((cooper (amb 1 2 3 4 5))
(require (not (= cooper 1)))
(require (not (= (abs (- fletcher cooper)) 1)))
(require (not-member cooper (list fletcher))))
((smith (amb 1 2 3 4 5))
(require (not (= (abs (- smith fletcher)) 1)))
(require (not-member smith (list fletcher smith))))
((miller (amb 1 2 3 4 5))
(require (> miller cooper))
(require (not-member miller (list smith cooper fletcher))))
((baker (amb 1 2 3 4 5))
(require (not (= baker 5)))
(require (not-member baker (list miller smith cooper fletcher)))))
`((baker ,baker)
(cooper ,cooper)
(fletcher ,fletcher)
(miller ,miller)
(smith ,smith))))I wrote the attached macro today to remove some ugly lateral movement while optimizing the ‘multiple-dwelling’ procedure from SICP. If I was going to be writing in this non-deterministic language frequently I think I would change the interface a good bit (just look at that nasty repetition of ‘non-member’!), but this helps a good bit.
#define loop(s,n,args...) for(int i=s;i<n;i++){args;}
#define array(type,name,args...) type name[] ={args};
#define arrsize(arr) (sizeof(arr)/sizeof(arr[0]))
array(int,arr,1,3,4,6,2,7,9,1,0,-1);
loop(0,arrsize(arr),(arr[i]*=2),(arr[i]>6?printf("%d,",arr[i]):0))
#define loop(s,n,args...) for(int i=s;i<n;i++){args;}
There's no reason for the args, just do
#define loop(s, n) for (int __i = (s), __n = (n); __i < __n; ++__i)>>32 This allows to create more complex variants of the loop, much neater than just prepending for()
#define unwrap(args...) args
#define loop(s,n,args...) for(int i=s;i<n;i++){args;}
#define gloop(cond,args...) for(unwrap cond){args;}
#define array(type,name,args...) type name[] ={args};
#define arrsize(arr) (sizeof(arr)/sizeof(arr[0]))
#define limitprint(arr,cond,code...) gloop((int i=0;i<arrsize(arr);i++),(code),(arr[i] cond?printf("%d,",arr[i]):0))
array(int,arr,1,3,4,6,2,7,9,1,0,-1);
limitprint(arr,>6,(arr[i]*=2));
The above results in:
int arr[] ={1,3,4,6,2,7,9,1,0,-1};;
for(int i=0;i<(sizeof(arr)/sizeof(arr[0]));i++){((arr[i]*=2)),(arr[i] >6?printf("%d,",arr[i]):0);};
Is this really what C programmers find neat?
>>34
The thread is about "dirty little macros", not "neat elegant macros made by lisp wizards". There are neat things...
C preprocessor can handle variadic arguments by switching on number of arguments:
https://stackoverflow.com/a/26408195
This can be used with _Generic to create type-generic, variadic macros. The C preprocessor arglist is also a tuple which can be manipulated with purely lexical macros such as above "unwrap",
using tokens, VA_ARGS and clever preprocessor hacks to achieve stuff that would normally be out of C reach.
Boost preprocessor library explores the more arcane ideas closer to functional programming, but utility macros are neat without introducing any layers of parsing themselves.
If you use LISP you probably recognize the idea of composition-type(##) token manipulation as primitive form of reader macros:
these combined tokens can be parsed as macro names which themself could expand to another composition,etc.
>>34
I also think that the thread should be limited to real macros, not fugly, non-portable "hacks" like what the last few posts have been about.
>>34 no, you only see stuff like that in APL implementer circles, except they'll name their macros with single letters, and make the whole thing somehow close to APL. like check out these macro definitions in ngn/k https://bitbucket.org/ngn/k/src/7a83bc777be99c09e7f54c1dc33ef886b301b518/k.h#lines-6 which results in code like this https://bitbucket.org/ngn/k/raw/81861b762de20fc82958890e1ad0a4341b1d8468/m.c. note that this is a very idiosyncratic style of code writing.
more realistically you have Poul-Henning Kamp's style and he's notorious for using macros freely, you can see some examples of his macro style here http://phk.freebsd.dk/time/20141116/ and here http://phk.freebsd.dk/time/20151212/
>>37 ( that ought to be https://bitbucket.org/ngn/k/raw/master/k.h and https://bitbucket.org/ngn/k/raw/master/m.c )
>>37,38
I recognize this style, its 'high density coding' to fit stuff on one screen and reduce typing effort, which probably looks like one of those obfuscated C entries, but if you use the same macro its fairly intuitive.
However these are not compositional macros, these are just created to write stuff fast - like a shortcut you memorize.