So I'm attempting to implement a Caesar cipher in LISP recursively, and I've got the basic functionality working. The problem is it returns a list of characters, and calling concatenate 'string on the return statement just returns the same list of characters plus a "". What am I doing wrong here?
(defun caesar (s n)
(if (null (concatenate 'list s))
'()
(cons
(code-char (+ n (char-code (car (concatenate 'list s)))))
(caesar (coerce (cdr (concatenate 'list s)) 'string) n)
)
)
)
The right approach to something like this is to do the conversion between string & list in a wrapper of some kind & then have the main function work on the list.
Here is an approach to doing that which uses some of the power and elegance of CL. This:
uses CLOS methods to do wrapping -- this will presumably make it ineligible for submission as homework, in case that is what it is, but is a good demonstration of how pretty CLOS can be I think, and is also how I would actually write something like this;
uses coerce in the wrapper method rather than concatenate to change types, since that's what it's for;
intentionally does not deal with some of the other problems of the original code around recursion & char-codes.
First of all here is a version which uses two methods: a wrapper method (defined in the generic function definition for convenience) and then the recursive method which does the work:
(defgeneric caesar (text n)
(:method ((text string) n)
;; if we're given a string just turn it into a list, then recurse
;; on the list & turn it back to a string (of the same type, hence
;; TYPE-OF).
(coerce (caesar (coerce text 'list) n) (type-of text))))
(defmethod caesar ((text list) n)
;; The recursive level (note this has various issues which are in
;; the original code & not addressed here
(if (null text)
'()
(cons (code-char (+ n (char-code (first text))))
(caesar (rest text) n))))
Secondly here is a slightly too-clever approach, using a special termination-on-null method. I would not recommend this, but it's a neat demonstration of the kind of thing CLOS can do.
(defgeneric caesar (text n)
(:method ((text string) n)
;; if we're given a string just turn it into a list, then recurse
;; on the list & turn it back to a string (of the same type, hence
;; TYPE-OF).
(coerce (caesar (coerce text 'list) n) (type-of text))))
(defmethod caesar ((text null) n)
;; termination
'())
(defmethod caesar ((text list) n)
;; The recursive level (note this has various issues which are in
;; the original code & not addressed here
(cons (code-char (+ n (char-code (first text))))
(caesar (rest text) n)))
I would be tempted to combine with-output-to-string and labels (for the recursive bit):
(defun caesar (s n)
(with-output-to-string (cipher)
(labels ((beef (s)
(when s
(princ <whatever> cipher)
(beef (rest s)))))
(beef (coerce s 'list)))))
Caveat: the above is thoroughly untested and simply typed into this message, so likely will not even compile. It just makes the suggestions more cncrete.
Related
I am trying to use generic functions' ability to specify behaviour based on the first argument of a list.
In other words, I want the list (atypelist 1 2 3) and the list (btypelist 1 2 3) to have their individual behaviour when passed to foo. So far, this is what I came up with:
(deftype atypelist (lst)
`(eq (car ,lst) 'atypelist))
(deftype btypelist (lst)
`(eq (car ,lst) 'btypelist))
(defmethod foo ((lst atypelist))
(format nil "success atypelist: ~S" lst))
(defmethod foo ((lst btypelist))
(format nil "success btypelist: ~S" lst))
However, when I call (typep (list 'atypelist 1 2 3) 'atypelist) I get the following error:
error while parsing arguments to DEFTYPE ATYPELIST:
too few elements in
()
to satisfy lambda list
(LST):
exactly 1 expected, but got 0
I am guessing the error is in my definition of atypelist.
Questions:
Is there a better way to get the functionality I am looking for?
If yes - what is the way?
If not - how to properly define a type on a list/cons that has a particular symbol in the car?
Before I start: what you want to do can't work, and is confused in two ways.
Firstly deftype defines a type in terms of other type specifiers: the body of a deftype form must expand into a type specifier, not an expression, as yours does. And deftype's arguments are not the thing you want to check the type for, they are parts of the type specification.
In this case you want to specify that the thing is a cons, and that its car is eql to something. Fortunately there are specializing type specifiers for both of these things, and you end up with something like this:
(deftype cons-with-specified-car (x)
`(cons (eql ,x) t))
And now
> (typep '(1) '(cons-with-specified-car 1))
t
> (typep '(a) '(cons-with-specified-car a))
t
> (typep '() '(cons-with-specified-car a))
nil
And if you want:
(deftype cons-with-a ()
'(cons-with-specified-car a))
and now
> (typep '(a) 'cons-with-a)
t
Secondly none of this will work because this it not how CLOS works. CLOS dispatches on classes not types, and you have merely defined a type, not a class: your method definitions simply cannot work, since classes cannot be parametrized in this way like types can.
Some ways you might achieve what you want.
If what you want to do is to dispatch on the first element of a list, then the obvious approach, if you want to use CLOS, is to use a two-level approach where you first dispatch on the class of the thing (cons is a class), and then use eql specializers to pick out the things you want.
(defgeneric select (it)
(:method ((it cons))
(select* (car it) it))
(:method (it)
nil))
(defgeneric select* (key it)
(:method (key it)
(format t "~&unknown key ~S in ~S~%" key it)))
(defmethod select* ((key (eql 'a)) it)
(format t "~&~S begins with a~%" it))
However in a case like this, unless you very much want the extensibility that CLOS gets you (which is a good reason to use CLOS here), I'd just use typecase. You could do this using the type defined above:
(defun select (it)
(typecase it
((cons-with-specified-car a)
'(cons a))
(cons
'cons)
(t
nil)))
or, probably simpler, just use what the deftype expands into:
(defun select (it)
(typecase it
((cons (eql a) t)
'(cons a))
(cons
'cons)
(t
nil)))
Finally probably what anyone doing this would actually write (again, assuming you do not want the extensibility CLOS gets you) is:
(defun select (it)
(typecase it
(cons
(case (car it)
...))
(t
...)))
Here is a possible solution, using the type specifier satisfies:
CL-USER> (defun is-atypelist (list)
(eq (car list) 'atypelist))
IS-ATYPELIST
CL-USER> (defun is-btypelist (list)
(eq (car list) 'btypelist))
IS-BTYPELIST
CL-USER> (deftype atypelist ()
`(satisfies is-atypelist))
ATYPELIST
CL-USER> (deftype btypelist ()
`(satisfies is-btypelist))
BTYPELIST
CL-USER> (typep (list 'atypelist 1 2 3) 'atypelist)
T
CL-USER> (typep (list 'atypelist 1 2 3) 'btypelist)
NIL
Note that this does not define a class, but a type, if this is what you need.
Is there a better way to get the functionality I am looking for?
1. Wrap your lists in container types
(defclass lst () ((items :initarg :items :reader items)))
(defclass alst (lst) ())
(defclass blst (lst) ())
It may be a little bit more cumbersome to work with but this is pretty much straightforward and not too suprising.
2. Douple-dispatch
(defgeneric foo (val))
(defgeneric foo/tag (tag val))
For example:
(defmethod foo ((c cons))
(destructuring-bind (tag . list) c
(foo/tag tag list)))
3. Define a custom method combination
It should be possible to hack the meta-object protocol dispatch mechanism to dispatch on the first item of a list. I wouldn't recommend it however.
4. Use a different dispatch mechanism
Use a completely different dispatching mechanism outside of CLOS, like pprint-dispatch does. For example you may want to use trivia or optima pattern-matching libraries, or cl-algebraic-data-type. This may be more useful if you are dealing with trees of symbols.
When working in a top level REPL, I sometimes forget what definitions I've entered into the running lisp system.
I use Clozure CL and it provides the option of saving the application as an image, which I do and can continue where I left off, but at this point it becomes impossible to review all the code, unless I had separately typed and saved the code to xyz file already.
Is there a way to get/extract/view the definitions that I entered, so I can save them as a source file?
The following will extract all the function definitions entered in a package:
(defun get-all-symbols (&optional package)
(let ((lst nil)
(package (find-package package)) )
(do-all-symbols (s lst)
(when (fboundp s)
(unless (and package (not (eql (symbol-package s) package)))
(push (cons s (function-lambda-expression s)) lst) )))))
Try something like:
(get-all-symbols *package*)
Common Lisp (in general) does not provide any standard way to “recover” the source code of a definition once it has been compiled. Normally, it's found in whatever file or buffer you're working-from.
(As Leo's answer points out, there is Function-Lambda-Expression, which can give you some function definitions. It won't help with, say, constants or classes, and it won't always work — as CLHS says, “Any implementation may legitimately return nil as the lambda-expression of any function.” http://clhs.lisp.se/Body/f_fn_lam.htm — his solution is certainly useful in the most common case(s), but it is not “as general” as this one.)
You could use a set of “wrapper” macros which store the forms you pass to them in a global hash-table, and then recover the source from that. Writing that sounded like an interesting little challenge, so the below is my attempt to do something like that.
My Silly Wrappers Solution
Note that the “source” forms stashed in this way won't preserve reader macros, comments, or the like, and will probably choke on some things like defmethod in subtly horrible ways. That's because I blindly store the definitions keyed off the defining form — eg, defun — and the second word, only. It's not smart enough to notice if you rebound a function as a macro or generic function (all three conflicting definitions would be saved), it doesn't read method combinations or lambda lists to save various methods, or any of that. There are lots of other things you might do — eg, (SetF (FDefinition 'FOO) …) — that could bypass these and go unnoticed, so it's far from “foolproof.” Caveat Lector.
The macros here try to inherit the documentation and lambda lists from the underlying forms, so they should work pretty nicely with most IDE's. They do well enough, in Slime.
One way to work with these would be to directly call them; eg, in your REPL you could directly
My-Package> (use-package :wrap-defining-form)
My-Package> (defun$ my-fn (x) (+ x (sqrt x)))
A more dangerous/interesting way is provided in the package Wrap-Defining-Form.Shadowing, in which the macros shadow the real Common-Lisp package definitions …
CL-User> (in-package :CL-USER$)
CL-User$> (defun blah (n) (loop repeat n do (format t "~&Blah …")))
When you're ready to “save” things, run (dump-definitions).
I wrote and tested this in SBCL, but tried to take care that it should work on many/most other implementations. In particular, I used one non-ANSI function: SB-Introspect:Function-Lambda-List. The function here Wrap-Defining-Form::Find-Function-Lambda-List will search all packages for your implementation's version of that function. If it can't find one, all is not lost; but you won't get hints from your IDE about the lambda-list of the wrapped function. (Clozure's seems to work — kinda — for functions, but not macros. That can probably be improved.)
CL-USER> (describe 'defun$)
WRAP-DEFINING-FORM:DEFUN$
[symbol]
DEFUN$ names a macro:
Lambda-list: (NAME LAMBDA-LIST &BODY BODY)
Documentation:
Wrap `DEFUN' and save the original form.
DEFUN: Define a function at top level.
Source file: /home/brpocock/Private/wrap-defining-form.lisp
; No value
Without Function-Lambda-List, the wrapper looks like
Lambda-list: (&REST UNKNOWN-LAMBDA-LIST)
… which is not very helpful.
wrap-defining-form.lisp
EDIT: Debugged in Clozure. Posted to https://github.com/brpocock/wrap-defining-forms also.
;;;; Wrap--Defining-Forms
;;; -*- Lisp -*-
(defpackage wrap-defining-forms
(:use :common-lisp)
(:documentation "Wrap defining forms so that they (try to) save the
source code of the definition being passed.")
(:export #:wrap-defining-form #:dump-definitions
#:defclass$
#:defconstant$
#:defgeneric$
#:define-compiler-macro$
#:define-condition$
#:define-method-combination$
#:define-modify-macro$
#:define-setf-expander$
#:define-symbol-macro$
#:defmacro$
#:defmethod$
#:defpackage$
#:defparameter$
#:defsetf$
#:defstruct$
#:deftype$
#:defun$
#:defvar$))
(defpackage wrap-defining-forms.shadowing
(:documentation "Wrapped forms like DEFUN$ are exported here with the
names of the forms that they wrap, like DEFUN, for
shadowing imports.")
(:export #:defclass
#:defconstant
#:defgeneric
#:define-compiler-macro
#:define-condition
#:define-method-combination
#:define-modify-macro
#:define-setf-expander
#:define-symbol-macro
#:defmacro
#:defmethod
#:defpackage
#:defparameter
#:defsetf
#:defstruct
#:deftype
#:defun
#:defvar)
(:use))
;; Clozure appears to be “smart” and adds Common-Lisp even though we
;; didn't ask for it (and explicily don't want it)
#+ccl (unuse-package '(:ccl :common-lisp)
:wrap-defining-forms.shadowing)
(defpackage :common-lisp-user/save-defs
(:nicknames :cl-user$)
(:use :common-lisp :common-lisp-user)
(:import-from :wrap-defining-forms #:dump-definitions)
(:shadowing-import-from :wrap-defining-forms.shadowing
#:defclass
#:defconstant
#:defgeneric
#:define-compiler-macro
#:define-condition
#:define-method-combination
#:define-modify-macro
#:define-setf-expander
#:define-symbol-macro
#:defmacro
#:defmethod
#:defpackage
#:defparameter
#:defsetf
#:defstruct
#:deftype
#:defun
#:defvar))
;; Clone any other functions you may have packed into CL-User.
(with-package-iterator (next-symbol :common-lisp-user :internal)
(loop for symbol = (next-symbol)
while symbol
for sibling = (intern (symbol-name symbol) (find-package :cl-user$))
when (and (fboundp symbol)
(not (fboundp sibling)))
do (setf (fdefinition sibling) (fdefinition symbol))))
(in-package "WRAP-DEFINING-FORMS")
(defvar *definitions* (make-hash-table)
"Copies of forms defined by the wrappers created by
`WRAP-DEFINING-FORM' which can be stashed with `DUMP-DEFINITIONS'")
#+ccl
(defun ccl-mock-lambda-list (function)
(if (macro-function function)
(list '&rest 'macro-lambda-list)
(multiple-value-bind (required optional restp
keywords)
(ccl:function-args (fdefinition function))
(concatenate ' list
(loop repeat required
collect (gensym "ARG-"))
(when (and optional (plusp optional))
(cons '&optional
(loop repeat optional
collect (gensym "OPT-"))))
(when restp
(list '&rest 'rest))
(when (and keywords (plusp keywords))
(list '&key '&allow-other-keys))))))
(defun find-function-lambda-list ()
"Find the implementation's version of `FUNCTION-LAMBDA-LIST' if there
is one. That way, Slime and friends can still give the proper
lambda-list for the wrapped form. If it can't be found, this will
return a stub with just a &rest-var."
(or
#+sbcl #'sb-introspect:function-lambda-list
#+ccl #'ccl-mock-lambda-list
#-(or ccl sbcl)
(dolist (package (list-all-packages))
(let ((sym (find-symbol "FUNCTION-LAMBDA-LIST" package)))
(when (fboundp sym)
(return-from find-function-lambda-list sym))))
(lambda (function)
(declare (ignore function))
(list '&rest 'unknown-lambda-list))))
(defmacro wrap-defining-form (cl-form)
"Assuming that CL-FORM is a symbol for a macro or function which
defines something interesting (eg, “Defun”), this will create a macro
with the same name with a trailing “$” that will save the source tree
before passing on the form to CL-FORM.
EG: (wrap-defining-form defun) provides a “defun$” which has the
additional side effect of storing the source form in *DEFINITIONS*.
Definitions saved can be recovered by `DUMP-DEFINITIONS'.
This is not industrial-strength; in particular, I expect it to cope
poorly with DEFMETHOD."
(check-type cl-form symbol)
(let ((wrapper (intern (concatenate 'string (symbol-name cl-form) "$")))
(wrapper.shadow (intern (symbol-name cl-form) :wrap-defining-forms.shadowing))
(wrapped-lambda-list (funcall (find-function-lambda-list) 'defun)))
(setf (gethash cl-form *definitions*) (make-hash-table))
`(prog1
(defmacro ,wrapper (&whole whole ,#wrapped-lambda-list)
(declare (ignore ,#(remove-if (lambda (form) (member form lambda-list-keywords))
wrapped-lambda-list)))
,(concatenate 'string "Wrap `" (symbol-name cl-form) "' and save the original form." #(#\newline #\newline)
(symbol-name cl-form) ": " (or (documentation cl-form 'function)
"(see CLHS; no documentation here)"))
(let ((defined (cons ',cl-form (cdr whole))))
(setf (gethash (second whole) (gethash ',cl-form *definitions*))
defined)
defined))
(defmacro ,wrapper.shadow (&whole whole ,#wrapped-lambda-list)
(declare (ignore ,#(remove-if (lambda (form) (member form lambda-list-keywords))
wrapped-lambda-list)))
,(concatenate 'string "Wrap `COMMON-LISP:" (symbol-name cl-form) "' and save the original form."
#(#\newline #\newline)
(symbol-name cl-form) ": " (or (documentation cl-form 'function)
"(see CLHS; no documentation here)"))
(let ((defined (cons ',cl-form (cdr whole))))
(setf (gethash (second whole) (gethash ',cl-form *definitions*))
defined)
defined)))))
(wrap-defining-form defclass)
(wrap-defining-form defconstant)
(wrap-defining-form defgeneric)
(wrap-defining-form define-compiler-macro)
(wrap-defining-form define-condition)
(wrap-defining-form define-method-combination)
(wrap-defining-form define-modify-macro)
(wrap-defining-form define-setf-expander)
(wrap-defining-form define-symbol-macro)
(wrap-defining-form defmacro)
(wrap-defining-form defmethod)
(wrap-defining-form defpackage)
(wrap-defining-form defparameter)
(wrap-defining-form defsetf)
(wrap-defining-form defstruct)
(wrap-defining-form deftype)
(wrap-defining-form defun)
(wrap-defining-form defvar)
(defun dump-definitions (&optional pathname)
"Write out the definitions saved by `WRAP-DEFINING-FORM'-built
wrappers to PATHNAME (or *STANDARD-OUTPUT*)."
(let (output
(*print-case* :capitalize)
;; If writing to file, set margin at 79, but try to keep things under 72.
(*print-right-margin* (if pathname 79 *print-right-margin*))
(*print-miser-width* (if pathname 72 *print-miser-width*)))
(unwind-protect
(progn (setq output (if pathname
(open pathname :direction :output
:if-exists :rename
:if-does-not-exist :create)
*standard-output*))
(multiple-value-bind (sec min hr d m y) (decode-universal-time (get-universal-time))
(declare (ignore sec))
(format output
"~&~|~%;;; definitions as of ~d-~d-~d # ~d:~2,'0d:
\(In-Package #:~a)
~{~{~2%~:<~W ~#_~:I~W ~:_~W~1I ~_~W~:>~}~^~|~}~%~|~%" ; from CLHS 22.2.2 SIMPLE-PPRINT-DEFUN
y m d hr min
(package-name *package*)
(remove-if #'null
(loop for form being the hash-keys of *definitions*
for defs = (gethash form *definitions*)
collect (loop for definition being the hash-values of defs
collect definition))))))
(when output (ignore-errors (close output))))))
Sample Usage
CL-USER> (load "wrap-defining-form.lisp")
T
CL-USER> (use-package :wrap-defining-form)
T
CL-USER> (defun$ trash-word (word)
(let ((s (string word)))
(sort (remove-if-not #'alpha-char-p s) #'char<)))
WARNING: redefining COMMON-LISP-USER::TRASH-WORD in DEFUN
TRASH-WORD
CL-USER> (trash-word 'Blatherscythe)
"ABCEEHHLRSTTY"
CL-USER> (describe 'trash-word)
COMMON-LISP-USER::TRASH-WORD
[symbol]
TRASH-WORD names a compiled function:
Lambda-list: (WORD)
Derived type: (FUNCTION (T) (VALUES SEQUENCE &OPTIONAL))
Source form:
(SB-INT:NAMED-LAMBDA TRASH-WORD
(WORD)
(BLOCK TRASH-WORD
(LET ((S (STRING WORD)))
(SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<))))
; No value
CL-USER> (macroexpand-1 '(defun$ trash-word (word)
(let ((s (string word)))
(sort (remove-if-not #'alpha-char-p s) #'char<))))
(DEFUN TRASH-WORD (WORD)
(LET ((S (STRING WORD)))
(SORT (REMOVE-IF-NOT #'ALPHA-CHAR-P S) #'CHAR<)))
T
CL-USER> (dump-definitions)
;;; definitions as of 2016-12-1 # 15:23:
(In-Package #:COMMON-LISP-USER)
(Defun Trash-Word (Word)
(Let ((S (String Word)))
(Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))
NIL
CL-USER> (in-package :Common-Lisp-User/Save-Defs)
#<PACKAGE "COMMON-LISP-USER/SAVE-DEFS">
CL-USER$> (defun 2+ (n) (+ 2 n))
2+
CL-USER$> (describe '2+)
COMMON-LISP-USER/SAVE-DEFS::2+
[symbol]
2+ names a compiled function:
Lambda-list: (N)
Derived type: (FUNCTION (T) (VALUES NUMBER &OPTIONAL))
Source form:
(SB-INT:NAMED-LAMBDA 2+
(N)
(BLOCK 2+ (+ 2 N)))
; No value
CL-USER$> (macroexpand-1 '(defun 2+ (n) (+ 2 n)))
(COMMON-LISP:DEFUN 2+ (N) (+ 2 N))
T
CL-USER$> (documentation 'defun 'function)
"Wrap `COMMON-LISP:DEFUN' and save the original form.
DEFUN: Define a function at top level."
CL-USER$> (dump-definitions)
;;; definitions as of 2016-12-1 # 15:32:
(In-Package #:COMMON-LISP-USER/SAVE-DEFS)
(Common-Lisp:Defun 2+ (N) (+ 2 N))
(Common-Lisp:Defun Trash-Word (Word)
(Let ((S (String Word)))
(Sort (Remove-If-Not #'Alpha-Char-P S) #'Char<)))
NIL
File Backup
Dump-Definitions also will write to a file. (It sets :If-Exists :Rename, so you could have one-level-UNDO protection as well.)
CL-USER$> (dump-definitions "saved.lisp")
NIL
Here is an interactive session with CCL:
? (declaim (optimize (debug 3)))
NIL
The above is not strictly required here, but it doesn't hurt to develop with high debugging levels.
? (defun foo (x) (+ 3 x))
FOO
? (inspect 'foo)
[0] FOO
[1] Type: SYMBOL
[2] Class: #<BUILT-IN-CLASS SYMBOL>
Function
[3] INTERNAL in package: #<Package "COMMON-LISP-USER">
[4] Print name: "FOO"
[5] Value: #<Unbound>
[6] Function: #<Compiled-function FOO #x3020004B3F7F>
[7] Arglist: (X)
[8] Plist: NIL
Inspect> 6
[0] #<Compiled-function FOO #x3020004B3F7F>
[1] Name: FOO
[2] Arglist (analysis): (X)
[3] Bits: 8388864
[4] Plist: (CCL::PC-SOURCE-MAP #(17 70 15 22) CCL::FUNCTION-SYMBOL-MAP
(#(X) . #(63 17 70)) CCL::%FUNCTION-SOURCE-NOTE ...)
[5] Source Location: #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
Inspect 1> 5
[0] #<SOURCE-NOTE Interactive "(defun foo (x) (+ 3 x))">
[1] Type: SOURCE-NOTE
[2] Class: #<STRUCTURE-CLASS SOURCE-NOTE>
[3] SOURCE: #(40 100 101 102 117 ...)
[4] FILENAME: NIL
[5] FILE-RANGE: 23
You can see that even from within the REPL, and without running Slime which might also store information about the Emacs environment, you can have access to the source code of FOO. This can be used if you know which function you want to recover. For a recording of your interactive session, follow jkiiski's advice about DRIBBLE.
Perhaps you can easily implement something like this yourself:
(defun my-repl (&optional (file-path "cl-history.lisp"))
"Saves commands to a file"
(loop
(with-open-file (stream file-path
:direction :output
:if-does-not-exist :create
:if-exists :append)
(print '>)
(let ((input (read)))
(format stream "~A~%" input)
(print (eval input))))))
To exit the inner loop you should type (quit).
Alternatively you can use com.informatimago.common-lisp.interactive.interactive:repl
What is this self reference for?
Could it be written in any other way?
Is there any advantage?
(defmacro sublet (bindings% &rest body)
(let ((bindings (let-binding-transform
bindings%)))
(setq bindings
(mapcar
(lambda (x)
(cons (gensym (symbol-name (car x))) x))
bindings))
`(let (,#(mapcar #'list
(mapcar #'car bindings)
(mapcar #'caddr bindings)))
,#(tree-leaves
body
#1=(member x bindings :key #'cadr)
(caar #1#)))))
It's just a way of reusing structure somewhere else. In the macro you have:
(tree-leaves body
#1=(member x bindings :key #'cadr)
(caar #1#))
Which is just a fancy way of writing:
(tree-leaves body
(member x bindings :key #'cadr)
(caar (member x bindings :key #'cadr)))
On the positive side if you correct a bug in the member form you'll fix it both places, but it's runs the same code twice so if member was expensive this wouldn't be the wise way to do it. However it is a macro, thus run at compile time, and member is fairly fast on mall lists (small == millions of elements or below) so I guess it won't matter if you read the references just as good as any other CL code. An alternative and perhaps more readable for other kind of lispers would be:
(let ((found (member x bindings :key #'cadr)))
(tree-leaves body found (caar found)))
I just started writing this function and I was wondering if there was a way, that if just the &key argument was entered, the &optional list could be ignored.
(defun test (&optional arg (i 0) &key (size s))
...)
I would like to be able to run
(test arg)
or
(test arg i)
but also
(test :size)
Now this is a better mock up but I don't know where to put :size in params list
(defun test (&optional arg (i 0))
(cond ((eq arg nil) (return-from test (test-1)))
((listp arg)
(return-from test (test-2 arg)))
((pointerp arg) (mem-aref (test-3 arg) :int i))
(:size (size-test arg))
(t nil)))
so i can run (test) and get:
<output of (test-1)>
I can run (test '(1 2 3)) and get:
<output of (test-2 arg)>
I can run (test <pointer> 0)
and output is:
<output of (mem-aref (test-3 arg) :int i)>
I can run (test :size) and get:
<output of (test-size arg)>
Mixing optional and keyword arguments
Mixing optional and keyword arguments is still something that's not all that easy to do. If a function accepts an optional argument, then you won't be able to use the keyword arguments unless the optional argument is also provided. Otherwise, the first keyword would be interpreted as the optional argument, and so on. See, for instance, this Stack Overflow question: How can I have optional arguments AND keyword arguments to the same function?. As the answer to that question points out, it's usually a bug-prone practice to mix optional and keyword arguments. Common Lisp does it with read-from-string, and it often leads people into trouble.
What you're proposing, though, isn't just having a function that uses both keyword and optional arguments, but, from the sounds of it, is actually doing some checking of the types of arguments, and taking one behavior in one case, and another in another. In this case, if i is supposed to be a number, then you could check the first argument, and if it's a number, then treat it as the optional argument, and the rest as keyword arguments, and if it's not a number, then treat the whole list as keyword arguments. You can do that with an &rest argument that you destructure in different ways:
(defun frob (&rest args)
(flet ((frob-driver (i size)
(list i size)))
(if (or (endp args) (numberp (first args)))
;; no args, or the first argument is a number (and thus
;; not a keyword argument)...
(destructuring-bind (&optional (i 'default-i) &key (size 'default-size)) args
(frob-driver i size))
;; otherwise, there are some non-numeric arguments at
;; beginning, so it must be the keyword list, and that the
;; "optional" wasn't provided.
(destructuring-bind (&key (size 'default-size) &aux (i 'default-i)) args
(frob-driver i size)))))
(frob 10 :size 50) ; give i and size
;=> (10 50)
(frob :size 60) ; give size, but not i
;=> (default-i 60)
(frob 40) ; give i, but not size
;=> (40 default-size)
(frob) ; give neither
;=> (default-i default-size)
Keyword arguments without keyword symbols
In the comments, you mentioned that you'd like to be able to use non-keyword symbols as keywords in argument lists. This is easy enough. In the HyperSpec, §3.4.1 Ordinary Lambda Lists describes the syntax for keyword arguments:
[&key {var | ({var | (keyword-name var)} [init-form [supplied-p-parameter]])}* [&allow-other-keys]]
This means that you can define functions like this:
(defun frob (&key foo ((bar-keyword bar-variable) 'default-baz))
(list foo bar-variable))
(frob :foo 1 'bar-keyword 2)
;=> (1 2)
(frob :foo 3)
;=> (3 default-baz)
(frob 'bar-keyword 2)
;=> (nil 2)
You have to use a &rest argument list and process it in the function.
Mixing optional and keyword arguments should be avoided. It is BAD style to use optional and keyword arguments. This has been the source for countless errors with the few functions which use that (like READ-FROM-STRING).
In short, "no". There's no way of making that happen. As a general rule, try to stay away from mixing &rest, &optional and &key arguments, since their interactions are subtle and will more frequently trip you up than actually be useful.
Furthermore, if :size is a keyword argument, hen (test :size) is missing one argument (the value to bind size to). Your best bet is probably to look a arg to see if it is :size or something else.
Posting as answer because I solved the main issue here is the resultant code I came up with, The cond statements are what matter. The &args usage created another issue and that post is being discussed here. The ((symbolp (cadr args)) (%vector-float-size (first args))) line is what I came up with from Joshua Taylors kindly written and extremely informative answer.
(defun vector-float (&rest args)
(cond ((eq (first args) nil) (return-from vector-float (%vector-float)))
((listp (first args))
(c-arr-to-vector-float (first args)))
((symbolp (cadr args)) (%vector-float-size (first args)))
((pointerp (first args)) (mem-aref (%vector-float-to-c-array (first args)) :float (second args)))
(t nil)))
I've put together the following rudimentary stopwatch in Racket (just learning now, the final aim is a pomodoro-timer).
#lang racket
(define start-time 0)
(define end-times '())
(define (start);; stores start-time
(set! start-time (current-seconds)))
(define (lap);; stores "laps" in list
(set! end-times (cons (current-seconds) end-times)))
(define (stop);; stores final time, displays lap-times in h, m, s and resets end-times
(begin
(set! end-times (cons (current-seconds) end-times))
(display
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
(set! end-times '())
))
While this does exactly what it should, I was wondering how I could avoid mutable state. If I follow HTDP, this is the kind of situation where mutable state is warranted, but after browsing Wadler's "Monads for Functional Programming", I'm still curious about how I could do without set!.
I know that to make it functional, I should add arguments to my functions. For instance, start would become
(define (start [now (current-seconds)])
now)
and a similar approach could work with lap and stop.
Still, while I know that after adding additional arguments to restore functionality, I should also pass arguments rather than storing values in variables, I don't see how in this case I can leverage this to avoid set! as well.
Update: Since all three answers below are highly valuable (thanks!), I didn't mark any of them as the unique correct one. Below is the minimal solution to my initial question. It is a combination of the loop-proposal of #Metaxal, with the example-usage of #Greg Hendershott.
#lang racket
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([t0 (current-seconds)] [times '()])
(match (read-line)
["quit" (reverse
(map (lambda (x)
(let ((the-date (seconds->date x)))
(list
(sub1(date-hour the-date))
(date-minute the-date)
(date-second the-date)))) times))]
["lap" (loop t0 (cons (- (current-seconds) t0) times))]
[_ (loop t0 times)])))
What will likely happen in the following of your program is that you will have a loop.
Then this loop can be a function that takes as input the whole current state, and when you want to update its state, just call the loop again with the new state (you may also call the loop again with the same exact state of course).
Simplified example:
(define (loop [t0 (current-seconds)] [times '()])
;; ... do things here, possibly depending on user input ...
;; then loop with a new state:
(cond [<some-start-condition> (loop (current-seconds) '())]
[<some-lap-condition> (loop t0 (cons (- (current-seconds) t0) times))]
[<some-stop-condition> times])) ; stop, no loop, return value
This certainly changes the approach to your design though.
It's harder to use this approach when designing GUI programs, because the event loop often prevents you from (or makes it difficult) passing values from one event to the next.
However, in Racket, there is (the pedagogical, but still very good) big-bang that is made just for that.
In this case using set! is justified and hard to avoid, because we must "remember" state between invocations of the procedures. What we can do is improving the encapsulation of state, by hiding the variables that change inside a procedure and using a message dispatcher for accessing the procedures that refer to the mutable state. This is very similar to what we do with object-oriented programming, but only lambdas are required to implement it!
(define (make-timer)
; the "attributes" of the object
(let ([start-time 0]
[end-times '()])
; the "methods" of the object
(define (start)
(set! start-time (current-seconds)))
(define (lap)
(set! end-times (append end-times (list (current-seconds)))))
(define (stop)
(lap)
(display
(map (lambda (an-end)
(let ((the-date (seconds->date (- an-end start-time))))
(list
(sub1 (date-hour the-date))
(date-minute the-date)
(date-second the-date))))
end-times))
(set! end-times '()))
; return a dispatch procedure
(lambda (msg)
(case msg
((start) (start)) ; call the start procedure defined above
((lap) (lap)) ; call the lap procedure defined above
((stop) (stop)) ; call the stop procedure defined above
(else (error "unknown message:" msg))))))
I took the liberty of modifying some of your procedures to make them a bit simpler. Here's how we would use the timer object we just created:
(define timer (make-timer))
(timer 'start)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'lap)
(sleep 1)
(timer 'stop)
=> ((18 0 1) (18 0 2) (18 0 3) (18 0 4))
This technique is called "message passing", learn more about it in the wonderful SICP book.
For a simple example like this, I would probably do what #Metaxal
suggested.
However another approach is that you could explicitly define the state
as a struct:
(struct state (start-time end-times))
Then change the start, lap, and stop to be functions on state:
;; start : -> state
;; stores start-time
(define (start)
(state (current-seconds) '()))
;; lap : state -> state
;; stores "laps" in list
(define (lap st)
(match-define (state start-time end-times) st)
(state start-time
(cons (current-seconds) end-times)))
;; stop : state -> list
;; stores final time, displays lap-times in h, m, s
(define (stop st)
(match-define (state start-time end-times*) st)
(define end-times (cons (current-seconds) end-times*))
(reverse
(map (lambda (an-end)
(let ((the-date (seconds->date(- an-end start-time))))
(list
(sub1(date-hour the-date))
;; sub1 is needed because (date-hour(seconds->date 0) = 1
(date-minute the-date)
(date-second the-date)))) end-times)))
As in #Metaxal's answer, your "main loop" needs to handle the state and "thread" it through the functions as appropriate:
Example usage:
(define (run)
(displayln "Enter 'lap' or 'quit':")
(let loop ([st (start)])
(match (read-line)
["quit" (stop st)]
["lap" (loop (lap st))]
[_ (loop st)])))
Whereas #Óscar López's answer shows a style of OOP as explained in SICP.
A nice thing about Racket (and Scheme) is that you can choose whatever approach on the spectrum you think best fits the problem at hand, and your taste -- simple imperative, OOP imperative, pure functional.