I wrote the code below (INFIX-LINKING-LEAFS - the last function - is the first caller with the loop). I'm sorry if it is too much code (five functions) for the purpose of answering my question. I thought, the whole context might be necessary to identify my fallacy.
It apparently is a cumbersome approach. But I need it to comprehend the single steps of the problem. My first try contained everything in one function, and I lost orientation. Now I intend to make it very cumbersome in seperated tiny steps.
So at this moment, I am not searching for abstractions but for the reason, why my inner loop does not start. It will be an obvious mistake, but my thinking locked at the moment. (I avoid caar etc. on purpose by the way, even if I like the shorthands.)
As you might see, I thought that the inner loop would just repeat my instructions no matter what. What I realised is, as you can see, that I instructed to loop (also dolist) just once. And, actually, I'm too dull right now to get it. Could you please give me a nudge?
Thank you so very much!
This is a sample input:
((⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) <
"logo-quote" "\"4\"" > (POWER . 500) < "logo-quote" "\"8\"" > (SUM . 300) <
"logo-quote" "\"1\"" >))
If this "pre-Logo-line" is too confusing, maybe the starting datum is helpful as an information:
(defparameter *infix-case-4* "print - 3 * 4 + 5 * 9 - 2 / 4 ^ 8 + 1")
This is the code:
(defun infix-pos (lines-lst)
"Takes a list of pre-Logo lines as input and returns a nested list
with a sublist of dotted pairs for each line with (<position> . <weight>),
sorted by <weight>."
(let ((loop-ctr -1)
(infix-pos-weight-lst '())
(interim '())
(out '()))
(loop for line in lines-lst do
(loop for el in line
do (incf loop-ctr)
if (consp el)
do (progn
(push (cons loop-ctr (rest el))
infix-pos-weight-lst)))
(push (nreverse infix-pos-weight-lst) interim)
(setf infix-pos-weight-lst '()) )
;;interim))
(loop for lst in interim do
(push (sort lst
#'(lambda (x y)
(> (rest x) (rest y))))
out))
out))
(let ((new-line '())
(pos-lst '()))
;; pos-s: start, pos-o: operator, pos-e: end
(defun splice-in-new-line (pos-s pos-o pos-e)
"Concatenates the first part of NEW-LINE with the 'new part' and
the last part of NEW-LINE. The 'new part' is the prefixed Logo expression."
(setf new-line (append
(subseq new-line 0 pos-s) ;; first part of NEW-LINE
(list '⊂ ;; new part for NEW-LINE
(string
(first (nth (first (first pos-lst))
new-line))))
(subseq new-line pos-s pos-o)
(subseq new-line (1+ pos-o) pos-e)
'(⊃)
(subseq new-line pos-e)));) ;; Last part of NEW-LINE
(terpri) (princ "splice-in...: ") (print new-line) (terpri))
(defun determine-case ()
"Returns the name of the context of the infix operator.
Simply an intermediate step for me, to be more easy on my eyes."
(cond (;; (case 1:) Operator connects two plain words
(and (eq '< (nth (- (first (first pos-lst)) 4) new-line))
(eq '> (nth (+ (first (first pos-lst)) 4) new-line)))
'plain-plain)
(;; (case 2:) Operator connects a plain word and a thing or (- number)
(and (eq '< (nth (- (first (first pos-lst)) 4) new-line))
(eq '⊃ (nth (+ (first (first pos-lst)) 7) new-line)))
'plain-thing)
(;; (case 3:) Op. connects a thing or (- number) and a plain word
(and (eq '⊂ (nth (- (first (first pos-lst)) 7) new-line))
(eq '> (nth (+ (first (first pos-lst)) 4) new-line)))
'thing-plain)
(;; (case 4:) Operator connects two things or (- numbers)
(and (eq '⊂ (nth (- (first (first pos-lst)) 7) new-line))
(eq '⊃ (nth (+ (first (first pos-lst)) 7) new-line)))
'thing-thing)
(;; (fallback:) Do nothing in different contexts.
t nil)))
(defun handle-case (branch)
"Calls SPLICE-IN-NEW-LINE with the relevant crop marks."
(case branch
((plain-plain) (format t "~%handle case 1")
(splice-in-new-line
(- (first (first pos-lst)) 4)
(first (first pos-lst))
(+ (first (first pos-lst)) 5)))
((plain-thing) (format t "~%handle case 2")
(splice-in-new-line
(- (first (first pos-lst)) 4)
(first (first pos-lst))
(+ (first (first pos-lst)) 8)))
((thing-plain) (format t "~%handle case 3")
(splice-in-new-line
(- (first (first pos-lst)) 7)
(first (first pos-lst))
(+ (first (first pos-lst)) 5)))
((thing-thing) (format t "~%handle case 4")
(splice-in-new-line
(- (first (first pos-lst)) 7)
(first (first pos-lst))
(+ (first (first pos-lst)) 8)))
(otherwise (format t "~%otherwise")
nil))
(setf pos-lst (rest pos-lst));)
(format t "~%pos-lst: ~a" pos-lst))
(defun infix-linking-leafs (lines-lst)
"Takes a list of pre-Logo lines as input. Any infix operator that links
two plain numeric words, negated numeric words or 'thinged' words will
be identified. From highest to lowest weight, these partial infix expressions
will be reformulated as prefixed expressions spliced into the original line.
If words are bound by one operator they are lost for the next operator in
the weight order."
(let ((infix-pos-lst (infix-pos lines-lst))
(out '())
(ct-outer 0)
(ct-inner 0))
(loop for line in lines-lst do
(progn
(setf new-line line)
(format t "outer: ~d~%NEW-LINE: ~a~%" (incf ct-outer) new-line)
(loop for subl in infix-pos-lst do
(progn
(format t "inner: ~d~%SUBL: ~a~%" (incf ct-inner) subl)
(when (= ct-inner 1)
(setf pos-lst subl))
(format t "POS-LST: ~a~%" pos-lst)
(handle-case (determine-case))) ) ; end inner LOOP
(format t "~%outer: ~d~%NEW-LINE: ~a~%" ct-outer new-line)
(push new-line out)
(setf new-line '()) )) ; end outer PROGN, outer LOOP
(nreverse out))))
The sample output:
outer: 1
NEW-LINE: (⊂ print ⊂ minus < logo-quote "3" > ⊃ (PRODUCT . 400) < logo-quote
"4" > (SUM . 300) < logo-quote "5" > (PRODUCT . 400) < logo-quote
"9" > (SUM . 300) ⊂ minus < logo-quote "2" > (QUOTIENT . 400) <
logo-quote "4" > (POWER . 500) < logo-quote "8" > (SUM . 300) <
logo-quote "1" >)
inner: 1
SUBL: ((36 . 500) (9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300)
(41 . 300))
POS-LST: ((36 . 500) (9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300)
(41 . 300))
handle case 1
splice-in...:
(⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) ⊂
"POWER" < "logo-quote" "\"4\"" > < "logo-quote" "\"8\"" > ⊃ (SUM . 300) <
"logo-quote" "\"1\"" >)
pos-lst: ((9 . 400) (19 . 400) (31 . 400) (14 . 300) (24 . 300) (41 . 300))
outer: 1
NEW-LINE: (⊂ print ⊂ minus < logo-quote "3" > ⊃ (PRODUCT . 400) < logo-quote
"4" > (SUM . 300) < logo-quote "5" > (PRODUCT . 400) < logo-quote
"9" > (SUM . 300) ⊂ minus < logo-quote "2" > (QUOTIENT . 400) ⊂
POWER < logo-quote "4" > < logo-quote "8" > ⊃ (SUM . 300) <
logo-quote "1" >)
((⊂ "print" ⊂ "minus" < "logo-quote" "\"3\"" > ⊃ (PRODUCT . 400) < "logo-quote"
"\"4\"" > (SUM . 300) < "logo-quote" "\"5\"" > (PRODUCT . 400) < "logo-quote"
"\"9\"" > (SUM . 300) ⊂ "minus" < "logo-quote" "\"2\"" > (QUOTIENT . 400) ⊂
"POWER" < "logo-quote" "\"4\"" > < "logo-quote" "\"8\"" > ⊃ (SUM . 300) <
"logo-quote" "\"1\"" >))
Some feedback:
There are a lot of unneeded variables in your code. Example, I would write INFIX-POS like this:
(defun infix-pos (lines-list)
"Takes a list of pre-Logo lines as input and returns a nested list
with a sublist of dotted pairs for each line with (<position> . <weight>),
sorted by <weight>."
(loop for line in lines-list
collect (sort (loop for el in line and loop-ctr from 0
when (consp el)
collect (cons loop-ctr (cdr el)))
#'> :key #'cdr)))
The above code gets rid of one LOOP and a lot of local variables.
I would also write the rest of the code without the top-level LET. The global LET with local DEFUNs is a source for errors.