Sequential procedures in Lisp - functional-programming

When I try to program in a functional style with immutable objects, sequential operations end up being written inside-out, like this:
(thing-operation3
(thing-operation2
(thing-operation1 thing extra-arg1)
extra-arg2)
extra-arg3)
I'm starting to see this pattern repeating all over my code, and I find it very hard to read. This could marginally be improved using higher-order procedures like curry and compose:
((compose1
(curryr thing-operation3 extra-arg3)
(curryr thing-operation2 extra-arg2)
(curryr thing-operation1 extra-arg1))
thing)
Better perhaps, but it is still written upside-down, and it takes some extra cognitive load to figure out what is going on. And I'm not sure whether this is ideomatic Lisp-code.
Object-oriented style is so much easier to read:
thing.operation1(extra-arg1).operation2(extra-arg2)
.operation3(extra-arg3)
It reads in a natural order, and it could also be implemented with immutable objects.
What is the ideomatic way of writing such sequential operations in Lisp so that they are easy to read?

An usual way in Common Lisp would be to use LET*
(let* ((thing1 (thing-operation0 thing0 extra-arg0))
(thing2 (thing-operation1 thing1 extra-arg1))
(thing3 (thing-operation2 thing2 extra-arg2)))
(thing-operation3 thing3 extra-arg3))
That way one can name the return values, which improves readability and one could write declarations for those.
One could also write a macro which might be used like in the following:
(pipe
(thing-operation1 thing extra-arg1)
(thing-operation2 _2 extra-arg2)
(thing-operation3 _3 extra-arg3)
(thing-operation4 _4 extra-arg4))
Some language provide similar macros and Lisp libraries may provide variations of it. Let's write a simple version of it:
(defmacro pipe (expression &rest expressions)
(if (null expressions)
expression
(destructuring-bind ((fn arg &rest args) &rest more-expressions)
expressions
(declare (ignorable arg))
`(pipe
(,fn ,expression ,#args)
,#more-expressions))))
For above pipe expression the following code is produced:
(THING-OPERATION4
(THING-OPERATION3
(THING-OPERATION2
(THING-OPERATION1 THING EXTRA-ARG1)
EXTRA-ARG2)
EXTRA-ARG3)
EXTRA-ARG4)
A variant:
(defmacro pipe (expression &rest expressions)
(if (null expressions)
expression
(destructuring-bind ((fn arg &rest args) &rest more-expressions)
expressions
`(pipe
(let ((,arg ,expression))
(,fn ,arg ,#args))
,#more-expressions))))
This would let you write:
(pipe (+ 1000 pi)
(+ arg1 arg1) ; use the previous result multiple times
(+ arg2 (sqrt arg2))) ; use the previous result multiple times

Clojure has a threading operator, ->, which does what you expect:
(-> thing
(thing-operation1 extra-arg1)
(thing-operation2 extra-arg2)
(thing-operation3 extra-arg3))
You can implement this easily as a macro in other Lisp dialects. Greg Hendershott's rackjure library has a ~> form that does the same thing in Racket, for example.
The -> (or ~> in rackjure) macro splices the result in as the first argument of each subform. If you want to splice the result in as the last argument instead, there's a ->> macro (~>> in rackjure).

You might use the PROGN Common Lisp special form.
Or you could define your own Lisp macro to fit your taste.

how about
(reduce (lambda (a b) (funcall b a))
(list thing
(partial-apply op1 arg1)
(partial-apply op2 arg2)
...
(partial-apply opn argn) ))
(in Common Lisp). In Racket,
(foldl (lambda (a b) (a b))
thing (list
(partial-apply op1 arg1)
(partial-apply op2 arg2)
...
(partial-apply opn argn) ))
Regarding terminology, it's either ((curry fun) arg) or (partial-apply fun arg).

Related

Controlling the printing of special cons forms (e.g printing (function +) as #'+ etc)

I want some reader macros to print as as shortened expression that the macro understands. Lets say I want to extend the #' macro to take #'~[rest-of-symbol] and turn that into (complement #'rest-of-symbol).
What controls how that is printed? On SBCL, for instance, '(function +) prints as #'+. How do i make '(complement #'listp) print as #~listp?
My first thought was
(defmethod print-object :around ((obj cons) stream)
;; if #'~fn-name / (complement (function fn-name))
;; => fn-name otherwise NIL
(let ((fn-name
(ignore-errors
(destructuring-bind (complement (function fn-name))
obj
(when (and (eq complement 'complement)
(eq function 'function))
fn-name)))))
(if fn-name
(format stream "#'~~~S" fn-name)
(call-next-method))))
This works insofar as (print-object '(complement #'evenp) *standard-output*) prints it the way I want, but the REPL doesn't. Also (print-object '#'+ *standard-output*) prints it as (function +) so the REPL isn't using print-object. With defining the print-object method for user defined classes the REPL always picks up on the new definition.
This is my first post and I'm sorry I can't get the code to format properly. If someone can put a link on how to do that I would appreciate it.
Evaluation time
You are mixing code with data in your example:
(function +)
Is a special form that evaluates to a function object, which admits a shorter syntax:
#'+
But when you are writing:
'(function +)
or
'(complement fn)
Then in both cases you are writing quoted, literal lists, which evaluates to themselves (namely a list starting with symbol function or complement, followed respectively by symbol + and fn).
However, you want the code to be evaluated at runtime to actual function objects; if you type this in the REPL:
(complement #'alpha-char-p)
The result is a value that is printed as follows:
#<FUNCTION (LAMBDA (&REST SB-IMPL::ARGUMENTS) :IN COMPLEMENT) {101AAC8D9B}>
You have an actual function object that you can funcall. In other words, by the time you reach print-object, you no longer have access to source code, you are manipulating data at runtime which happens to be functions. So you cannot use destructuring-bind to get the complement symbol that was present in the source code.
What you need to do instead is to attach metadata to your function. There is a way to do that in Common Lisp by defining a new type of function, thanks to the Meta-Object Protocol.
Funcallable objects
I'm relying on Closer-MOP for all the symbols prefixed with c2cl: below. I define a new class of functions, annotated-fn, which is a function with addditional data:
(defclass annotated-fn (c2cl:funcallable-standard-object)
((data :initform :data :initarg :data :reader annotated-fn-data))
(:metaclass c2cl:funcallable-standard-class))
Notice that this class is a funcallable-standard-object (like the usual functions), and its metaclass is funcallable-standard-class. Such an object has an additional implicit slot that is a function to call.
More precisely, you have to call c2cl:set-funcallable-instance-function to set a function associated with the object, and when later you use funcall or apply with the object, then the wrapped function is called instead. So you can transparently use this class of functions wherever you usually use a function. It just has additional slots (here data).
For example, here is how I instantiate it, with a function to wrap additional data:
(defun annotate-fn (function data)
(let ((object (make-instance 'annotated-fn :data data)))
(prog1 object
(c2cl:set-funcallable-instance-function object function))))
Let's try it:
(describe
(annotate-fn (constantly 3)
'(:category :constantly)))
#<ANNOTATED-FN {1006275C7B}>
[funcallable-instance]
Lambda-list: UNKNOWN
Derived type: FUNCTION
Documentation:
T
Source file: SYS:SRC;CODE;FUNUTILS.LISP
Slots with :INSTANCE allocation:
DATA = (:CATEGORY :CONSTANTLY)
You can also use this object like any other function.
Now, your reader macros can expand into calls to annotate-fn, and add any kind of additional metadata you need to the function.
Reader macro
For our example, imagine you define a reader macros for constant functions:
(set-macro-character #\[ 'read-constantly t)
(set-macro-character #\] (get-macro-character #\) nil))
(defun read-constantly (stream char)
(declare (ignore char))
(let* ((list (read-delimited-list #\] stream t))
(value (if (rest list) list (first list)))
(var (gensym)))
`(let ((,var ,value))
(annotate-fn (constantly ,var)
(list :category :constantly
:constant ,var)))))
Using this syntax:
> [(+ 8 5)]
=> #<ANNOTATED-FN ...>
By the way, the syntax I defined also allows the following:
> [+ 8 5]
Pretty-printing
Let's define a generic function that prints an annotated function given its :category field:
(defgeneric print-for-category (category data object stream))
(defmethod print-object ((o annotated-fn) s)
(let* ((data (annotated-fn-data o))
(category (getf data :category)))
(print-for-category category data o s)))
Then, we can specialize it for :constantly, and here we assume also that the data associated with the function contains a :constant field:
(defmethod print-for-category ((_ (eql :constantly)) data o s)
(format s "[~s]" (getf data :constant)))
For example:
(let ((value (+ 8 6)))
(annotate-fn (constantly value)
`(:constant ,value
:category :constantly)))
This above is printed as:
[14]
Which would be the same as your hypothetical reader macro.
To do this you need to understand the pretty printer. I have understood it in the past but no longer do completely. It dispatches on type and the trick for things like this is that you can specify very specific types for trees of conses, although doing so is verbose.
Here is an example which is almost certainly not completely correct, but does achieve what you want in this case:
(defparameter *ppd* (copy-pprint-dispatch))
(defun pprint-complement-function (s form)
;; This is the thing that the pretty printer will call. It can
;; assume that the form it wants to print is already correct.
(destructuring-bind (complement (function name)) form
(declare (ignore complement function))
(format s "#'~~~W" name)))
;;; Now set this in the table with a suitable hairy type specification
;;;
(set-pprint-dispatch '(cons (eql complement)
(cons (cons (eql function)
(cons t null))
null))
'pprint-complement-function
0
*ppd*)
And now
> (let ((*print-pprint-dispatch* *ppd*))
(pprint '(complement (function foo)))
(pprint '((complement (function foo)) (function foo))))
#'~foo
(#'~foo #'foo)
You can make the awful nested cons type specifier easier by defining this (which, perhaps, should be the compound type specifier for list except you can't do that):
(deftype list-of-types (&rest types)
(labels ((lot (tt)
(if (null tt)
'null
`(cons ,(first tt) ,(lot (rest tt))))))
(lot types)))
And then
(set-pprint-dispatch '(list-of-types (eql complement)
(list-of-types (eql function)
*))
'pprint-complement-function
0
*ppd*)
is perhaps easier to read.

Adapting readmacros UCI Lisp code to common lisp

I'm trying to make the common lisp equivalent of this UCI Lisp/Interlisp helper function for a pattern mather.
(DRM /? (LAMBDA () (LIST '*VAR* (READ]
The documentation is a follows:
-Variables, which are used by the pattern matcher, start with a question mark ("?"), as in ?FOO.
-This is converted internally to (*VAR* role-name), so ?FOO becomes (*VAR* FOO).
-The DRM defines ? to convert itself to *VAR* when it is read
This is my current implementation of it:
(set-macro-character #\? (lambda () (list '*var* (read))))
But when I ran the match function below:
(match (ptrans (actor ?x) (object ?x) (to (store)))
(ptrans (actor (person)) (object (person)) (to (store))) nil)
I get the following error that's coming from DRM function:
*** - EVAL/APPLY: too many arguments given to :LAMBDA
Is my implementation correct?
Reader macro functions need to take two arguments: one for the stream from which they can read the source code, and one for the character that triggered them to be called. If you change your implementation to
(set-macro-character #\? (lambda (stream char)
(declare (ignore char))
(list '*var* (read stream))))
then any occurrence of ?x will be read as (*VAR* X).
Note that this will be evaluated if used as a function argument, which will cause an error if VAR is not a bound function / macro.
You probably want ?x to be read in as '(*VAR* X) (note the quote) to get the list as data.
In that case you should do this:
(set-macro-character #\? (lambda (stream char)
(declare (ignore char))
(list 'quote
(list '*var* (read stream)))))
to prevent evaluation of the form the reader macro function returns.

Is it foolish to make alexandria:curry not necessarily use funcall?

Currently a function curried with Alexandria's curry must be called with funcall. However it is possible to set the new function's symbol-function so that we can do without it and treat it like a real function. Illustrated on https://lispcookbook.github.io/cl-cookbook/functions.html#with-the-alexandria-library:
(defun adder (foo bar)
"Add the two arguments."
(+ foo bar))
(defvar add-one (alexandria:curry #'adder 1) "Add 1 to the argument.")
(funcall add-one 10) ;; => 11
(setf (symbol-function 'add-one) add-one)
(add-one 10) ;; => 11
;; and still ok with (funcall add-one 10)
Is there a good reason not to allow both styles ? This looks quite interesting to me in this context of currying.
ps: I did ask on Alexandria's issue tracker some 3 weeks ago
pps: https://gitlab.common-lisp.net/alexandria/alexandria/blob/master/functions.lisp#L116
Based on your comment, and looking at the issue, yes it would be "foolish" to change curry so that it binds functions in the global namespace:
This would be a major change for curry, which would break existing code
A macro with this functionality would not mesh well with the spirit of Alexandria, as far as I know. This would be better suited for Serapeum, which happens to already define such a function, namely defalias. As you can see, the definition is a little more involved than using symbol-value. See also the documentation.
For reference, this simple macro does the job:
(defmacro defcurry (name function &rest arguments)
"Returns a regular function, created by currying FUNCTION with ARGUMENTS."
`(let ((closure (alexandria:curry ,function ,#arguments)))
(setf (symbol-function ,name) closure)))
Example:
(defun adder (x y) (+ x y))
(defcurry 'add2 #'adder 2)
(add2 3) ;; no "funcall" here
;; => 5"
edit: but… this is much simpler:
(defun add2 (a)
(adder 2 a))

Testing if a Variable Contains a Function in Common Lisp

I am writing a common lisp program and I have a variable that can contain either a string or a function. I want to call the function if it is one and return that as well as the string. How do I test if a variable is a function?
Code so far:
(defun string-or-function (var)
(if (typep var 'simple-array)
var
(if "Function equivalent of typep goes here."
(setf temp (fn-that-does-something))
(string-or-function temp)
Edit: Code that works:
(defun string-or-function (var)
(let ((s-or-f (type-of var)))
(if (equal s-or-f 'function)
(print "function")
(if (equal (car s-or-f) 'simple-array)
(print "string")))))
Is there a better way to do it?
Common Lisp has a predicative type system. The notion that a value has a "principal" type doesn't make as much sense in Lisp. The type-of function is actually fairly infrequently used, as it makes less sense to ask "What is the type of X" and more sense to ask "Is X of type Y". This can be done with typep, or in your case more concisely with typecase, which is just a case statement for types.
(defun string-or-function (var)
(typecase var
(string (format t "string"))
(function (format t "function"))
(t (format t "something else"))))
I want to call the function if it is one and return that as well as the string.
I think you mean something like this:
(defun evaluate (arg)
"Returns something from evaluating ARG in some manner. If ARG is a string,
return it. If ARG is a function, call it with no arguments and return its
return value(s)."
(ctypecase arg
(string arg)
(function (funcall arg))))
If you need extensibility:
(defgeneric evaluate (arg)
(:documentation "Returns something from evaluating ARG in some manner."))
(defmethod evaluate ((arg string))
arg)
(defmethod evaluate ((arg function))
(funcall arg))
Here are some other ways:
(defun string-or-function-p (x)
(typep x '(or string function)))
...but you can probably also use check-type, which is not a predicate but a check which signals a restartable condition in case the value does not satisfy the type specification:
(check-type place (or string function))
If you happen to use this type a lot, define a custom type:
(deftype string-or-fun () '(or string function))
Of course, you can also use generic functions depending on your needs (silly example):
(defgeneric execute (object)
(:method ((s string)) (eval (read-from-string s)))
(:method ((f function)) (funcall f)))
But note that generic function dispatch on classes, not types, which are different things.
(eq (type-of var) 'function)
However, remember that Common Lisp keeps variables and function names in different namespaces, so (var 1 2 3) and (cons var 1) are looking in two different places. You probably cannot call var like (var), but will rather need to use (funcall var), depending on which namespace this is in.
Basically, you probably shouldn't be stuffing a function-or-maybe-a-string into one variable.

Lisp: How to MAPCAR "#x" over a list of HEX?

Using #x... like below one obtains the decimal of hex value
> #xB1
177
> #xA5
165
> #xFF
255
Say we have a list of hex, what is the correct syntax using mapcar #x... over the list? Below doesn't work:
> (mapcar #'(lambda (hex) `(#x,hex)) '(B1 A5 FF))
Reader error: Malformed number in a #b/#o/#x/#r macro.
[Condition of type SIMPLE-ERROR]
Thanks.
The #x is what's called a "reader macro". It is very similar to using quotations (ie "") to represent strings. They are executed when the code is read/compiled. What you actually want is a procedure which can convert from hexadecimal strings at run time. The procedure you are looking for is parse-integer, which takes a string and returns the value it represents. The mapcar with it should look something like this:
(mapcar (lambda (hex)
(parse-integer hex :radix 16))
'("B1" "A5" "FF"))
Note that this is using strings, if you want to use symbols as in your suggestion you would have to do something like this:
(mapcar (lambda (hex)
(parse-integer (symbol-name hex) :radix 16))
'(B1 A5 FF))
If you don't know the difference between a symbol and a string, I would suggest reading this: What exactly is a symbol in lisp/scheme?
It occurs to me that while the best solution for this problem is probably one using parse-integer as mentioned in malisper's answer, there is a sense in which this could be solved with a mapping based approach.
When we write something like #xB1, we're not explicitly invoking a function. Instead, we're using the fact that # is a dispatching read macro character, and that there's a function installed for the subcharacter x that reads numbers written in hexadecimal. That means that by the time the evaluator or compiler gets a form, the number is already there. However, we do have access to the function that is doing the processing of the hexadecimal string, using get-dispatch-macro-character. Viz.:
CL-USER> (get-dispatch-macro-character #\# #\x)
#<FUNCTION SB-IMPL::SHARP-X> ; in SBCL
CL-USER> (get-dispatch-macro-character #\# #\x)
#<SYSTEM-FUNCTION SYSTEM::HEXADECIMAL-READER> ; in CLISP
What can we do with that function? How would we use it?
2.1.4.4 Macro Characters
… If a character is a dispatching macro character C1, its reader macro
function is a function supplied by the implementation. This function
reads decimal digit characters until a non-digit C2 is read. If any
digits were read, they are converted into a corresponding integer
infix parameter P; otherwise, the infix parameter P is nil. The
terminating non-digit C2 is a character (sometimes called a
``sub-character'' to emphasize its subordinate role in the
dispatching) that is looked up in the dispatch table associated with
the dispatching macro character C1. The reader macro function
associated with the sub-character C2 is invoked with three arguments:
the stream, the sub-character C2, and the infix parameter P. For more
information about dispatch characters, see the function
set-dispatch-macro-character.
That means that when we write something like #xB1, the function above is getting called with a stream from which it can read B1, the character x, and nil. We can try calling that function with arguments like that, although we can't be quite sure what will happen, because implementations might make different assumptions about where the function will be called from.
For instance, this works without a problem in CLISP, but SBCL assumes that the function should be called recursively from read (which we're not doing):
CL-USER> (funcall (get-dispatch-macro-character #\# #\x)
(make-string-input-stream "B1")
#\x
nil)
177 ; in CLISP
CL-USER> (funcall (get-dispatch-macro-character #\# #\x)
(make-string-input-stream "B1")
#\x
nil)
; Evaluation aborted on #<SB-INT:SIMPLE-READER-ERROR "~A was invoked
; with RECURSIVE-P being true outside of a recursive read operation."
; {1005F245B3}>. ; in SBCL
That said, for implementations where this will work, we can easily write a mapcar-like function to extract a dispatch macro character function and map it over some strings. Thus, in an implementation where this works:
(defun map-dispatch-macro-character (disp-char
sub-char
list
&optional (readtable *readtable*))
"Retrieve the dispatch macro character for DISP-CHAR and SUB-CHAR and
map it over the elements in LIST. Each element in LIST is either a
string designator or a two-element list of a string-designator and a
prefix argument."
(flet ((to-list (x)
(if (listp x) x
(list x))))
(let ((fn (get-dispatch-macro-character disp-char sub-char readtable)))
(mapcar (lambda (x)
(destructuring-bind (str &optional prefix) (to-list x)
(with-input-from-string (in (string str))
(funcall fn in sub-char prefix))))
list))))
CL-USER> (map-dispatch-macro-character #\# #\x '(B1 "A5" (FF nil)))
(177 165 255)
And of course, if you really want to be able to write #x, you could of course define a version that just extracts the characters from a string of length two, so that you could do:
CL-USER> (map-dispatch-macro-character* "#x" '(B1 A5 FF))
(177 165 255)

Resources