Suppose I have a simple string that I want to parse into array of string:
"add (multiply (add 1 2) (add 3 4)) (add 5 6)"
How do I parse it into 3 strings (based on outer parentheses):
add
(multiply (add 1 2) (add 3 4))
(add 5 6)
With my OOP mind, I think I need a for loop index and if else statement to do this.
I have tried parse it with string split, however I got:
command
(multiply
1
(add
3
2))
(add
3
4)
which is not what I expected
since your data elements are already in the well formed polish notation, you can simply read it as edn, and operate on the clojure's data structures:
(def s "add (multiply (add 1 2) (add 3 4)) (add 5 6)")
(map str (clojure.edn/read-string (str "(" s ")")))
;;=> ("add" "(multiply (add 1 2) (add 3 4))" "(add 5 6)")
i'm still unaware of your end goal, but this seems to fulfill the asked one.
Either you can use the build-in LispReader
(import '[clojure.lang LispReader LineNumberingPushbackReader])
(import '[java.io PushbackReader StringReader])
(defn could-read? [pr]
(try
(LispReader/read pr nil)
true
(catch RuntimeException e false)))
(defn paren-split2 [s]
(let [sr (StringReader. s)
pr (LineNumberingPushbackReader. sr)
inds (loop [result [0]]
(if (could-read? pr)
(recur (conj result (.getColumnNumber pr)))
result))
len (count s)
bounds (partition 2 1 inds)]
(for [[l u] bounds
:let [result (clojure.string/trim (subs s l (min len u)))] :when (seq result)]
result)))
(paren-split2 "add ( multiply ( add 1 2) (add 3 4)) (add 5 6 )")
;; => ("add" "( multiply ( add 1 2) (add 3 4))" "(add 5 6 )")
or you can hand-code a parser:
(def conj-non-empty ((remove empty?) conj))
(defn acc-paren-split [{:keys [dst depth current] :as state} c]
(case c
\( (-> state
(update :depth inc)
(update :current str c))
\) (if (= 1 depth)
{:depth 0 :dst (conj-non-empty dst (str current c)) :current ""}
(-> state
(update :depth dec)
(update :current str c)))
\space (if (zero? depth)
{:depth 0 :dst (conj-non-empty dst current) :current ""}
(update state :current str c))
(update state :current str c)))
(defn paren-split [s]
(:dst (reduce acc-paren-split
{:dst []
:depth 0
:current ""}
s)))
(paren-split "add ( multiply ( add 1 2) (add 3 4)) (add 5 6 )")
;; => ["add" "( multiply ( add 1 2) (add 3 4))" "(add 5 6 )"]
Note: Either approach will preserve spaces in the input strings.
You could use read-string from clojure core to use the built-in reader of clojure. Here we read-in, use str to generated of the read-in chunk a string
and subtract it from the string, clojure.string/trim the ends then, to start the cycle anew, until after trimming an empty string occurs.
Then, the collected result is returned.
(defn pre-parse [s]
(loop [s s
acc []]
(if (zero? (count s))
acc
(let* [chunk (read-string s)
s_ (str chunk)
rest-s (clojure.string/trim (subs s (count s_)))]
(recur rest-s (conj acc s_))))))
recure takes its arguments, and calls loop on it with the arguments given in the order as loop takes them.
We can test it with:
(def x "add (multiply (add 1 2) (add 3 4)) (add 5 6)")
(pre-parse x)
;; => ["add" "(multiply (add 1 2) (add 3 4))" "(add 5 6)"]
Simple program for binary search.
elements contain no. of elements
then array contains those elements
then q contains no. of queries
search contains element to be searched.
Why this error is coming about high and low has no value after some iterations.
Kindly help :)
My Code :-
(setf elements (parse-integer (read-line)))
(setf array (make-array elements :fill-pointer 0))
(dotimes (i elements) (vector-push (parse-integer (read-line)) array))
(setf q (parse-integer (read-line)))
(defvar *mid*)
(dotimes (i q)
(setf search (parse-integer (read-line)))
(do ((low 0)
(high (- elements 1))
(mid (floor (+ low high) 2)
(floor (+ low high) 2)))
((>= low high) (setf *mid* nil))
(cond
((eql (elt array mid) search) (setf *mid* mid))
((< (elt array mid) search) (setf high (- mid 1)))
(t (setf low (+ mid 1)))))
(format t "~a" *mid*))
Your code is a fine example of an old adage:
the determined Real Programmer can write FORTRAN programs in any language.
Unfortunately Lisp programmers are generally quiche-eating hippies: so here is one quiche-eater's solution to this problem, using notions not present when FORTRAN IV was handed down to us from above on punched stones. These notions are therefore clearly heretical, but nonetheless useful.
Assuming this is homework, you probably will not be able to submit this answer.
Reading the data
First of all we'll write some functions which read the specification of the problem from a stream or file. I have inferred what it is from your code.
(defun stream->search-spec (stream)
;; Read a search vector from a stream: return a vector to be searched
;; and a vector of elements to search for.
;;
;; This function defines what is in files: each line contains an
;; integer, and the file contains a count followed by that many
;; lines, which specifies first the vector to be searched, and then
;; the things to search for.
;;
;; This relies on PARSE-INTEGER & READ-LINE to puke appropriately.
(flet ((read-vector ()
(let* ((elts (parse-integer (read-line stream)))
(vec (make-array elts :element-type 'integer))) ;won't help
(dotimes (i elts vec)
(setf (aref vec i) (parse-integer (read-line stream)))))))
(values (read-vector) (read-vector))))
(defun file->search-spec (file)
;; Read a search vector from a file. This is unused below but is
;; useful to have.
(with-open-file (in file)
(stream->search-spec in)))
(defun validate-sorted-vector (v)
;; check that V is a sorted vector
(dotimes (i (- (length v) 1) v)
(unless (<= (aref v i) (aref v (1+ i)))
(return-from validate-sorted-vector nil))))
The last function is used below to sanity check the data, since the search algorithm assumes the vector is sorted.
The search function
This implements binary search in the same way yours tries to do. Rather than doing it with loops and explicit assignemnt it does it using a local recursive function, which is far easier to understand. There are also various sanity checks and optionally debugging output. In any implementation which optimises tail calls this will be optimised to a loop; in implementations which don't then there will be a few extra function calls but stack overflow problems are very unlikely (think about why: how big would the vector need to be?).
(defun search-sorted-vector-for (vector for &key (debug nil))
;; search a sorted vector for some value. If DEBUG is true then
;; print what we're doing. Return the index, or NIL if FOR is not
;; present.
(when debug
(format *debug-io* "~&* ~D:~%" for))
(labels ((search (low mid high)
(when debug
(format *debug-io* "~& ~10D ~10D ~10D~%" low mid high))
(if (<= low mid high)
;; more to do
(let ((candidate (aref vector mid)))
(cond ((= candidate for)
;; found it
mid)
((< candidate for)
;; look higher
(search (1+ mid) (floor (+ high mid 1) 2) high))
((> candidate for)
;; look lower
(search low (floor (+ low mid) 2) (1- mid)))
(t
;; can't happen
(error "mutant death"))))
;; low = high: failed
nil)))
(let ((high (1- (length vector))))
(search 0 (floor high 2) high))))
Putting the previous two things together.
search-sorted-vector-with-search-vector will repeatedly search using the two vectors that the *->search-spec functions return. stream->search-results uses stream->search-spec and then calls this on its values. file->search-results does it all from a file.
(defun search-sorted-vector-with-search-vector (vector searches &key (debug nil))
;; do a bunch of searches, returning a vector of results.
(let ((results (make-array (length searches))))
(dotimes (i (length searches) results)
(setf (aref results i) (search-sorted-vector vector (aref searches i)
:debug debug)))))
(defun stream->search-results (stream &key (debug nil))
;; Read search specs from a stream, and search according to them.
;; Return the vector of results, the vector being searched and the
;; vector of search specifications.
(multiple-value-bind (to-search search-specs) (stream->search-spec stream)
(when debug
(format *debug-io* "~&searching ~S~% for ~S~&" to-search search-specs))
(assert (validate-sorted-vector to-search) (to-search) "not sorted")
(values (search-sorted-vector-with-search-vector to-search search-specs
:debug debug)
to-search search-specs)))
(defun file->search-results (file &key (debug nil))
;; sort from a file
(with-open-file (in file)
(stream->search-results in :debug debug)))
Using it
Given a file /tmp/x.dat with:
9
1
10
100
101
102
103
200
201
400
6
10
102
200
1
400
99
then:
> (file->search-results "/tmp/x.dat" :debug t)
searching #(1 10 100 101 102 103 200 201 400)
for #(10 102 200 1 400 99)
* 10:
0 4 8
0 2 3
0 1 1
* 102:
0 4 8
* 200:
0 4 8
5 6 8
* 1:
0 4 8
0 2 3
0 1 1
0 0 0
* 400:
0 4 8
5 6 8
7 7 8
8 8 8
* 99:
0 4 8
0 2 3
0 1 1
2 1 1
#(1 4 6 0 8 nil)
#(1 10 100 101 102 103 200 201 400)
#(10 102 200 1 400 99)
You can see that the last search failed (99 is not in the vector).
Why is it not possible to push directly on a list like '(1 2 3) or NIL?
Specifically:
Why is possible to do
> (let ((some-list nil))
(push 42 some-list))
(42)
but not to do something like
(push 42 nil)
or
(push 42 '(1 2 3))
What is the reasoning behind this implementation?
With macro push the second argument needs to be a place to be modified. Here are some examples:
Lets make two variables:
(defparameter *v* (list 2 4))
(defparameter *v-copy* *v*)
Then we push 0
(push 1 *v*) ; ==> (1 2 4)
*v-copy* ; ==> (2 4) (unaltered)
; the reason is that the variable is changed, not its value
(macroexpand '(push 1 v))
; ==> (setq v (cons 1 v))
push can use other things as second argument. Lets try a cons
(push 3 (cdr *v-copy*))
*v-copy* ; ==> (2 3 4)
; since the tail of *v* is the *v-copy* *v* is changed too
*v* ; ==> (1 2 3 4)
(macroexpand-1 '(push 2 (cdr *v-copy*)))
; ==> (rplacd v (cons 2 (cdr *v-copy*)))
If your examples were valid, what should it really have done? Lets do the nil first:
(macroexpand '(push 42 nil))
; ==> (setq nil (cons 42 nil))
This treats nil just as any other variable and if this worked nil would never be the empty list again. It would have been a list with one element, 42 and a different value than (). In Common Lisp nil is a constant and cannot be mutated. I've created a lisp once where nil was a variable like any other and a small typo redefined nil making the programs behave strange with no apparent reason.
Lets try your literal quoted list.
(macroexpand '(push 42 (quote (1 2 3))))
; ==> (let ((tmp (1 2 3)))
; (funcall #'(setf quote) (cons 42 'tmp) tmp))
It doesn't seem the push macro differentiates between special form quote and those types that has set their setf function. It won't work and it doesn't make sense. Anyway in the same manner as mutating the binding nil if this changed the literal data '(1 2 3) to '(43 1 2 3) would you then expect to get (43 1 2 3) every time you evaluated (1 2 3) from there on? I imagine that would be the only true effect of mutating a constant. If this was allowed you should be allowed to redefine 4 to be 5 so that evaluating 4 or (+ 2 2) shows the result 5.
Suppose one introduces variables in a fresh Common Lisp
at the REPL and one types: (setq q 2).
I understand from these columns that this variable q is
not defined following the Common Lisp standard and
depends upon the implementation.
My question is: what is the easiest way or test to be
sure what it is exactly?
I read in one source that q is then automatically an implicitly defined
global dynamic variable and is then equivalent to
(defpar q 2).
In relation with this question. Seasoned Lisp
programmers talk much about the symbol tables. I do
not find in e.g. Seibel how to find out what is in
those tables. Can one access these tables? Do
debuggers support accessing these tables in a non
standard way?
Using SETQ rather than DEFPARAMETER is likely to make a global variable, but not a special variable. That will cause annoying debugging later. Don't use SETQ to define variables.
An example with lengthy code snippets. I'm using non-standard SBCL for this.
Let's define a package with two variables, one defined with DEFPARAMETER and one set with SETQ.
CL-USER> (defpackage :foo (:use :cl))
#<PACKAGE "FOO">
CL-USER> (in-package :foo)
#<PACKAGE "FOO">
FOO> (defparameter q 2)
Q
FOO> (setq w 2)
; in: SETQ W
; (SETQ FOO::W 2)
;
; caught WARNING:
; undefined variable: W
;
; compilation unit finished
; Undefined variable:
; W
; caught 1 WARNING condition
2 (2 bits, #x2, #o2, #b10)
FOO> q
2 (2 bits, #x2, #o2, #b10)
FOO> w
2 (2 bits, #x2, #o2, #b10)
The warning message already tells us that SBCL doesn't like the SETQ option, but the variable seems to work. Let's try to DESCRIBE the variables:
FOO> (describe 'q)
FOO::Q
[symbol]
Q names a special variable:
Value: 2
; No values
FOO> (describe 'w)
FOO::W
[symbol]
W names an undefined variable:
Value: 2
; No values
This says that Q is a special variable, while W is an undefined variable.
FOO> (sb-cltl2:variable-information 'q)
:SPECIAL
NIL
NIL
FOO> (sb-cltl2:variable-information 'w)
NIL
NIL
NIL
This also confirms that W is not a special variable like Q is. So what does this mean? Let's define a function that uses those variables:
FOO> (defun foobar ()
(format t "~&Q: ~a~%W: ~a~%" q w))
; in: DEFUN FOOBAR
; (FORMAT T "~&Q: ~a~%W: ~a~%" FOO::Q FOO::W)
;
; caught WARNING:
; undefined variable: W
;
; compilation unit finished
; Undefined variable:
; W
; caught 1 WARNING condition
FOOBAR
FOO> (foobar)
Q: 2
W: 2
NIL
Again we get warnings about W, but the code still seems to work. Let's try to shadow the variables.
FOO> (defun quux ()
(let ((q 100)
(w 100))
(foobar)))
; in: DEFUN QUUX
; (LET ((FOO::Q 100) (FOO::W 100))
; (FOO::FOOBAR))
;
; caught STYLE-WARNING:
; The variable W is defined but never used.
;
; compilation unit finished
; caught 1 STYLE-WARNING condition
QUUX
FOO> (quux)
Q: 100
W: 2
NIL
Now we notice that since W is not special, you can't shadow it. Also
FOO> (sb-introspect:who-binds 'q)
((QUUX
. #S(SB-INTROSPECT:DEFINITION-SOURCE
:PATHNAME NIL
:FORM-PATH (0 3 2)
:FORM-NUMBER 0
:CHARACTER-OFFSET 0
:FILE-WRITE-DATE NIL
:PLIST NIL
:DESCRIPTION NIL)))
FOO> (sb-introspect:who-binds 'w)
NIL
We can't see who binds the variable. Or who sets either:
FOO> (defun qwerty ()
(setf w 1000
q 1000))
; in: DEFUN QWERTY
; (SETF FOO::W 1000
; FOO::Q 1000)
; --> PROGN SETF
; ==>
; (SETQ FOO::W 1000)
;
; caught WARNING:
; undefined variable: W
;
; compilation unit finished
; Undefined variable:
; W
; caught 1 WARNING condition
QWERTY
FOO> (qwerty)
1000 (10 bits, #x3E8)
FOO> (sb-introspect:who-sets 'q)
((QWERTY
. #S(SB-INTROSPECT:DEFINITION-SOURCE
:PATHNAME NIL
:FORM-PATH (0 3 2)
:FORM-NUMBER 0
:CHARACTER-OFFSET 0
:FILE-WRITE-DATE NIL
:PLIST NIL
:DESCRIPTION NIL)))
FOO> (sb-introspect:who-sets 'w)
NIL
Since you also asked about symbol tables, the easiest way to see what's in it is to INSPECT a package. You can do that with your IDE (in Slime C-c I) or by calling the function directly:
FOO> (inspect (find-package :foo))
The object is a STRUCTURE-OBJECT of type PACKAGE.
0. %NAME: "FOO"
1. %NICKNAMES: NIL
2. %USE-LIST: (#<PACKAGE "COMMON-LISP">)
3. TABLES: #(#<SB-INT:PACKAGE-HASHTABLE
(978+0)/1973 [2.270 words/sym,load=49.6%] {100001A483}>)
4. MRU-TABLE-INDEX: 0
5. %USED-BY-LIST: NIL
6. INTERNAL-SYMBOLS: #<SB-INT:PACKAGE-HASHTABLE (7+0)/17 [2.732 words/sym,load=41.2%] {1006D60AE3}>
7. EXTERNAL-SYMBOLS: #<SB-INT:PACKAGE-HASHTABLE (0+0)/3 [load=0.0%] {1006D60B13}>
8. %SHADOWING-SYMBOLS: NIL
9. DOC-STRING: NIL
10. LOCK: NIL
11. %IMPLEMENTATION-PACKAGES: (#<PACKAGE "FOO">)
12. SOURCE-LOCATION: #S(SB-C:DEFINITION-SOURCE-LOCATION
:NAMESTRING NIL
:TOPLEVEL-FORM-NUMBER NIL
:FORM-NUMBER NIL
:PLIST NIL)
13. %LOCAL-NICKNAMES: NIL
14. %LOCALLY-NICKNAMED-BY: NIL
> 6
The object is a STRUCTURE-OBJECT of type SB-INT:PACKAGE-HASHTABLE.
0. CELLS: #(FOOBAR 0 QUUX ? 0 0 0 E W 0 Q QWERTY 0 0 0 0 0
#(21 0 98 59 0 0 0 223 135 0 193 37 0 0 0 0 0))
1. SIZE: 12
2. FREE: 5
3. DELETED: 0
> 0
The object is a VECTOR of length 18.
0. FOOBAR
1. 0
2. QUUX
3. ?
4. 0
5. 0
6. 0
7. E
8. W
9. 0
10. Q
11. QWERTY
12. 0
13. 0
14. 0
15. 0
16. 0
17. #(21 0 98 59 0 0 0 223 135 0 193 37 0 0 0 0 0)
> 8
The object is a SYMBOL.
0. Name: "W"
1. Package: #<PACKAGE "FOO">
2. Value: 1000
3. Function: "unbound"
4. Plist: NIL
> u
The object is a VECTOR of length 18.
0. FOOBAR
1. 0
2. QUUX
3. ?
4. 0
5. 0
6. 0
7. E
8. W
9. 0
10. Q
11. QWERTY
12. U
13. 0
14. 0
15. 0
16. 0
17. #(21 0 98 59 0 0 0 223 135 0 193 37 201 0 0 0 0)
> 10
The object is a SYMBOL.
0. Name: "Q"
1. Package: #<PACKAGE "FOO">
2. Value: 1000
3. Function: "unbound"
4. Plist: NIL
> q
You could also use DO-SYMBOLS to loop over symbols in a package.
FOO> (do-symbols (symbol)
(when (and (boundp symbol)
(eq (symbol-package symbol) *package*))
(format t "~&~a~% Value: ~a~% Info: ~a~% Who sets: ~a~% ~
Who binds: ~a~% Plist: ~a~% Documentation: ~a~%~%"
symbol
(symbol-value symbol)
(multiple-value-list
(sb-cltl2:variable-information symbol))
(sb-introspect:who-sets symbol)
(sb-introspect:who-binds symbol)
(symbol-plist symbol)
(documentation symbol 'variable))))
Q
Value: 1000
Info: (SPECIAL NIL NIL)
Who sets: ((QWERTY
. #S(SB-INTROSPECT:DEFINITION-SOURCE
:PATHNAME NIL
:FORM-PATH (0 3 2)
:FORM-NUMBER 0
:CHARACTER-OFFSET 0
:FILE-WRITE-DATE NIL
:PLIST NIL
:DESCRIPTION NIL)))
Who binds: ((QUUX
. #S(SB-INTROSPECT:DEFINITION-SOURCE
:PATHNAME NIL
:FORM-PATH (0 3 2)
:FORM-NUMBER 0
:CHARACTER-OFFSET 0
:FILE-WRITE-DATE NIL
:PLIST NIL
:DESCRIPTION NIL)))
Plist: NIL
Documentation: NIL
W
Value: 1000
Info: (NIL NIL NIL)
Who sets: NIL
Who binds: NIL
Plist: NIL
Documentation: NIL
I need to have the result in correct order. It works for numbers less than 100 only.
(base8 8) gives (1 0),
(base8 20) gives (2 4),
but
(base8 100) gives (414) instead of (144).
I tried for 2 days and can not find the problem. Please help me.
(defun base8(n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
The problem is that you are reversing the string a few times. The following will do:
(defun base8 (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(list m8)
(append (base8 t8) (list m8)))))
EDIT
Here's a solution without append, using a helper function. You'll see clearly that one reverse is enough:
(defun base8-helper (n)
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(cons m8 (if (= t8 0)
nil
(base8-helper t8)))))
(defun base8 (n)
(reverse (base8-helper n)))
or, with an accumulator (tail-recursive)
(defun base8 (n &optional (acc '()))
(let ((t8 (truncate n 8)) (m8 (mod n 8)))
(if (= t8 0)
(cons m8 acc)
(base8 t8 (cons m8 acc)))))
A slightly shorter version:
(defun number->list (number &key (radix 10))
(loop
:with result := nil
:until (zerop number) :do
(multiple-value-bind (whole remainder)
(floor number radix)
(push remainder result)
(setf number whole))
:finally (return result)))
And even shorter, using iterate:
(ql:quickload :iterate)
(use-package :iterate)
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole remainder)
(floor number radix)
(setf number whole)
(collect remainder at start))))
I knew that optimizing compilers could potentially change the code to replace more costly division with (un-)signed shifts and what not. And indeed SBCL generates the code that does something very similar to what Joshua Tailor posted, however, you get this only if you provide necessary type declaration and compilation declarations:
(declaim (inline number->list)
(ftype (function (fixnum &key (radix fixnum)) list)))
(defun number->list (number &key (radix 10))
(iter (until (zerop number))
(multiple-value-bind (whole reminder)
(floor number radix)
(setf number whole)
(collect reminder at start))))
(defun test-optimize () (number->list 64 :radix 8))
This disassembles into:
; disassembly for TEST-OPTIMIZE
; 05B02F28: 48C745F080000000 MOV QWORD PTR [RBP-16], 128 ; no-arg-parsing entry point
; 2F30: 48C745E817001020 MOV QWORD PTR [RBP-24], 537919511
; 2F38: E913010000 JMP L6
; 2F3D: 0F1F00 NOP
; 2F40: L0: 488B4DF0 MOV RCX, [RBP-16]
; 2F44: 48894DF8 MOV [RBP-8], RCX
; 2F48: 488B55F0 MOV RDX, [RBP-16]
; 2F4C: 31FF XOR EDI, EDI
; 2F4E: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 2F56: FFD1 CALL RCX
; 2F58: 0F8D2B010000 JNL L8
; 2F5E: 488B55F0 MOV RDX, [RBP-16]
; 2F62: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F6A: 41FFD3 CALL R11
; 2F6D: 480F42E3 CMOVB RSP, RBX
; 2F71: 488D5C24F0 LEA RBX, [RSP-16]
; 2F76: 4883EC18 SUB RSP, 24
; 2F7A: 48C7C7FAFFFFFF MOV RDI, -6
; 2F81: 488B0548FFFFFF MOV RAX, [RIP-184] ; #<FDEFINITION object for ASH>
; 2F88: B904000000 MOV ECX, 4
; 2F8D: 48892B MOV [RBX], RBP
; 2F90: 488BEB MOV RBP, RBX
; 2F93: FF5009 CALL QWORD PTR [RAX+9]
; 2F96: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2F9E: 41FFD3 CALL R11
; 2FA1: 480F42E3 CMOVB RSP, RBX
; 2FA5: 488955F8 MOV [RBP-8], RDX
; 2FA9: 488B55F0 MOV RDX, [RBP-16]
; 2FAD: 4C8D1C2581030020 LEA R11, [#x20000381] ; GENERIC-NEGATE
; 2FB5: 41FFD3 CALL R11
; 2FB8: 480F42E3 CMOVB RSP, RBX
; 2FBC: BF0E000000 MOV EDI, 14
; 2FC1: 4883EC18 SUB RSP, 24
; 2FC5: 48896C2408 MOV [RSP+8], RBP
; 2FCA: 488D6C2408 LEA RBP, [RSP+8]
; 2FCF: B904000000 MOV ECX, 4
; 2FD4: 488B0425580F1020 MOV RAX, [#x20100F58]
; 2FDC: FFD0 CALL RAX
; 2FDE: 48F7DA NEG RDX
; 2FE1: 488B5DF8 MOV RBX, [RBP-8]
; 2FE5: 488955F8 MOV [RBP-8], RDX
; 2FE9: L1: 48837DF800 CMP QWORD PTR [RBP-8], 0
; 2FEE: 741A JEQ L2
; 2FF0: 48895DE0 MOV [RBP-32], RBX
; 2FF4: 488B55F0 MOV RDX, [RBP-16]
; 2FF8: 31FF XOR EDI, EDI
; 2FFA: 488D0C25E5030020 LEA RCX, [#x200003E5] ; GENERIC-<
; 3002: FFD1 CALL RCX
; 3004: 488B5DE0 MOV RBX, [RBP-32]
; 3008: 7C5B JL L7
; 300A: L2: 488BCB MOV RCX, RBX
; 300D: 488B55F8 MOV RDX, [RBP-8]
; 3011: L3: 48894DF0 MOV [RBP-16], RCX
; 3015: 49896C2440 MOV [R12+64], RBP
; 301A: 4D8B5C2418 MOV R11, [R12+24]
; 301F: 498D4B10 LEA RCX, [R11+16]
; 3023: 49394C2420 CMP [R12+32], RCX
; 3028: 0F86C0000000 JBE L9
; 302E: 49894C2418 MOV [R12+24], RCX
; 3033: 498D4B07 LEA RCX, [R11+7]
; 3037: L4: 49316C2440 XOR [R12+64], RBP
; 303C: 7402 JEQ L5
; 303E: CC09 BREAK 9 ; pending interrupt trap
; 3040: L5: 488951F9 MOV [RCX-7], RDX
; 3044: 488B55E8 MOV RDX, [RBP-24]
; 3048: 48895101 MOV [RCX+1], RDX
; 304C: 48894DE8 MOV [RBP-24], RCX
; 3050: L6: 48837DF000 CMP QWORD PTR [RBP-16], 0
; 3055: 0F85E5FEFFFF JNE L0
; 305B: 488B55E8 MOV RDX, [RBP-24]
; 305F: 488BE5 MOV RSP, RBP
; 3062: F8 CLC
; 3063: 5D POP RBP
; 3064: C3 RET
; 3065: L7: BF02000000 MOV EDI, 2
; 306A: 488BD3 MOV RDX, RBX
; 306D: 4C8D1C254C020020 LEA R11, [#x2000024C] ; GENERIC--
; 3075: 41FFD3 CALL R11
; 3078: 480F42E3 CMOVB RSP, RBX
; 307C: 488BCA MOV RCX, RDX
; 307F: 488B55F8 MOV RDX, [RBP-8]
; 3083: 4883C210 ADD RDX, 16
; 3087: EB88 JMP L3
; 3089: L8: 488D5C24F0 LEA RBX, [RSP-16]
; 308E: 4883EC18 SUB RSP, 24
; 3092: 488B55F8 MOV RDX, [RBP-8]
; 3096: 48C7C7FAFFFFFF MOV RDI, -6
; 309D: 488B052CFEFFFF MOV RAX, [RIP-468] ; #<FDEFINITION object for ASH>
; 30A4: B904000000 MOV ECX, 4
; 30A9: 48892B MOV [RBX], RBP
; 30AC: 488BEB MOV RBP, RBX
; 30AF: FF5009 CALL QWORD PTR [RAX+9]
; 30B2: 488955F8 MOV [RBP-8], RDX
; 30B6: 488B55F0 MOV RDX, [RBP-16]
; 30BA: BF0E000000 MOV EDI, 14
; 30BF: 4883EC18 SUB RSP, 24
; 30C3: 48896C2408 MOV [RSP+8], RBP
; 30C8: 488D6C2408 LEA RBP, [RSP+8]
; 30CD: B904000000 MOV ECX, 4
; 30D2: 488B0425580F1020 MOV RAX, [#x20100F58]
; 30DA: FFD0 CALL RAX
; 30DC: 488B5DF8 MOV RBX, [RBP-8]
; 30E0: 488955F8 MOV [RBP-8], RDX
; 30E4: E900FFFFFF JMP L1
; 30E9: CC0A BREAK 10 ; error trap
; 30EB: 02 BYTE #X02
; 30EC: 18 BYTE #X18 ; INVALID-ARG-COUNT-ERROR
; 30ED: 54 BYTE #X54 ; RCX
; 30EE: L9: 6A10 PUSH 16
; 30F0: 4C8D1C2590FF4100 LEA R11, [#x41FF90] ; alloc_tramp
; 30F8: 41FFD3 CALL R11
; 30FB: 59 POP RCX
; 30FC: 488D4907 LEA RCX, [RCX+7]
; 3100: E932FFFFFF JMP L4
Note the line: 2F81, it is where the function ash is called (which was substituted for division).
The problem with your current code
Uselpa correctly pointed out that the problem in the code you've given is that reverse is called too many times. It may be useful to take a step back and think of the definition here without thinking about Lisp code. First, the code was:
(defun base8 (n)
(cond
((zerop (truncate n 8)) (cons n nil))
(t (reverse (cons (mod n 8)
(base8 (truncate n 8)))))))
The idea is that (base8 n) returns the list of octits of n.
The first case, where n < 8 (which you're checking with (zerop (truncate n 8))) is right. If n < 8 then the result should simply be a list containing n. You can do that (as you did) with (cons n nil), though (list n) would probably be more idiomatic. In either case, it's right.
The recursive case is a bit trickier though. Let's consider a number n which, written in octal has five octits: abcde. There's a recursive call, (base8 (truncate n 8)). If we assume that base8 works correctly for the subcase, then this means that
(base8 (truncate abcde 8)) ===
(base8 abcd) ===
'(a b c d)
Now, (mod n 8) returns e. When you cons e and (a b c d) together, you get (e a b c d), and when you reverse that, you get (d c b a e), and that's what you're returning from base8 for abcde, and this isn't right. If base8 returns returns the octits in a list with the most significant octit first, you'd need to join e and (a b c d) with something like (append '(a b c d) (list 'e)), which is to say
(append (base8 (truncate n 8))
(list (mod n 8)))
That's not particularly efficient, and it does a lot of list copying. It's probably easier to generate the list of octits in reverse order with a helper function, and then have base8 call that helper function, get the list of octits in reverse order, and reverse and return it. That's what the next solutions I'll show do, although I'll be using some bit-operations to handle the division by eight rather than truncate and mod.
Efficient solutions with binary operations
Since the title of the question is How do I convert a decimal number to a list of octal digits in Common Lisp?, I think it's worth considering some options that don't use truncate, since that might be sort of expensive (e.g., see Improving performance for converting numbers to lists, and base10 to base2, and the observation that using binary arithmetic instead of quotient and remainder is faster).
The the first three bits of number correspond to its first numeral in base 8. This means that (ldb (byte 3 0) number) gives the remainder of number divided by 8, and (ash number -3)gives the quotient of number divided by 8. You can collect the octits in order from least to most significant significant octit by collecting (ldb (byte 3 0) number) and updating number to (ash number -3). If you want the least significant octit of the number to be first in the list, you could return (nreverse octits) instead of octits.
(defun base8 (number)
(do ((octits '() (cons (ldb (byte 3 0) number) octits))
(number number (ash number -3)))
((zerop number) octits)))
CL-USER> (base8 123)
(1 7 3)
CL-USER> (base8 11)
(1 3)
CL-USER> (base8 83)
(1 2 3)
The structure of the previous code is iterative, but corresponds directly to a recursive version. If you prefer the recursive version, it's this:
(defun base8 (number)
(labels ((b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits)))))
(b8 number '())))
The labels in that code simply establishes a local function called b8. You could define it with a separate defun if you wanted to and call it from base8:
(defun base8 (number)
(b8 number '()))
(defun b8 (number octits)
(if (zerop number)
octits
(b8 (ash number -3)
(cons (ldb (byte 3 0) number)
octits))))
An unorthodox (and probably inefficient) solution
Here's a silly solution that writes the number in octal, and then converts each digit character to the corresponding number:
(defun base8 (number)
(map 'list #'(lambda (x)
(position x "01234567" :test 'char=))
(write-to-string number :base 8)))
I'd use loop for this one:
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop for x = n then (floor x base)
nconcing (list (mod x base))
while (>= x base)))
(defun base8 (n)
(as-base-n-list n 8))
Needing to use list to feed the nconcing accumulation clause is ugly. Alternately, you could use collect into and reverse the accumulated list with nreverse before returning from the loop form.
While the version above is clear enough, I like this version of as-base-n-list better, which eliminates the redundant call to mod above:
(defun as-base-n-list (n base)
(check-type n (integer 0) "a nonnegative integer")
(check-type base (integer 1) "a positive integer")
(loop with remainder
do (multiple-value-setq (n remainder) (floor n base))
nconcing (list remainder)
until (zerop n)))
This one takes advantage of floor returning multiple values.