In sbcl, I know I can muffle the anticipated messages when using both &optional and &key in defun, but that doesn't seem to work in defmacro. (I should just redesign/rewrite, I know, but this is legacy code.)
When I compile this file ...
(declaim (sb-ext:muffle-conditions style-warning))
(defun wilma (&optional wilma1 &key wilma2 wilma3)
(declare (ignore wilma1 wilma2 wilma3)))
(defmacro betty (&optional betty1 &key betty2 betty3)
(declare (ignore betty1 betty2 betty3)))
... this happens:
home:~/sbcl/experiments/style-warning.d$ sbcl --noinform
* (compile-file "5.lisp")
; compiling file "/u/home/sbcl/experiments/style-warning.d/5.lisp" (written 09 OCT 2017 03:31:44 PM):
; compiling (DECLAIM (MUFFLE-CONDITIONS STYLE-WARNING))
; compiling (DEFUN WILMA ...)
; compiling (DEFMACRO BETTY ...)
; file: /u/home/sbcl/experiments/style-warning.d/5.lisp
; in: DEFMACRO BETTY
; (DEFMACRO BETTY (&OPTIONAL BETTY1 &KEY BETTY2 BETTY3)
; (DECLARE (IGNORE BETTY1 BETTY2 BETTY3)))
;
; caught STYLE-WARNING:
; &OPTIONAL and &KEY found in the same lambda list: (&OPTIONAL BETTY1 &KEY BETTY2
; BETTY3)
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
; /u/home/sbcl/experiments/style-warning.d/5.fasl written
; compilation finished in 0:00:00.018
#P"/u/home/sbcl/experiments/style-warning.d/5.fasl"
T
NIL
* (exit)
home:~/sbcl/experiments/style-warning.d$
How do I suppress these diagnostics?
EDIT 1:
Since this is legacy code and I'll just massage it for sbcl-readiness and then leave it alone, there's no reason I can't do something like this in any code which uses it:
home:~/sbcl/experiments/style-warning.d$ sbcl --noinform
* (with-open-file (*error-output* "/dev/null" :direction :output :if-exists :append)
(compile-file "5.lisp"))
; compiling file "/u/home/sbcl/experiments/style-warning.d/5.lisp" (written 09 OCT 2017 03:31:44 PM):
; compiling (DECLAIM (MUFFLE-CONDITIONS STYLE-WARNING))
; compiling (DEFUN WILMA ...)
; compiling (DEFMACRO BETTY ...)
; /u/home/sbcl/experiments/style-warning.d/5.fasl written
; compilation finished in 0:00:00.017
#P"/u/home/sbcl/experiments/style-warning.d/5.fasl"
T
NIL
* (exit)
home:~/sbcl/experiments/style-warning.d$
But is there something out there which can suppress style warnings in macro definitions?
You need to run
(declaim (sb-ext:muffle-conditions style-warning))
before the form (defmacro betty ...) is compiled.
One way to do that is
$ sbcl --non-interactive --eval '(declaim (sb-ext:muffle-conditions style-warning))' --eval '(compile-file "5")'
This is SBCL 1.4.0, an implementation of ANSI Common Lisp.
More information about SBCL is available at <http://www.sbcl.org/>.
SBCL is free software, provided as is, with absolutely no warranty.
It is mostly in the public domain; some portions are provided under
BSD-style licenses. See the CREDITS and COPYING files in the
distribution for more information.
; compiling file "/Users/sds/lisp/5.lisp" (written 09 OCT 2017 09:51:51 PM):
; compiling (DEFUN WILMA ...)
; compiling (DEFMACRO BETTY ...)
; /Users/sds/lisp/5.fasl written
; compilation finished in 0:00:00.010
where the file 5.lisp only contains wilma and betty:
(defun wilma (&optional wilma1 &key wilma2 wilma3)
(declare (ignore wilma1 wilma2 wilma3)))
(defmacro betty (&optional betty1 &key betty2 betty3)
(declare (ignore betty1 betty2 betty3)))
Related
I would like to try extending some Lisp (Scheme, Racket, Clojure, any) to run external commands as follows:
; having
(define foo ...)
(define bar ...)
; on command
(ls (foo bar) baz)
; this lisp should evaluate (foo bar) as usual, with result "foobar", then
(ls foobar baz)
; here "ls" is not defined
; instead of rising "undefined identifier" exception
; it must look for "ls" command in the directories
; in the "PATH" environment variable
; and launch the first found "ls" command
; with strings "foobar" and "baz" on input
I just want to run it anyhow, without carrying about correct conversion from lisp's data structures to strings or handling the exit code and the output of the command in stdout/stderr.
I think there is no way to extend it within normal environment (like catching the "undefined" exception all the time). The eval procedure of the interpreter itself must be changed.
Which Lisp is the best to extend it like this and how is it done? Maybe there already exists a project performing something similar?
Common Lisp has a standard error system which may be used to implement that.
In Common Lisp implementations which provide a use-value or store-value restart for errors of type undefined-function.
Example
CL-USER 69 > (flet ((call-use-value-restart (c)
(use-value (lambda (arg)
(format t "~%dummy function with arg ~a~%" arg))
c)))
(handler-bind ((undefined-function #'call-use-value-restart))
(this-function-does-not-exist "foo")))
dummy function with arg foo
NIL
In the above example the function this-function-does-not-exist does not exist. As you can see, the error is handled and another function is called instead, which then does some output.
If we call the undefined function on its own, we get an error:
CL-USER 70 > (this-function-does-not-exist "foo")
Error: Undefined operator THIS-FUNCTION-DOES-NOT-EXIST in form (THIS-FUNCTION-DOES-NOT-EXIST "foo").
1 (continue) Try invoking THIS-FUNCTION-DOES-NOT-EXIST again.
2 Return some values from the form (THIS-FUNCTION-DOES-NOT-EXIST "foo").
3 Try invoking something other than THIS-FUNCTION-DOES-NOT-EXIST with the same arguments.
4 Set the symbol-function of THIS-FUNCTION-DOES-NOT-EXIST to another function.
5 Set the macro-function of THIS-FUNCTION-DOES-NOT-EXIST to another function.
6 (abort) Return to top loop level 0.
Type :b for backtrace or :c <option number> to proceed.
Type :bug-form "<subject>" for a bug report template or :? for other options.
CL-USER 71 : 1 >
Our example basically calls the restart number 3 programmatically:
It binds a handler which calls the function call-use-value-restart when an error of type undefined-function happens.
The function call-use-value-restart then calls the use-value restart with a function it provides. Here you could provide a function which calls an external program of the name given by (cell-error-name c). The use-value restart then just calls the provided function and keeps on executing the program as usual.
Hint for a solution
Typically one would write a small top-level loop where such a handler is provided.
Another way to call the restart
In this example we use a hook to add a handler in case an error happens. Here we use the global variable *debugger-hook*. This should be a function and in our case it calls a new function when the condition c is of type undefined-function.
* (defun provide-a-function-hook (c hook)
(declare (ignore hook))
(typecase c
(undefined-function (use-value (lambda (arg)
(format t "~%dummy function with arg ~a~%" arg))
c))))
PROVIDE-A-FUNCTION-HOOK
* (setf *debugger-hook* #'provide-a-function-hook)
#<FUNCTION PROVIDE-A-FUNCTION-HOOK>
* (this-function-does-not-exist "foo")
; in: THIS-FUNCTION-DOES-NOT-EXIST "foo"
; (THIS-FUNCTION-DOES-NOT-EXIST "foo")
;
; caught STYLE-WARNING:
; undefined function: THIS-FUNCTION-DOES-NOT-EXIST
;
; compilation unit finished
; Undefined function:
; THIS-FUNCTION-DOES-NOT-EXIST
; caught 1 STYLE-WARNING condition
dummy function with arg foo
NIL
In racket you may override #%top:
#lang racket
(provide
(combine-out
(except-out (all-from-out racket) #%top)
(rename-out [shell-curry #%top])))
(require racket/system)
(define (stringify a)
(~a (if (cmd? a) (cmd-name a) a)))
(struct cmd (name proc)
#:property prop:procedure
(struct-field-index proc)
#:transparent
#:methods gen:custom-write
[(define (write-proc x port mode)
(display (string-append "#<cmd:" (stringify x) ">") port))])
(define (shell name)
(define (cmd-proxy . args)
(define cmd
(string-join (map stringify (cons name args))
" "))
(system cmd))
cmd-proxy)
(define-syntax shell-curry
(syntax-rules ()
((_ . id)
(cmd 'id (shell 'id)))))
Save this as shell.rkt and make this runner.rkt in the same directory:
#lang s-exp "shell.rkt"
(define test (list /bin/ls /usr/bin/file))
(second test) ; ==> #<cmd:/usr/bin/file>
(first test) ; ==> #<cmd:/bin/ls>
((second test) (first test))
; ==> t (prints that /bin/ls is an executable on my system)
Now from here to make it a #lang myshell or something like that is pretty easy.
In Gambit Scheme, I can't seem to invoke a macro in the definition of another macro if I compile the file. Here is a contrived example:
;;;; example.scm
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body))
(define-macro (compose-macro f g)
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))
(define my-cadr
(lambda (x)
((compose-macro car cdr) x)))
;; $ gsc example.scm
;; *** ERROR IN #<procedure #2> -- Unbound variable: w/gensyms
However, if I load the file with the (include ...) special form in the interpreter, it works
$ gsi
> (include "example.scm")
> (pp my-cadr)
(lambda (x) ((lambda (#:x0) (car (cdr #:x0))) x))
Does anyone know what is going on here? Can I convince Gambit to let me use w/gensyms in the definition of another macro in a compiled file?
This is most likely related to phases.
Try this:
Put w/gensyms in a file a.scm and put compose-macro in a file b.scm that imports a.scm.
This is a phasing problem. You want the definition of w/gensyms to be available in the body of subsequent macros. This can be achieved with a for-syntax macro that forces the evaluation of the macro definition at syntax expansion time:
(define-macro (for-syntax . body)
(eval `(begin ,#body))
`(begin))
(for-syntax
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body)))
If you want the macro to be available both from within other macro definitions and within non-macro definition code you can use this instead:
(define-macro (for-syntax . body)
(eval `(begin ,#body))
`(begin ,#body))
For this specific example, since you are using the macro at a single place, you could have done this:
(define-macro (compose-macro f g)
(define-macro (w/gensyms gs body)
`(let ,(map (lambda (g) `(,g (gensym ',g)))
gs)
,body))
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))
A related approach to address phasing issues is to put the definition of w/gensyms and other macros in the file "macros.scm" and do:
(define-macro (compose-macro f g)
(include "macros.scm")
(w/gensyms (x)
`(lambda (,x) (,f (,g ,x)))))
I am new to LISP and want to understand, how to write LISP macro code, which evaluates all forms but returns output of only one specified form, where the form to be returned could be specified inside macro or can be a user provided input.
I used following macro and it returns the output of the second form. but it doesn't seem correct, as it doesn't seem to evaluate the first form and I would like to specify which of the two forms to evaluate.
(defmacro testcode () (+ 3 4) (+ 5 6))
(macroexpand-1 (testcode))
11
NIL
Macros are syntactical abstractions or syntax sugaring. testcode does it's calculations in macro expansion time and thus you cannot expect the forms to be calculated more than once and (testcode) is synonymous with the "code" 11. To illustrate that lets give it side effects:
(defmacro testcode ()
(print "expanding testcode")
(+ 3 4) ; dead code. Never gets used
(+ 5 6))
(defun test ()
(testcode))
; prints "expanding testcode"
(test)
; ==> 11 (doesn't print anything)
(test)
; ==> 11 (still doesn't print anything, Why?)
(disassemble 'test)
; ==>
; 0 (const 0) ; 11
; 1 (skip&ret 1)
So test literally is the same as (defun (test) 11).
So what are macros? Well if you have written this and noticed there is a pattern:
(let ((it (heavy-cpu-function var)))
(when it
(do-something-with-it it)))
You can say this is a thing I create syntax for:
(defmacro awhen (predicate-expression &body body)
`(let ((it ,predicate-expression))
(when it
,#body)))
(macroexpand-1 '(awhen (heavy-cpu-function var)
(do-something-with-it it)))
; ==>
; (let ((it (heavy-cpu-function var)))
; (when it
; (do-something-with-it it)))
So instead of writing the first you use awhen and Common Lisp changes it to the first. You are using a lot of macros since a lot of syntax in Common Lisp are macros:
(macroexpand-1 '(and (a) (b) (c)))
; ==>
; (cond ((not (a)) nil)
; ((not (b)) nil)
; (t (c)))
(macroexpand-1 '(cond ((not (a)) nil)
((not (b)) nil)
(t (c)))
; ==>
; (if (not (a))
; nil
; (if (not (b))
; nil
; (c)))
I'm trying to write an ELisp macro to generate a multiple functions based on some common data. For example, when I want to compute the fn names I write something like (I'm ignoring hygiene for the moment, I'm passing a symbol literal into the macro so evaluation shouldn't matter):
(cl-defmacro def-fns (sym)
"SYM."
(let ((s1 (make-symbol (concat (symbol-name sym) "-1")))
(s2 (make-symbol (concat (symbol-name sym) "-2"))))
`(progn (defun ,s1 () (+ 1 2 3))
(defun ,s2 () "six"))))
which I expect to generate 2 fns when invoked, called foo-1 and foo-2.
I should then be able to invoke the macro and fns like so:
(def-fns foo)
(foo-1)
;; => 6
(foo-2)
;; -> "six
Even the macroexpansion of (def-fns foo) in Emacs suggests that this should be the case:
(progn
(defun foo-1 nil (+ 1 2 3))
(defun foo-2 nil "six"))
However, when I evaluate the def-fns definition and invoke it it does not generate those functions. Why is this the case? This technique works in Common Lisp and in Clojure (which have very similar macro systems), so why not in ELisp?
Your code would not work in CL either.
The problem is with make-symbol - it creates a new symbol, so that
(eq (make-symbol "A") (make-symbol "A"))
==> nil
This means that your macro creates the functions but binds them to symbols which you no longer have a handle on.
When you evaluate (foo-1), Emacs Lisp reader tries to find the function binding of the interned symbol foo-1, not the fresh uninterned symbol your macro created.
You need to use intern instead: it makes the symbol "generally available", so to speak:
(eq (intern "a") (intern "a))
==> t
So, the corrected code looks like this:
(defmacro def-fns (sym)
"SYM."
(let ((s1 (intern (concat (symbol-name sym) "-1")))
(s2 (intern (concat (symbol-name sym) "-2"))))
`(progn (defun ,s1 () (+ 1 2 3))
(defun ,s2 () "six"))))
(def-fns foo)
(foo-1)
==> 6
(foo-2)
==> "six"
Notes:
If you were using CL, the uninterned symbols would have been printed as #:foo-1 and the source of your problem would have been obvious to you.
It is exceedingly rare that you really need to use make-symbol. Usually, you want to use either intern or gensym.
I am creating a new language based on Racket and I don't want certain #x macros to work, such as the syntax-quote #'. How do I remove it so that #' does not do a syntax quote, but does whatever an unbound dispatch macro-char does?
I can do that with single-char macros by doing
(make-readtable (current-readtable)
#\' #\a #f) ; set ' to be the same as a normal character
but I don't know how to do this for dispatch macros.
Assuming you want #' to be treated as ':
Provide a reader-proc that simply calls the normal read-syntax:
#lang racket/base
(define (reader-proc ch in src line col pos)
(read-syntax src in))
(define our-readtable (make-readtable (current-readtable)
#\'
'dispatch-macro
reader-proc))
;; A `#:wrapper1` for `syntax/module-reader`, i.e. to use in your
;; lang/reader.rkt
(define (wrapper1 thk)
(parameterize ([current-readtable our-readtable])
(thk)))
(provide wrapper1)
;; tests
(module+ test
(require rackunit
racket/port)
(parameterize ([current-readtable our-readtable])
(check-equal? (with-input-from-string "#'foo" read)
'foo)
(check-equal? (with-input-from-string "#'(foo)" read)
'(foo))
(check-equal? (with-input-from-string "#'(foo #'(bar))" read)
'(foo (bar)))))
A slightly more complicated example of working with 'dispatch-macro is the lambda reader literal support I just recently added to #lang rackjure.
UPDATED
Assuming you want #' to cause a read error, "bad syntax: #'":
#lang racket/base
(require syntax/readerr)
(define (reader-proc ch in src line col pos)
(raise-read-error (format "bad syntax: #~a" ch)
src line col pos 2))
(define our-readtable (make-readtable (current-readtable)
#\'
'dispatch-macro
reader-proc))
;; A `#:wrapper1` for `syntax/module-reader`, i.e. to use in your
;; lang/reader.rkt
(define (wrapper1 thk)
(parameterize ([current-readtable our-readtable])
(thk)))
(provide wrapper1)
;; tests
(module+ test
(require rackunit
racket/port)
(parameterize ([current-readtable our-readtable])
(check-exn exn:fail? (λ () (with-input-from-string "#'foo" read)))))