Is there a more ergonomic way to apply a function to a field in a struct in Elisp?
Say I have the following:
(cl-defstruct stack xs)
(defvar stack (make-stack :xs '(1 2 3 4 5)))
Is there an easy way to apply functions to the :xs field. I'd like an API like this:
(update-field :xs stack (lambda (xs)
(cl-map 'list #'1+ '(1 2 3 4 5))))
Does anyone know if this exists?
Update:
I'm looking for a way to DRY up the calls to (stack-xs stack) (see below). What I'm looking for is more similar to something like Map.update from Elixir.
(setf (stack-xs stack) (cl-map 'list #'1+ (stack-xs stack)))
The cl-defstruct macro creates slot accessors of the form NAME-SLOT where NAME is the struct type name, and SLOT is the slot name. Using your example, you can set the xs slot using setf with the slot accessor like this:
(cl-defstruct stack xs)
(defvar st (make-stack :xs '(1 2 3 4 5)))
(setf (stack-xs st) (cl-map 'list #'1+ (stack-xs st)))
(stack-xs st)
The final line above returns '(2 3 4 5 6).
Update: a downside of the setf call shown above is that the slot accessor has to be used twice, once to read the current value and then again to update it to the new value. You can use cl-callf to DRY it up:
(cl-callf (lambda (p) (cl-map 'list #'1+ p)) (stack-xs st))
Alternatively you could wrap the setf call within a new method defined on the stack type using cl-defmethod, perhaps like this:
(cl-defmethod stack-update ((s stack) f slot)
"Update SLOT in stack S by applying F.
F is passed one argument, the current value of SLOT,
and is expected to return a new value for SLOT."
(let ((sl (if (keywordp slot) (intern (substring (symbol-name slot) 1)) slot)))
(setf (cl-struct-slot-value 'stack sl s) (funcall f (cl-struct-slot-value 'stack sl s)))))
You can then call stack-update like this:
(stack-update st #'(lambda (p) (cl-map 'list #'1+ p)) :xs)
or equivalently:
(stack-update st (apply-partially 'cl-map 'list #'1+) 'xs)
I ended up solving this by writing a macro, struct/update:
(defmacro struct/update (type field f xs)
"Apply F to FIELD in XS, which is a struct of TYPE.
This is immutable."
(let ((copier (->> type
symbol-name
(string/prepend "copy-")
intern))
(accessor (->> field
symbol-name
(string/prepend (string/concat (symbol-name type) "-"))
intern)))
`(let ((copy (,copier ,xs)))
(setf (,accessor copy) (funcall ,f (,accessor copy)))
copy)))
I use this macro as such:
(defun set/add (x xs)
"Add X to set XS."
(struct/update set
xs
(lambda (table)
(let ((table-copy (ht-copy table)))
(ht-set table-copy x 10)
table-copy))
xs))
Which will update the following struct:
(cl-defstruct set xs)
Related
Given a Scheme function returning multiple values, for example:
(exact-integer-sqrt 5) ⇒ 2 1
How can I use only the first returned value, ignoring the other ones?
You can use call-with-values inside macro:
(define-syntax first-val
(syntax-rules ()
((first-val fn)
(car (call-with-values (lambda () fn) list)))))
(first-val (values 1 2 3 4))
(first-val (exact-integer-sqrt 5))
There are also define-values and let-values, if you know number of returned values.
(define-values (x y) (exact-integer-sqrt 5)) ;global
(let-values ([(x y z) (values 1 2 3)]) ;local
x)
Source: R7RS report
Simply use let-values:
(let-values (((root rem) (exact-integer-sqrt 5)))
root)
The above will extract both results in separate variables, and you can choose which one you need.
I am trying to define a function func->symbol that takes a function and returns its name as a symbol. For example:
(define (pythagoras a b)
(sqrt (+ (* a a) (* b b))))
;; #1
(func->symbol pythagoras) ; Returns: 'pythagoras
;; #2
(func->symbol (if #t pythagoras sqrt)) ; Returns: 'pythagoras
;; #3
(let ((f (if #t pythagoras sqrt)))
(func->symbol f)) ; Returns: 'pythagoras
;; #4
(let ((f (if #t pythagoras sqrt)))
(let ((g f))
(func->symbol g))) ; Returns: 'pythagoras
This is a follow-up question on How do I get a definition's name as a symbol? which only deals with case #1. For case #1, a simple macro def->symbol is sufficient:
(define-syntax def->symbol
(syntax-rules ()
((_ def) 'def)))
However, this macro definition does not pass cases #2, #3, #4. Is it possible to define func->symbol, or is Scheme not expressive enough for this?
In Racket, in many cases, you can get a function's name using object-name. But it is probably a bad idea to rely on this result for anything other than debugging.
Perhaps it's worth an answer which shows why this is not possible in any language with first-class functions.
I'll define what I mean by a language having first-class functions (there are varying definitions).
Functions can be passed as arguments to other functions, and returned as values from them.
Functions can be stored in variables and other data structures.
There are anonymous functions, or function literals.
Scheme clearly has first-class functions in this sense. Now consider this code:
(define a #f)
(define b #f)
(let ((f (lambda (x)
(+ x 1))))
(set! a f)
(set! b f))
Let's imagine there is a function-name function, which, given a function, returns its name. What should (function-name a) return?
Well, the answer is that there's simply no useful value it can return (in Racket, (object-name a) returns f, but that's clearly exposing implementation details which might be useful for debugging but would be very misleading as a return value for a function-name procedure.
This is why such a procedure can't exist in general in a language with first-class functions: the function which maps from names to values is many-to-one and thus has no inverse.
Here is an example of the sort of disgusting hack you could do to make this 'work' and also why it's horrible. The following is Racket-specific code:
(define-syntax define/naming
;; Define something in such a way that, if it's a procedure,
;; it gets the right name. This is a horrid hack.
(syntax-rules ()
[(_ (p arg ...) form ...)
(define (p arg ...) form ...)]
[(_ name val)
(define name (let ([p val])
(if (procedure? p)
(procedure-rename p 'name)
p)))]))
And now, given
(define/naming a
(let ([c 0])
(thunk
(begin0
c
(set! c (+ c 1))))))
(define/naming b a)
Then:
> (object-name a)
'a
> (object-name b)
'b
> (eqv? a b)
#f
> (a)
0
> (b)
1
> (a)
2
So a and b have the 'right' names, but because of that they are necessarily not the same object, which I think is semantically wrong: if I see (define a b) then I want (eqv? a b) to be true, I think. But a and b do capture the same lexical state, so that works, at least.
Shortly I have a function foo:
(defun foo (a b &key test)
(format t "~S is the result of my test ~A" (funcall test a b) test))
then the result of the evaluation is:
(foo 12 34 :test #'(lambda (a b) (+ a b)))
46 is the result of my test #<Anonymous Function #x30200171D91F>
and I want
(foo 12 34 :test #'(lambda (a b) (+ a b)))
46 is the result of my test #'(lambda (a b) (+ a b))
Unfortunately, function-lambda-expression does not display any information in CCL.
The point is this is implementation-dependent.
For instance in CCL:
(describe #'(lambda (a b) (+ a b)))
#<Anonymous Function #x302000C49E1F>
Name: NIL
Arglist (analysis): (A B)
Bits: -528481792
Plist: (CCL::FUNCTION-SYMBOL-MAP (#(B A) . #(575 18 49 63 18 49)))
Maybe, I can formulate the question differently. How to save a lambda function as a slot instance in a file in order to retrieve it from any lisp implementation.
Or to be more specific, I would like to set a slot as a non-interpreted function in order to call it to be interpreted as such and have a trace of the 'source'.
My temporary 'solution' is to use explicitly a macro function such as:
(defmacro src (func) `(read-from-string (format nil "~A" ',func)))
(setf (my-slot my-class-object) (src #'(lambda (a b) (* a b))))
;; this stores the un-interpreted function such as
(my-slot my-class-object)
;; return
#'(lambda (a b) (* a b))
;; then I can do
(funcall (my-slot my-class-object) 2 3)
6
The ability to restore the source from a function depends on the implementation and the debug level of your environment. In Common Lisp implementations that compiles code, you need to optimize for debugging to keep track of the source code. Sometimes the source is simply the filename where the function was defined, and an offset.
Named functions
If you want to keep track of functions, it is easier to do portably if you restrict yourself to named functions. Just attach the source code to the property list of the symbol, using a macro:
;; body should be a single form that returns a name, like "defun"
(defmacro with-source-code (&body body)
(destructuring-bind (form) body
(let ((name$ (gensym)))
`(let ((,name$ ,form))
(check-type ,name$ symbol)
(setf (get ,name$ 'source-code) ',form)
,name$))))
;; get the code associated with the name
(defun source-code (name)
(check-type name symbol)
(get name 'source-code))
For example:
(with-source-code
(defun my-test-fn (x y)
(+ x y)))
(source-code 'my-test-fn)
=> (DEFUN MY-TEST-FN (X Y) (+ X Y))
Weak hash tables
Weak references are also implementation dependent, but you can use the trivial-garbage system to use them portably, or be notified when the feature is unavailable.
Here you attach the actual function object to its source code (or, any object, but this is not great for numbers or characters since they are usually not identifiable):
;; defines package "tg"
(ql:quickload :trivial-garbage)
(defparameter *source-map*
(tg:make-weak-hash-table :test #'eq :weakness :key)
"Map objects to their defining forms.")
The weakness is :key so that the garbage collector may remove the entry if the key (the object whose code we want to retrieve) is garbage collected. This should be enough to avoid keeping entries indefinitely.
(defmacro remember (form)
(let ((value$ (gensym)))
`(let ((,value$ ,form))
(setf (gethash ,value$ *source-map*) ',form)
,value$)))
(defun source (object)
(gethash object *source-map*))
For example, you can define a lambda* macro that remembers the anonymous function being defined:
(defmacro lambda* ((&rest args) &body body)
`(remember (lambda ,args ,#body)))
For example:
(let ((fn (lambda* (x y) (+ x y))))
(prog1 (funcall fn 3 4)
(format t "~&Calling ~a" (source fn))))
The above returns 7 and prints Calling (LAMBDA (X Y) (+ X Y))
Metaclass
If you want to avoid weak hash tables, you can also wrap your function in another object, which can act like a function (a funcallable object), using the meta-object protocol.
In that case, you can use closer-mop to have a unified API to work with the Meta-Object Protocol:
(ql:quickload :closer-mop)
You define a subclass of funcallable-standard-object that keep track of the source code, and the function (or closure) being called:
(defclass fn-with-code (c2mop:funcallable-standard-object)
((source :reader source-of :initarg :source))
(:metaclass c2mop:funcallable-standard-class))
The object can be called like any other function, but for that you need to call set-funcallable-instance-function. We can do that after initializing the object, by definining the following method:
(defmethod initialize-instance :after ((f fn-with-code)
&key function &allow-other-keys)
(c2mop:set-funcallable-instance-function f function))
I also define a help function to build such an instance, given a function object and its source code:
(defun make-fn-with-code (function source)
(make-instance 'fn-with-code :source source :function function))
Then, we can rewrite lambda* as follows:
(defmacro lambda* ((&rest args) &body body)
(let ((code `(lambda ,args ,#body)))
`(make-fn-with-code ,code ',code)))
Finally, what is useful with this approach is that the code can be printed automatically when the function is printed, by defining a method for print-object:
(defmethod print-object ((o fn-with-code) stream)
(print-unreadable-object (o stream :type nil :identity nil)
(format stream "FUN ~a" (source-of o))))
> (lambda* (x y) (* x y))
#<FUN (LAMBDA (X Y) (* X Y))> ;; << printed as follow
You are nearly there with a macro. If you merge "foo" and "format-function" into one macro:
(defmacro format-result (a b &key test)
`(format t "~S is the result of my test ~A"
(funcall ,test ,a ,b) ',test))
so:
(FORMAT-RESULT 1 2 :test (lambda (a b) (+ a b)))
3 is the result of my test (LAMBDA (A B) (+ A B))
(FORMAT-RESULT 1 2 :test #'+)
3 is the result of my test #'+
Is there a simple way to make it if i wanted to run several test on that one argument to do so? Like ‘(add1 list? number? square) 3) and get (4 #f #t 9)?
(define (construct(functList argv))
Use map over the function list, applying each one to the value:
(define (f-map fns v)
(map (lambda (f) (f v)) fns))
> (f-map (list add1 list? number?) 3)
'(4 #f #t)
I like to learn a new language by making small tool like calculator.
Although I already searched a lot idiomatic examples about specific cases(such as idiomatic usage of array and list), I have no idea how to put those together to write this small calculator in an idiomatic way.
So here is my code:
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn clean-stk [stk]
(loop [stk stk]
(if (> (count (:opt stk)) 1)
(recur (calc-once stk))
(peek (:num stk)))))
(defn calc
"A simple calculator"
[s]
(clean-stk
(reduce
(fn [stk item]
(let [item (read-string item)
operators #{'+ '- '* '/}
prio {'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2}
add-to-num #(assoc %1 :num (conj (:num %1) %2))
add-to-opt #(assoc %1 :opt (conj (:opt %1) %2))
item-prio (get prio item)
last-prio #(get prio (peek (:opt %)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(loop [stk stk]
(if (<= item-prio (last-prio stk))
(recur (calc-once stk))
(add-to-opt stk item)))
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(loop [stk stk]
(if (not= (peek (:opt stk)) 'l)
(recur (calc-once stk))
(assoc stk :opt (pop (:opt stk)))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))))
After calling it:
(calc (pre-process (read-line))))
It can calculate like:
(1 + 3) * ( 4 + 4)
32
I think my code could be improved by
eliminating those cond
or
try to make the {:num '() :opt '()} into a more accessible data
structure
, but I have no idea.
Hopefully someone can give me some suggestions or point out problems with my code (or the grammers of my question :P).
====================================Thank you :)================================
Thank you guys for help. I modified my code, it seems better now. But I still have some questions:
Should I put some less generic functions (such as add-to-num) into global var?
Does anybody discover that sometimes naming a function in FP is pretty hard? Especially for those non-generic functions.
And here is my new code:
(def prio
{'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2})
(def operators #{'+ '- '* '/})
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn process-stk [stk checker fn-ret]
(loop [stk stk]
(if (checker stk)
(recur (calc-once stk))
(fn-ret stk))))
(defn calc
"A simple calculator"
[s]
(process-stk
(reduce
(fn [stk item]
(let [item (read-string item)
add-to-num #(assoc %1 :num (conj (:num %1) %2))
add-to-opt #(assoc %1 :opt (conj (:opt %1) %2))
item-prio (get prio item)
last-prio #(get prio (peek (:opt %)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk #(<= item-prio (last-prio %))
#(add-to-opt % item))
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk #(not= (peek (:opt %)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
#(> (count (:opt %)) 1)
#(peek (:num %))))
This cries out for a macro solution, given below. I did cheat in that there are only 2 precedence levels so I didn't have to work out a stack to keep track of precedence. This solution could be generalized but it take a little more doing.
The trick to remember about macros in clojure is they take clojure structure (which is a nested list of lists) and return a different list of lists. The calc macro simply takes the input, wraps it in parens and passes it to the clojure reader which does all the heavy lifting of parsing the input string into a list of symbols.
Then the reorder-equation function turns the infix into a prefix order list. That list is returned by the macro and is then evaluated as clojure code.
The check for * and / makes sure they get evaluated first. To see what it does try
(reorder-equation '((1 + 3) * (4 + 4)))
=> (* (+ 1 3) (+ 4 4))
As you can see it takes the equations and rewrites it into a valid clojure expression which will then be evaluated.
This may seem like cheating but as you get more familiar with Clojure you will realize that you can let the language do a lot of the heavy lifting. Parsing input into a list of symbols and using those symbols as function names make perfect sense. As a matter of fact, any function that takes two arguments is valid in our calculator:
(calc "(1 + 3) < (4 + 4)")
=> true
and
(calc "(1 + 3) str (4 + 4)")
=> "48"
The code:
(defn reorder-equation [ arg ]
(if (seq? arg)
(let [[f s & r] arg
f (reorder-equation f)]
(cond
(#{"*" "/"} (str s)) ( let [[t ft & r2 ] r
t (reorder-equation t)]
(if ft
(list ft (list s f t) (reorder-equation r2))
(list s f t)))
(nil? s) f
:else (list s f (reorder-equation r))))
arg))
(defmacro calc [inp]
(let [tr (read-string (str "(" inp ")"))]
(reorder-equation tr)))
It is the correct version of the M Smith's solution, although I used eval in my code, which is generally a bad idea. I paste it here and hope it can help someone.
(defn calc [ arg ]
(if (seq? arg)
(let [[f s & r] arg
f (calc f)]
(if (nil? s)
f
(let [[t ft & r2 ] r
t (calc t)
new-f ((resolve s) f t)]
(cond
(#{"*" "/"} (str s))
(if ft
(calc (concat `(~new-f) (rest r)))
new-f)
(nil? s) f
:else
(if (#{"+" "/"} (str ft))
(calc (concat `(~new-f) (rest r)))
((resolve s) f (calc r)))))))
arg))
(defn main [inp]
(let [tr (read-string (str "(" inp ")"))]
(calc tr)))
Example:
(println (main "2 - 4 + 8 * 16"))
(println (main "(1 + 2) * (10 - 4) / 9 * 6"))
(println (main "10 + 2 * 100 / ((40 - 37) * 100 * (2 - 4 + 8 * 16))"))
Result:
126
12
1891/189
Here is my solution, which does not use regex or macros, and which instead uses partition and reduce for its parsing logic.
The general idea is that you treat the user input as a sequence of symbol pairs after the initial value. So your arithmetic expression is essentially '(<init-value> (op1 value1) (op2 value2) ...(opN valueN)) Of course, the <init-value> could itself be a parenthetical, and if so must first be reduced as well.
partition then provides the sequence of symbol/value pairs to reduce, which constructs a valid Clojure expression with symbols arranged by precedence. I halt evaluation on invalid symbols (anything not a number list or symbol), exiting the reduce block with the handy reduced (added in 1.5).
An important concept is that any lists (parenthesis) encountered ultimately reduce to values, and so are recursively reduce-d. The function peel handles nested lists, i.e. (((1 + 1)))
It a little verbose (I prefer descriptive variable names), but it's correct. I checked several rather complex nested expressions against Google.
(def instructions
(str "Please enter an arithmetic expression separated by spaces.\n"
"i.e. 1 + 2 / 3 * 4"))
(defn- error
([] (error instructions))
([msg] (str "ERROR: " (if (nil? msg)
instructions
msg))))
(def ^{:private true} operators {'* 1
'/ 1
'+ 0
'- 0})
(def ^{:private true} operator? (set (keys operators)))
(defn- higher-precedence? [leftop rightop]
(< (operators leftop) (operators rightop)))
(declare parse-expr)
(defn- peel
"Remove all outer lists until you reach
a list that contains more than one value."
[expr]
(if (and (list? expr) (= 1 (count expr)))
(recur (first expr))
expr))
(defn- read-value [e]
(if (list? e)
(parse-expr (peel e))
(if (number? e) e)))
(defn- valid-expr? [op right]
(and (operator? op)
(or (number? right) (list? right))))
(defn- higher-precedence-concat [left op right]
(let [right-value (read-value right)
last-left-value (last left)
other-left-values (drop-last left)]
(concat other-left-values `((~op ~last-left-value ~right-value)))))
(defn- parse-expr [s]
(let [left (read-value (first s))
exprs (partition 2 (rest s))
[[op right] & _] exprs]
(if (and left (valid-expr? op left))
(let [right (read-value right)]
(reduce (fn [left [op right]]
(if (valid-expr? op right)
(if (higher-precedence? (first left) op)
(higher-precedence-concat left op right)
(list op left (read-value right)))
(reduced nil)))
(list op left right) (rest exprs))))))
(defn calc [input]
(try
(let [expr (-> (str "(" input ")")
read-string ;; TODO: use tools.reader?
peel)]
(if (list? expr)
(if-let [result (eval (parse-expr expr))]
result
(error))
(error)))
(catch java.lang.RuntimeException ex
(error (.getMessage ex)))))
Example checked against google's online calculator:
(calc "10 + 2 * 100 / ((40 - 37) * 100 * (2 - 4 + 8 * 16))")
=> 1891/189
(double *1)
=> 10.00529100529101
Two limitations: expressions must be space delimited (i.e. 1+2-3 not supported) just like Incanter's infix mathematics, and because I use read-string the user input can have trailing parens (I consider this a bug I'll have to fix with a more robust REPL implementation).
Credits: I used Eric Robert's Programming Abstractions in C (Addison Wesley, 1997) as a reference in coding the above. Chapter 14 "Expression Trees" describes an almost identical problem.
I'll try it out, but I can't get your code to work, so it's a bit hard for me to understand what is happening in every place. Basically, the following is a guess and not intended to be a complete answer. Hopefully someone can come in and edit this down a bit and get it to function correctly.
I'll start with the basic premise: You have, in my opinion, way to many nested and anonymous functions. Everywhere you see a #(xyz) could probably be pulled out into its own function. I'm pretty sure having function inside of function inside of function would be pretty bad form in any programming language, and I feel it is bad form here. I began by removing anon functions, both hashed and the (fn) you have in your original code.
I also don't like nesting functions in my let-bindings.
(def prio
{'+ 0 ; Define operator priority here
'- 0
'* 1
'/ 1
'l -1
'r -1
'dummy -2})
(def operators #{'+ '- '* '/})
(defn pre-process [s]
"Seperate operands with operators and replace ( with l, ) with r"
(re-seq #"\d+|[\+\-\*\/lr]"
(clojure.string/replace s #"\(|\)" {"(" "l" ")" "r"})))
(defn calc-once [stk]
"Take one operator from operator stack and apply it to
top two numbers in operand stack"
(let [opt (:opt stk)
num (:num stk)
tmp-num (pop (pop num))
tmp-opt (pop opt)
last-two-num [(peek (pop num)) (peek num)]
last-opt (peek opt)]
(assoc stk
:num (conj tmp-num (apply (eval last-opt) last-two-num))
:opt tmp-opt)))
(defn process-stk [stk checker fn-ret]
(loop [stk stk]
(if (checker stk)
(recur (calc-once stk))
(fn-ret stk))))
(defn assoc-to-item [item]
#(assoc %1 item (conj (item %1) %2)))
(defn priority [item]
(get prio item))
(defn create-checker [op item v]
(op item v))
(defn pre-calc [stk item s]
(reduce
(let [item (read-string item)
add-to-num (assoc-to-item :num)
add-to-opt (assoc-to-item :opt)
item-prio (priority item)
last-prio (priority (last (:opt)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk
(create-checker <= item-prio (last-prio))
add-to-opt)
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk
(create-checker not= (peek (:opt)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
(defn calc [s]
"A simple calculator"
(process-stk (pre-calc stk item s)
#(> (count (:opt %)) 1)
#(peek (:num %))))
Further notes:
(peek) is very ambiguous and I generally don't like using it. From the cheatsheets:
For a list or queue, same as first, for a vector, same as, but much
more efficient than, last. If the collection is empty, returns nil.
Since I'm not entirely sure what structure you are working with at all times (I think its a vec?) and you do, you may want to use last or first, which ever is more appropriate. Although it is "much more efficient" than last, it's not helping me understand how the program works, so use peek in the finished product but not the shared product (mind you don't really need super speed for this either).
I also think that the (cond) should be unambiguously case-tested.
I attempted to make it a tad more "idiomatic" by making sure the args are less ambiguous. In your original code, you are passing in massive functions (and the results of nested functions) as one large argument to another function. Breaking all of that down to smaller functions is where you need to work more a bit. Notice how it is more clear what is happening in the calc function?
I pulled out the anon function inside calc and entered into a function called pre-calc. I would still suggest pulling out the anon functions from calc and work on clarifying what is happening inside of pre-calc. It is still hard to read because I can't really guess what is happening.
I would suggest starting with something like the following because it is hard to see what args are passed into (reduce). You can see how this is confusing because I am passing item in as an argument then I am following your pattern and passing item into (read-string) and then I am binding that result to item. I'm not sure if this is your intent, but I most certainly would not pass in an arg called let and them bind the result of passing it into a function created by evaluating item. This creates further confusion for me because you have item passed into a let-bound item-prio. I never did this, so I don't even know if the arg item or the let-bound item is being evaluated here.
Here is that part of the code. Notice how it is easy to see what is being reduced now?
(defn stack-binding [item]
(let [item (read-string item)
add-to-num (assoc-to-item :num)
add-to-opt (assoc-to-item :opt)
item-prio (priority item)
last-prio (priority (last (:opt)))]
(cond
(number? item) ; It's number
(add-to-num stk item)
(get operators item) ; It's operator
(process-stk stk
(create-checker <= item-prio (last-prio))
add-to-opt)
(= 'l item) ; (
(add-to-opt stk item)
(= 'r item) ; )
(process-stk stk
(create-checker not= (peek (:opt)) 'l)
#(assoc % :opt (pop (:opt %))))
:else
(println "Unexpected syntax: " item))))
(defn pre-calc [stk item s]
(reduce (stack-binding item)
(apply (partial list {:num '() :opt '(dummy)}) ;; Basic structure of stack
s))
There is a lot more I could write, but as I said, I really don't know how everything is working together. Regardless, this should at least show some of the logic I would use in creating this program. I would try to generalize this a lot more and keep it so that each function is only about 10 LOC each.
As I said, I hope others can either expand on this or edit it to something more palatable.
The smallest idiomatic calculator is the REPL!
If infix notation is the goal, I'd go for changing the reader so that numbers become functions of the arithmetic functions *,/,+,-,% etc, so (7 + 5) would be read as 7, being a Clojure function (in addition to being a java.lang.Number), can take + 5 as arguments, similar to how, in Smalltalk, numbers can understand arithmetic operations as messages.