==================================================
; I defined no less than six functions performing serial
; substitution:
;
; (serial-substitute '(-> (A B) (B (A B)) (-> B (A C) (B C)))
; '((A abc) (B cde) (C xxx)))
;
; =>
;
; (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
;
; until I learnt that built in primitive function "expand", in one
; of its polymorphic versions, does exactly that. However, I decided
; to publish my versions, just for archive. The final one is only
; four times slower than built in substitution.
(set 'substitute
(lambda(substitute-a l b)
(if (= l substitute-a)
b
(if (list? l)
(map (lambda(x)(substitute substitute-a x b))
l)
l))))
(set 'serial-substitute1
(lambda(l A)
(let ((result l))
(dolist(i A)
(set 'result (substitute (i 0) result (i 1))))
result)))
(set 'metex
(lambda-macro(head)
(eval (append '(letex)
(list (map (lambda(x)
(list (first x)
(list 'quote (last x))))
head))
(args)))))
(set 'serial-substitute2
(lambda(l A)
(eval (list 'metex A (list 'quote l)))))
(set 'serial-helper3 (lambda(x)(list (first x)
(list 'quote (last x)))))
(set 'serial-substitute3
(lambda(l A)
(eval (list 'letex (map serial-helper3
A)
(list 'quote l)))))
(set 'ss4 '(metex A 'l))
(set 'serial-substitute4
(lambda(l A)
(eval (expand ss4 'A 'l))))
(set 'serial-substitute5
(lambda(l A)
(letex ((A A)(l l))(metex A 'l))))
(set 'serial-substitute6
(lambda(F s)
(eval (let((vars (map first s)))
(list 'local
vars
'(bind s)
(append '(expand F)
(map quote vars)))))))
(set 'serial-substitute7 expand) ; this is one built in
(set 'serial-substitute8 '(lambda())) ; just to test empty loop
(set 'formula '(-> (A B) (B (A B)) (-> B (A C) (B C))))
(set 'substitution ' ((A abc) (B cde) (C xxx)))
(dolist (s '(serial-substitute1 serial-substitute2 serial-substitute3
serial-substitute4 serial-substitute5 serial-substitute6
serial-substitute7 serial-substitute8))
(println s " time (ms): " (time ((eval s) formula substitution) 100000))
(println s " result: " ((eval s) formula substitution)))
(exit)
serial-substitute1 time (ms): 10681
serial-substitute1 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute2 time (ms): 2084
serial-substitute2 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute3 time (ms): 1544
serial-substitute3 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute4 time (ms): 2114
serial-substitute4 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute5 time (ms): 2134
serial-substitute5 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute6 time (ms): 1174
serial-substitute6 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute7 time (ms): 386
serial-substitute7 result: (-> (abc cde) (cde (abc cde)) (-> cde (abc xxx) (cde xxx)))
serial-substitute8 time (ms): 119
serial-substitute8 result: nil
