I am trying to do a project which includes CLISP. I do not have any knowledge about CLISP and am a complete novice in this language.
Following is the code that is to already given:
#|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POLYMORPHISM
TODO 2a. Define an object "cirle" with variables x,y
(for the center of the circle) and radius
(to hold the size of the circle). Add a method
"area" that returns 2 *pi*radius^2
; run this to peek inside circle
'(xpand (circle))
TODO 2b. Define an object "rectangle" with variables x1,x2,y1,y2
that all default value of 0. Add
a method "area" that returns the area of that rectangle
TODO 2c. Show the output from the following test
|#
(defun polymorphism()
(let ((sum 0)
(all (list (circle :radius 1)
(rectangle :x2 10 :y2 10)
(circle :radius 2))))
(dolist (one all)
(incf sum (send one 'area)))
(print `(polymorphism ,sum))))
; to run, uncomment the following
'(polymorphism)
#|
I have to create an object for circle and rectangle which has attributes and a method.
For the circle, this is what I have already tried:
(defthing
circle
:has ((x 0) (y 0) (radius 0))
:does ((area (radius)
(2 * (22/7) * radius))
))
For the rectangle, this is what I have already tried:
(defthing
rectangle
:has ((x1 0) (y1 0) (x2 0) (y2 0))
:does ((area
((x1-x2) * (y1-y2) * radius))
))
Is that all I will need or do I have to add anything for the circle and rectangle methods to work?
Common Lisp does not have infix arithmetic. All arithmetic is done by calling functions and calling functions is done by writing an opening paren, the function name, the arguments, then a closing paren.
Where you write:
(area (radius)
(2 * (22/7) * radius))
You probably meant to write:
(area (radius)
(* pi radius radius))
(Assuming you are trying to calculate the radius and not approximating the circumference)
defthing isn't a built-in macro. We build objects with defclass. There is a tutorial: https://lispcookbook.github.io/cl-cookbook/clos.html
(defclass person ()
((name
:initarg :name
:accessor name)
(lisper
:initform nil
:accessor lisper)))
Create an object of that class:
(make-instance 'person :name "me" )
Methods are created with defmethod:
(defmethod greet (obj)
(format t "Are you a person ? You are a ~a.~&" (type-of obj)))
They can specialize on the type of the argument:
(defmethod greet ((obj person))
(format t "Hello ~a !~&" (name obj)))
Related
I have a code which takes a list and returns all possible permutations by the parameter result.
But when I compile I have an error which says *** - =: (1+ INDEX) is not a number.
Is this message true or I messed up the code generally?
I am new to lisp I can looking for a fix and also open to suggestions from fucntional programmers.
;; Creates permutatiions of a given list and returns it via parameter
(defun create-permuations (source)
(setf result (list))
(create-permuations-helper source 0 '() result)
result)
(defmacro create-permuations-helper (source index cur result)
(if (= (list-length cur) index)
(cons cur result)
(loop for i from 0 to (list-length cur) do
(create-permuations-helper source (1+ index)
(append cur (list (nth i source))) result))))
99% of times when a compiler reports an error you can trust it to be true. Here Index is the list (1+ index), literally the 1+ symbol followed by the index symbol. This is so because you are using a macro, and macros operate on code.
In your macro, you do not return a form to be evaluated, you execute code during macro-expansion that depends on itself. That alone is an undefined behaviour. For example:
(defmacro a (x)
(if (plusp x)
(a (- x 1))
nil))
In the body of a, you want to expand code using a recursive call to itself. But the macro is not yet fully known and cannot be until the whole macro is defined.
Maybe the particular lisp implementation binds a to the macro function in body of the macro, which is a strange thing to do, or you evaluated the definition twice. The first time the compiler assumes a is an unknown function, then binds a to a macro, and the second time it tries to expand the macro.
Anyway macro are not supposed to be recursive.
In the example, since the macro does not evaluate its argument, the nested call to the macro is given the literal expression (- x 1), and not its actual value, which cannot be known anyway since x is unknown. You are crossing a level of abstraction here by trying to evaluate things at macroexpansion time.
But, macros can expand into code that refers to themselves.
(defmacro a (x)
(if (plusp x)
`(b (a ,(- x 1)))
nil))
Now, (a 2) expands into (b (a 1)), which itself macroexpands into (b (b (a 0))), and finally reaches a fixpoint which is (b (b nil)).
The difference is that the macro produces a piece of code and returns, which the compiler macroexpands again, whereas in the first example, the macro must already be expanded in the body of its own definition.
Possible implementation
One way to solve your problem is to define a local function that has access to a variable defined in your main function. Then, the local function can set it, and you do not need to pass a variable by reference (which is not possible to do):
(defun permut (list)
(let (result)
(labels ((recurse (stack list)
(if list
(dolist (x list)
(recurse (cons x stack)
(remove x list :count 1)))
(push stack result))))
(recurse nil list))
result))
Alternatively, you can split the process in two; first, define permut-helper, which is a higher-order function that takes a callback function; it generates permutations and calls the callback for each one:
(defun permut-helper (stack list callback)
(if list
(dolist (x list)
(permut-helper (cons x stack)
(remove x list :count 1)
callback))
(funcall callback stack)))
You call it with a function that pushes results into a list of permutations:
(defun permut (list)
(let (result)
(flet ((add-result (permutation)
(push permutation result)))
(permut-helper nil list #'add-result))
result))
I have a problem with the behaviour of objects (class instances).
A code sample:
(defclass game-cards ()
((card-symbol :initarg :card-symbol :accessor card-symbol)
(colour :initarg :colour :accessor colour)))
(defvar *king-hearts* (make-instance 'game-cards
:card-symbol 'King
:colour 'hearts))
(defvar *ace-spades* (make-instance 'game-cards
:card-symbol 'Ace
:colour 'spades))
(defclass game-states ()
((my-cards :initarg :my-cards :accessor my-cards)
(other-cards :initarg :other-cards :accessor other-cards)))
(defparameter *state-1*
(make-instance 'game-states
:my-cards '(*king-hearts* *ace-spades*)
:other-cards ()))
(defmethod play-game ((state game-states))
(some-job (first (my-cards state))))
(defmethod some-job ((card game-cards))
(colour card))
When some-job is used with a game-cards object in the parameter list, it works like I expected.
CL-USER> (some-job *king-hearts*)
HEARTS
CL-USER>
Also this works:
CL-USER> (first (my-cards *state-1*))
*KING-HEARTS*
CL-USER>
When I try this:
(some-job (first (my-cards *state-1*)))
I get the following error message:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::SOME-JOB (1)>
when called with arguments
(*KING-HEARTS*).
[Condition of type SIMPLE-ERROR]
When I define some-job as a function:
(defun some-job-1 (card)
(colour card))
the same behaviour occurs.
The error message is now:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::COLOUR (1)>
when called with arguments
(*KING-HEARTS*).
[Condition of type SIMPLE-ERROR]
It seems that *king-hearts* is now not distinguished as an instance of game-cards by some-job and colour.
What is the reason? Tank you for your answers.
Quoted data is not evaluated. That's a basic Lisp evaluation rule:
CL-USER 1 > pi
3.141592653589793D0
CL-USER 2 > 'pi
PI
CL-USER 3 > '(pi pi)
(PI PI)
CL-USER 4 > (list pi pi)
(3.141592653589793D0 3.141592653589793D0)
CL-USER 5 > (list 'pi 'pi)
(PI PI)
Here PI is a symbol and not a number:
CL-USER 6 > (type-of 'pi)
SYMBOL
CL-USER 7 > (type-of pi)
DOUBLE-FLOAT
Thus we can define a method for a number:
CL-USER 8 > (defmethod square ((n number)) (* n n))
#<STANDARD-METHOD SQUARE NIL (NUMBER) 402005F60B>
CL-USER 9 > (square pi)
9.869604401089358D0
But the call for a symbol does not work, since there is only a method for a number:
CL-USER 10 > (square 'pi)
Error: No applicable methods for #<STANDARD-GENERIC-FUNCTION SQUARE 4060010C1C> with args (PI)
1 (continue) Call #<STANDARD-GENERIC-FUNCTION SQUARE 4060010C1C> again
2 (abort) Return to top loop level 0.
Type :b for backtrace or :c <option number> to proceed.
Type :bug-form "<subject>" for a bug report template or :? for other options.
We can define a method for a symbol in the debugger:
CL-USER 11 : 1 > (defmethod square ((n symbol))
(let ((n (symbol-value n)))
(* n n)))
#<STANDARD-METHOD SQUARE NIL (SYMBOL) 4020285ED3>
And then we re-invoke the call:
CL-USER 12 : 1 > :c 1
9.869604401089358D0
How to solve your problem:
Either create a list of CLOS objects using LIST
or retrieve the CLOS objects from the global variable using SYMBOL-VALUE.
The latter usually makes less sense.
I've been struggling with this for two days now, and I can't find the answer.
What I want is to define three variables, a, b, and c each with a value of 0.
Naive:
(dolist (lbl '(a b c)) (defvar lbl 0))
Doesn't do what I want. a, b, and c remain undefined, and lbl now has a value of 0.
I think I may understand why this can't work: defvar is a macro, not a function, and as such I am passing it the form lbl, not the current value of label (which is a, b, c in turn). I think.
But in the resulting macroexpansion, shouldn't lbl eventually be linked-up(?) or evaluated(?) to the value I'm intending? Obviously not, either because it can't be done or I'm doing it wrong.
I want to understand:
How to make this work: (dolist (lbl '(a b c)) (defvar lbl 0))
What's going wrong under the hood. I have a feeling it has something to do with symbols or the mechanics of the quote operator.
Here are a few options:
With eval, by building a defvar expression:
(dolist (lbl '(a b c))
(eval `(defvar ,lbl 0))
With proclaim and setf of symbol-value (note: set is deprecated, since 1994 for what it's worth):
(dolist (lbl '(a b c))
(proclaim `(special ,lbl))
(setf (symbol-value lbl) 0))
This is actually mostly what defvar does (see notes in the linked page), but each Lisp implementation usually also records source file location, as they do for other defining macros.
Under the hood, defvar is a macro that makes the variable special (i.e. with dynamic extent bindings in the current dynamic environment; note: there's no portable undoing for this!), and optionally initializes it if it's not yet bound.
The fact that it's a macro means it doesn't evaluate its arguments, so it can take the variable name literally, and it does so. As such, (defvar lbl 0) will define the variable lbl, not the symbol stored in a lbl variable.
The fact that it optionally initializes the variable means that the initializing expression will not even be evaluated if the variable is boundp. So, its secondary effects won't happen if the variable is already initialized. This might or might not be expected.
Note that this expression isn't actually evaluated at macro-expansion time, it's left for evaluation when the expansion is evaluated, which in a REPL means right after macro expansion (and possibly after compilation, depending on the Lisp implementation; read more about evaluation and compilation, it's quite interesting).
Similar:
(dolist (lbl '(a b c))
(let ((lbl 0))
(print lbl)))
Why is lbl 0 and not some of a, b, c?
Because LET binds the symbol lbl and not its value.
Similar with (DEFVAR FOO 3).
Imagine following code:
(DEFVAR FOO 3)
(LET ((FOO 3)) ...)
Now, if we compile this code, the Lisp compiler recognizes the DEFVAR declaration and now knows that FOO is a special global variable. Thus in the let form FOO will be dynamically bound.
Compare this code:
(dolist (v '(FOO)) (eval `(DEFVAR ,v 3)))
(LET ((FOO 3)) ...)
The compiler won't see the DEFVAR and does not know that it should be a global special variable. In the LET form, FOO will have a lexical binding.
Thus DEFVAR needs to be a macro which knows the symbol at compile time (!) and which expands into a form that informs the compiler that the symbol is a special global variable. The form also sets the value when executed.
Thus the best way to create multiple DEFVAR declarations from a list of variables is to write a macro, which expands into a PROGN form with multiple DEFVARs. Inside the PROGN, the compiler will still recognize them.
CL-USER 21 > (pprint (macroexpand '(defvar* (a b c) 0)))
(PROGN (DEFVAR A 0) (DEFVAR B 0) (DEFVAR C 0))
Implemented as:
(defmacro defvar* (vars initial-value)
`(progn
,#(loop for var in vars
do (check-type var symbol)
collect `(defvar ,var ,initial-value))))
Note that it makes sense to check that the variables are really provided as symbols.
defvar is a special form which makes sure the symbol of it's first argument is a bound variable. If the variable is not bound the evaluated expression of the second argument becomes the bound variables value. Thus:
(defvar *x* 10) ; if *x* was not bound it's now 10
(defvar *x* 20) ; since *x* is defined nothing happens
Notice that *x* is not evaluated but is used unevaluated. In order to get the same functionality by using a variable that evaluates to a symbol which you want to exist as a variable in global scope you need to do something like this:
(defvar b 10)
(dolist (lbl '(a b c))
(when (not (boundp lbl))
(setf (symbol-value lbl) 0)))
Still, neither of the ones not already bound becomes special like with defvar, but at least you get the same behaviour:
(list a b c) ; => (0 10 0)
Perhaps you should just do:
(defvar *a* 0)
(defvar *b* 0)
(defvar *c* 0)
If you have a lot of variables you need to do this with you can do:
(defmacro defvars (lst value)
(loop :for e :in lst
:collect `(defvar ,e ,value) :into result
:finally (return (cons 'progn result))))
(defparameter *w* 10)
(defvars (*q* *w* *e*) 1)
(list *q* *w* *e* ; ==> (1 10 1)
Also, it's really important to earmuff your global variables. Once special it will follow dynamic binding. eg.
(defun test ()
(let ((*b* 15))
(test2)))
(defun test2 ()
*b*)
(test) ; ==> 15
Reimplementing DEFVAR
You can approximate the behavior of defvar with a function like this:
(defun %defvar (symbol value documentation)
"Define a global special variable.
symbol---a symbol
value---nil or a function of zero arguments
documentation---nil or a documentation string
returns symbol
Proclaim SYMBOL globally as a special variable. If VALUE is non-nil,
then if SYMBOL is not already bound, SYMBOL is assigned the value
returned by calling VALUE. DOCUMENATION is assigned as the
documentation of type variable to for SYMBOL."
(prog1 symbol
;; make it globally special
(proclaim (list 'special symbol))
;; if a value is provided, and symbol isn't
;; already bound, set its value to the result
;; of calling the value-function
(when (not (null value))
(unless (boundp symbol)
(setf (symbol-value symbol)
(funcall value))))
;; set the documentation
(setf (documentation symbol 'variable) documentation)))
Then you can do, e.g.,
CL-USER> (%defvar '*the-answer* (lambda () 42) "the answer")
*THE-ANSWER*
CL-USER> *the-answer*
42
CL-USER> (documentation '*the-answer* 'variable)
"the answer"
And with your original code, you could do something like:
(dolist (lbl '(a b c)) (%defvar lbl (lambda () 0)))
Now, how does this relate to what defvar actually does? Well, you could now implement a defvar like macro by doing:
(defmacro define-var (symbol &optional (value nil value-p) documentation)
`(%defvar
',symbol
,(if value-p `(lambda () ,value) 'nil)
,documentation))
This expands as we'd expect:
CL-USER> (macroexpand-1 '(define-var *the-answer* 42 "the answer"))
(%DEFVAR '*THE-ANSWER* (LAMBDA () 42) "the answer")
You can actually use macroexpand to look at what an implementation does, too. E.g., in SBCL:
CL-USER> (macroexpand-1 '(defvar *the-answer* 42 "the answer"))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL) (SB-IMPL::%COMPILER-DEFVAR '*THE-ANSWER*))
(SB-IMPL::%DEFVAR '*THE-ANSWER* (UNLESS (BOUNDP '*THE-ANSWER*) 42) 'T
"the answer" 'T (SB-C:SOURCE-LOCATION)))
This isn't too much different from what we wrote above, though it's handling the non-evaluation of the form when the variable is already bound in a slightly different way, and it's also got some handling for recording a source location. The general idea is the same, though.
Why things don't get "linked up"
But in the resulting macroexpansion, shouldn't lbl eventually be
linked-up(?) or evaluated(?) to the value I'm intending?
The original code is:
(dolist (lbl '(a b c)) (defvar lbl 0))
We can macroexpand this to see what it becomes (in SBCL):
CL-USER> (macroexpand '(dolist (lbl '(a b c)) (defvar lbl 0)))
(BLOCK NIL
(LET ((#:N-LIST1022 '(A B C)))
(TAGBODY
#:START1023
(UNLESS (ENDP #:N-LIST1022)
(LET ((LBL (TRULY-THE (MEMBER C B A) (CAR #:N-LIST1022))))
(SETQ #:N-LIST1022 (CDR #:N-LIST1022))
(TAGBODY (DEFVAR LBL 0)))
(GO #:START1023))))
NIL)
T
Now, we can still see LBL in two places, including in (defvar LBL 0). So why don't things get "matched up"? To see that, we need to remember that the defvar inside the let will also be macroexpanded. To what? This:
CL-USER> (macroexpand '(DEFVAR LBL 0))
(PROGN
(EVAL-WHEN (:COMPILE-TOPLEVEL) (SB-IMPL::%COMPILER-DEFVAR 'LBL))
(SB-IMPL::%DEFVAR 'LBL (UNLESS (BOUNDP 'LBL) 0) 'T NIL 'NIL
(SB-C:SOURCE-LOCATION)))
But now we see that SBCL's internals are getting the symbol named "LBL"; the call (sb-impl::%defvar 'lbl …) is calling the function sb-impl::%defvar with the symbol lbl, and there's no connection between that symbol and the lexical variable that happens to be represented in the source by the same symbol. After all, if you write:
CL-USER> (let ((a 89))
(list 'a a))
(A 89)
You want to be able to get the symbol a and the number 89, right? The macroexpansion of defvar includes a call to a function with the quotation of one of the arguments to macro.
Macroexpand-all in SBCL gives me the following expansion:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A
B)))))
=>
(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ (THE (SIGNED-BYTE 4) 1)
2))))
Why does A get expanded to (THE (SIGNED-BYTE 4) 1) and not just 1?
I understand that this comes from the (DECLARE ((SIGNED-BYTE 4) A)),
but should this affect SYMBOL-MACROLET at all?
Shouldn't it even be valid to
expand to something that is not a (SIGNED-BYTE 4)?
Disclaimer I don't know if this really answer the question. Comments and edits are welcome.
An open issue
As Dirk said in the comment, in Common Lisp The Language is said that (section dedicated to the declare form (link)):
There are certain aspects peculiar to symbol-macrolet. [..] a type
declaration of a name defined by symbol-macrolet is equivalent in
effect to wrapping a the form mentioning that type around the
expansion of the defined symbol.
As far as I can tell, the issue is somewhat controversial, e.g. it seems to be an open issue. Is it mandatory or no? Read here:
Issue SYMBOL-MACROLET-TYPE-DECLARATION Writeup
[..] must (or might) the value returned by MACROEXPAND or
MACROEXPAND-1 include a THE form if there are type declarations that
apply to the symbol-macro being expanded?
There are four proposals, YES, NO, MAYBE, and PROBABLY. Read about them in the article I linked above. Each of the four proposal has a rationale.
SBCL does this. It's a choice of the implementors, I think.
Why? Well, the rationale for the YES gives a reason.
There are some advantages(?)
For example, optimization of the code may be somewhat 'easier' for the compiler. Check this.
No declarations, no the in the expansion:
Take this:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A B)))))
the result is simply:
(LAMBDA (A B)
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ 1 2))))
if you put the latter in a file you badly want to optimize, say with something like this:
(declaim (optimize (speed 3) (debug 0) (safety 0)))
and you compile it, SBCL will give you a bunch of warns like this:
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline fixnum arithmetic (cost 1) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; etc.
With declarations, SBCL puts the in the expansion:
Now try this:
(SB-CLTL2:MACROEXPAND-ALL
'(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(declare ((signed-byte 4) B))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ A B)))))
this is the expansion:
(LAMBDA (A B)
(DECLARE ((SIGNED-BYTE 4) A))
(DECLARE ((SIGNED-BYTE 4) B))
(+ A B
(SYMBOL-MACROLET ((A 1) (B 2))
(+ (THE (SIGNED-BYTE 4) 1) (THE (SIGNED-BYTE 4) 2)))))
Put the latter in a file, put the declaim for optimization, compile. Guess what? No Warn. SBCL no longer complains about not being able to do some hardocore optimization to your code. It can do it. Because of the (THE (SIGNED-BYTE 4) 1) part.
More about the the special form
So maybe it's a way to ensure your type declaration will affect the variables in the macrolet form too, providind type checking, and enforcing the ability of the compiler to optimize code?
In Common Lisp, let and symbol-macrolet shadow lexical bindings, and the (declare ((signed-byte 4) a)) is a bound declaration, so this is a bug if what SBCL is doing is to propagate the declaration to the shadowing binding.
This example might make it more clear (not a good practice, but it serves the purpose):
(let ((a 1))
(declare (type fixnum a))
(let ((a "1"))
a))
The second a binding shadows the first, so the first becomes inaccessible within the scope of the second.
The second a doesn't have any type declaration, and it shouldn't inherit any from previous lexical bindings with the same name. Type declarations for lexical bindings are supposed to be applied to that specific binding only, no matter its name.
Thus, the output form of macroexpand-all should not have a the wrapping the access to the second a, at least one that clearly comes from the first binding. That is, a compiler may be sufficiently smart to see that the second a is always a string, so it could possibly declare it as a string.
The following examples just exercise the shadowing with both let and symbol-macrolet:
(let ((a 1))
(declare (type fixnum a))
(symbol-macrolet ((a "1"))
a))
(symbol-macrolet ((a 1))
(declare (type fixnum a))
(let ((a "1"))
a))
(symbol-macrolet ((a 1))
(declare (type fixnum a))
(symbol-macrolet ((a "1"))
a))
I want to parse the text line from the Wavefront OBJ file. Currently I am interested in "V" and "F" types only.
My algorithm is as follows:
check if line is not nil (otherwise step 2 would fail)
drop comment after "#" and trim spaces
drop prefix "v " or "f "
split string to the list of elements where each element
is split to the list if it is symbol like |34/76/23|
is converted from the list: I take one element only, the first by default
or coerced to the given type if it is atomic number already.
Here is the code:
(defun parse-line (line prefix &key (type 'single-float))
(declare (optimize (debug 3)))
(labels ((rfs (what)
(read-from-string (concatenate 'string "(" what ")")))
(unpack (str &key (char #\/) (n 0))
(let ((*readtable* (copy-readtable)))
(when char ;; we make the given char a delimiter (space)
(set-syntax-from-char char #\Space))
(typecase str
;; string -> list of possibly symbols.
;; all elements are preserved by (map). nil's are dropped
(string (delete-if #'null
(map 'list
#'unpack
(rfs str))))
;; symbol -> list of values
(symbol (unpack (rfs (symbol-name str))))
;; list -> value (only the requested one)
(list (unpack (nth n str)))
;; value -> just coerce to type
(number (coerce str type))))))
(and line
(setf line (string-trim '(#\Space #\Tab)
(subseq line 0 (position #\# line))))
(< (length prefix) (length line))
(string= line prefix :end1 (length prefix) :end2 (length prefix))
(setf line (subseq line (length prefix)))
(let ((value (unpack line :char nil)))
(case (length value)
(3 value)
(4 (values (subseq value 0 3) ;; split quad 0-1-2-3 on tri 0-1-2 + tri 0-2-3
(list (nth 0 value)
(nth 2 value)
(nth 3 value)))))))))
Step four (label "unpack") is kind of recursive. It is one function and can call itself three times.
Anyway, this solution seems to be clunky.
My question is: how should one solve this task with shorter and clearer code?
I would approach this in a more structured manner.
You want to parse an obj file into some sort of data structure:
(defun parse-obj-file (filespec)
;; todo
)
You need to think about how the data structure returned should look. For now, let us return a list of two lists, one of the vertices, one of the faces. The parser will go through each line, determine whether it is either a vertex or a face, and then collect it into the appropriate list:
(defun parse-obj-file (filespec)
(with-open-file (in-stream filespec
:direction :input)
(loop for line = (read-line in-stream nil)
while line
when (cl-ppcre:scan "^v " line)
collect (parse-vertex line) into vertices
when (cl-ppcre:scan "^f " line)
collect (parse-face line) into faces
finally (return (list vertices faces)))))
I used the cl-ppcre library here, but you could also use mismatch or search. You will then need to define parse-vertex and parse-face, for which cl-ppcre:split should come in quite handy.
It would perhaps also be useful to define classes for vertices and faces.
Update: This is how I would approach vertices:
(defclass vertex ()
((x :accessor x :initarg :x)
(y :accessor y :initarg :y)
(z :accessor z :initarg :z)
(w :accessor w :initarg :w)))
(defun parse-vertex (line)
(destructuring-bind (label x y z &optional w)
(cl-ppcre:split "\\s+" (remove-comment line))
(declare (ignorable label))
(make-instance 'vertex
:x (parse-number x)
:y (parse-number y)
:z (parse-number z)
:w (parse-number w))))
Parse-number is from the parse-number library. It is better than using read.
Update 2: (Sorry for making this a run-on story; I have to interlace some work.) A face consists of a list of face-points.
(defclass face-point ()
((vertex-index :accessor vertex-index :initarg :vertex-index)
(texture-coordinate :accessor texture-coordinate
:initarg :texture-coordinate)
(normal :accessor normal :initarg :normal)))
(defun parse-face (line)
(destructuring-bind (label &rest face-points)
(cl-ppcre:split "\\s+" (remove-comment line))
(declare (ignorable label))
(mapcar #'parse-face-point face-points)))
(defun parse-face-point (string)
(destructuring-bind (vertex-index &optional texture-coordinate normal)
(cl-ppcre:split "/" string)
(make-instance 'face-point
:vertex-index vertex-index
:texture-coordinate texture-coordinate
:normal normal)))
Remove-comment simply throws away everything after the first #:
(defun remove-comment (line)
(subseq line 0 (position #\# line)))