Advertisement
Guest User

Untitled

a guest
Dec 9th, 2019
178
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 15.84 KB | None | 0 0
  1. ;;; (((XLISP 3.3))
  2. ;;; FOUR EVER MORE
  3.  
  4. (define-macro (cw &rest z) (list 'quasiquote z))
  5.  
  6. (define-macro (pr &rest args) (cons 'prn args))
  7.  
  8. (define-macro (prnt exp &rest j) (cw begin (newline) (display '--------------------) (newline) (elist (quote ,exp)) (newline) (display '-------result-------) (newline) (elist ,exp) (newline)))
  9.  
  10. (define-macro (prn exp j) (cw if ((n==== ,exp) (quote ,j)) (begin (prnt ,exp) (display '------expected------) (newline) (elist (quote ,j)) (newline))))
  11.  
  12. (define sp 32)
  13.  
  14. (define (elist exp) (if (list? exp) (let ((sp (sy 32))) (display (sy 40)) (display sp) (for-each (lambda (x) (write x) (display sp) (display (sy 44)) (display sp)) exp) (display (sy 41))) (write exp)))
  15.  
  16. (define a 'a) (define b 'b) (define c 'c) (define d 'd) (define e 'e) (define f 'f) (define g 'g) (define h 'h) (define i 'i) (define j 'j) (define k 'k) (define l 'l) (define m 'm) (define n 'n) (define o 'o) (define p 'p) (define q 'q) (define r 'r) (define s 's) (define t 't) (define u 'u) (define v 'v) (define w 'w) (define x 'x) (define y 'y) (define z 'z)
  17.  
  18. (define-macro (mark &rest r) r)
  19.  
  20. (define-macro (av x) (cw apply values ,x))
  21.  
  22. (define-macro (abc e1 e2) (cw multiple-value-bind (a b c d e f g h i j k l m n o p q r s t u v w x y z) ,e1 ,e2))
  23.  
  24. (define-macro (vaz e1 e2) (cw multiple-value-bind (va vb vc vd ve vf vg vh vi vj vk vl vm vn vo vp vq vr vs vt vu vv vw vx vy vz) ,e1 ,e2))
  25.  
  26. (define-macro (waz e1 e2) (cw multiple-value-bind (wa wb wc wd we wf wg wh wi wj wk wl wm wn wo wp wq wr ws wt wu wv ww wx wy wz) ,e1 ,e2))
  27.  
  28. (define-macro (xaz e1 e2) (cw multiple-value-bind (xa xb xc xd xe xf xg xh xi xj xk xl xm xn xo xp xq xr xs xt xu xv xw xx xy xz) ,e1 ,e2))
  29.  
  30. (define-macro (yaz e1 e2) (cw multiple-value-bind (ya yb yc yd ye yf yg yh yi yj yk yl ym yn yo yp yq yr ys yt yu yv yw yx yy yz) ,e1 ,e2))
  31.  
  32. (define-macro (zaz e1 e2) (cw multiple-value-bind (za zb zc zd ze zf zg zh zi zj zk zl zm zn zo zp zq zr zs zt zu zv zw zx zy zz) ,e1 ,e2))
  33.  
  34. (define-macro (va ex) (cw v (vaz (av (cons v vv)) ,ex)))
  35.  
  36. (define-macro (wa ex) (cw w (waz (av (cons w ww)) ,ex)))
  37.  
  38. (define-macro (xa ex) (cw x (xaz (av (cons x xx)) ,ex)))
  39.  
  40. (define-macro (ya ex) (cw y (yaz (av (cons y yy)) ,ex)))
  41.  
  42. (define-macro (za ex) (cw z (zaz (av (cons z zz)) ,ex)))
  43.  
  44. (define-macro (v ex) (cw lambda (v &rest vv) ,ex))
  45.  
  46. (define-macro (w ex) (cw lambda (w &rest ww) ,ex))
  47.  
  48. (define-macro (x ex) (cw lambda (x &rest xx) ,ex))
  49.  
  50. (define-macro (y ex) (cw lambda (y &rest yy) ,ex))
  51.  
  52. (define-macro (z ex) (cw lambda (z &rest zz) ,ex))
  53.  
  54. (define fc (z (apply z zz)))
  55.  
  56. (define pred (za (mapped (y (if (fc za y) (or y #t))))))
  57.  
  58. (define less (z (tree-mapped (type (y (if (< y z) y)) number?))))
  59.  
  60. (define more (z (tree-mapped (type (y (if (> y z) y)) number?))))
  61.  
  62. (define y= (z (tree-mapped (type (y (if (= y z) (or y #t))) number?))))
  63.  
  64. (define == (z (mapped (y (if (eq? y z) (or y #t))))))
  65.  
  66. (define === (z (mapped (y (if (eqv? y z) (or y #t))))))
  67.  
  68. (define ==== (z (mapped (y (if (equal? y z) (or y #t))))))
  69.  
  70. (define n= (z (tree-mapped (type (y (if (not (= y z)) (or y #t))) number?))))
  71.  
  72. (define n== (z (mapped (y (if (not (eq? y z)) (or y #t))))))
  73.  
  74. (define n=== (z (mapped (y (if (not (eqv? y z)) (or y #t))))))
  75.  
  76. (define n==== (z (mapped (y (if (not (equal? y z)) (or y #t))))))
  77.  
  78. (define make-adder (z (tree-mapped (type (y (+ y z)) number?))))
  79.  
  80. (define predor (z (mapped (letrec ((rec (ya (if yb (or (apply (car yb) ya) (rec ya (cdr yb))) ())))) (x (let ((xs (cons x xx))) (or (apply z xs) (rec xs zz))))))))
  81.  
  82. (define predand (z (mapped (letrec ((rec (ya (if yb (and (apply (car yb) ya) (rec ya (cdr yb))) (or (car ya) #t))))) (x (let ((xs (cons x xx))) (if (apply z xs) (rec xs zz))))))))
  83.  
  84. (define predfn (z (mapped (y (let ((ys (cons y yy))) (if (apply (apply predand zz) ys) (apply z ys)))))))
  85.  
  86. (define fnfn (z (mapped (letrec ((rec (ya (if yb (rec ((car yb) ya) (cdr yb)) ya)))) (x (rec (apply z (cons x xx)) zz))))))
  87.  
  88. (define type (z (mapped (y (or ((predfn z (apply predand zz)) y) (if ((apply predand zz) y) () y))))))
  89.  
  90. (define mapped (z (y (if yy (map z (cons y yy)) (fc z y)))))
  91.  
  92. (define mapped (mapped mapped))
  93.  
  94. (define tree-mapped (z (letrec ((rec (y (if yy (map rec (cons y yy)) (if (pair? y) (map rec y) (fc z y)))))) (x (apply rec (cons x xx))))))
  95.  
  96. (define tree-mapped (mapped tree-mapped))
  97.  
  98. (define nthcdr (z (mapped (y (if (= 0 z) y ((nthcdr (- z 1)) (cdr y)))))))
  99.  
  100. (define subseq (za (mapped (y (letrec ((rec (xa (if (= 0 xb) (reverse xc) (rec (cdr xa) (- xb 1) (cons (car xa) xc)))))) (rec ((nthcdr za) y) (- zb za) ()))))))
  101.  
  102. (define findcar (z (mapped (y (if y (if (fc z (car y)) (values (car y) y) ((findcar z) (cdr y))))))))
  103.  
  104. (define append1 (za (append za (list zb))))
  105.  
  106. (define conc1 (za (append! za (list zb))))
  107.  
  108. (define longer (za (mapped (y (letrec ((rec (x (if (number? x) x (if (string? x) (string-length x) (if (vector? x) (vector-length x) (if (list? x) (length x) (error x))))))) (compare (wa (and (pair? wa) (or (not wb) (compare (cdr wa) (cdr wb))))))) (values (if (if (if (list? za) (list? y)) (compare y za) (> (rec y) (rec za))) y) za y))))))
  109.  
  110. (define longer-object (z (mapped (y (abc ((longer y) z) (if a c b))))))
  111.  
  112. (define shorter-object (z (mapped (y (abc ((longer z) y) (if a b c))))))
  113.  
  114. (define filter (z (mapped (y (letrec ((rec (xa (if xb (let ((val (fc xa (car xb)))) (if val (rec xa (cdr xb) (cons val xc)) (rec xa (cdr xb) xc))) (reverse xc))))) (rec z y ()))))))
  115.  
  116. (define group (z (mapped (y (letrec ((rec (xa (let ((rest ((nthcdr z) xa))) (if (pair? rest) (rec rest (cons ((subseq 0 z) xa) xb)) (reverse (cons xa xb))))))) (if (= 0 z) (error 0) (if y (rec y ()))))))))
  117.  
  118. (define prune (z (mapped (y (letrec ((rec (xa (if xa (if (pair? (car xa)) (rec (cdr xa) (cons (rec (car xa) ()) xb)) (rec (cdr xa) (if (fc z (car xa)) xb (cons (car xa) xb)))) (reverse xb))))) (rec y ()))))))
  119.  
  120. (define find#t (z (mapped (y (if y (let ((val (fc z (car y)))) (if val (values (car y) val) ((find#t z) (cdr y)))) y)))))
  121.  
  122. (define (before x y lst &key (test ==)) (if lst (let ((first (car lst))) (if ((test y) first) () (if ((test x) first) lst (before x y (cdr lst) :test test))))))
  123.  
  124. (define (after x y lst &key (test ==)) (let ((rest (before y x lst :test test))) (and rest (multiple-value-bind (a b) ((findcar (test x)) rest) b))))
  125.  
  126. (define (duplicate obj lst &key (test ==)) (multiple-value-bind (a b) ((findcar (test obj)) (cdr (multiple-value-bind (a b) ((findcar (test obj)) lst) b))) b))
  127.  
  128. (define split-at (z (mapped (y (letrec ((rec (xa (if xa (if (fc z (car xa)) (values (reverse xb) xa) (rec (cdr xa) (cons (car xa) xb))) (values (reverse xb) xa))))) (rec y ()))))))
  129.  
  130. (define 2x (z (* 2 z)))
  131.  
  132. (define 2x (type 2x number?))
  133.  
  134. (define 2x (tree-mapped 2x))
  135.  
  136. (define last1 (z (car (last-pair z))))
  137.  
  138. (define last1 (mapped last1))
  139.  
  140. (define single (z (and (pair? z) (not (cdr z)) z)))
  141.  
  142. (define single (mapped single))
  143.  
  144. (define mklist (z (if (list? z) z (list z))))
  145.  
  146. (define mklist (mapped mklist))
  147.  
  148. (define flatten (z (letrec ((rec (ya (if ya (if (atom? ya) (cons ya yb) (rec (car ya) (rec (cdr ya) yb))) yb)))) (rec z ()))))
  149.  
  150. (define flatten (mapped flatten))
  151.  
  152. (define (sy &rest zs) (if zs ((fnfn (tree-mapped (y (if (char? y) y (if (integer? y) (integer->char y) (if (string? y) (string->list y) ((fnfn symbol->string string->list) y)))))) flatten list->string string-upcase intern) zs) (gensym)))
  153.  
  154. (define (spy &rest zs) (if zs ((fnfn (group 1) (y (map (x (append1 x #\space)) y)) (tree-mapped (w (if (char? w) w (if (integer? w) (string->list (number->string w)) (if (string? w) (string->list w) ((fnfn symbol->string string->list) w)))))) flatten list->string string-upcase intern) zs) (gensym)))
  155.  
  156. (define ch (z (char->integer z)))
  157.  
  158. (define ch (mapped ch))
  159.  
  160. (define mp (za (mapped (y (apply append (map (x (apply x za)) (map mapped (cons y yy))))))))
  161.  
  162. (define tp (za (mapped (y (apply append (map (x (apply x za)) (map tree-mapped (cons y yy))))))))
  163.  
  164. (define ma (z (y (apply map (cons z (cons y yy))))))
  165.  
  166. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  167.  
  168.  
  169.  
  170. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  171.  
  172.  
  173.  
  174. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  175. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  176. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  177. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  178. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  179. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  180. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  181. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  182. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  183. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  184. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  185. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  186. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  187. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  188. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  189. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  190. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  191. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  192. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  193. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  194. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  195. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  197. ;;;;;;;; BASE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  198. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  199. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  200.  
  201. (newline)
  202.  
  203. (elist '(f o u r))
  204.  
  205. (newline)
  206.  
  207. (display "H u t c h i n s o n")
  208.  
  209. (prn (abc (+ 1 2) a)
  210. 3
  211. )
  212.  
  213. (prn (abc (+ 1 2) t)
  214. ()
  215. )
  216.  
  217. (MARK prn (abc (values h a z e l) (list c d e b a))
  218. (
  219. z e l a h
  220. ))
  221.  
  222. (prn ((y (list y yy)) 1 2 3 4 5 6 7)
  223. (
  224. 1 (2 3 4 5 6 7)
  225. ))
  226.  
  227. (prn ((z (list z zz)) 1 2 3 4 5 6 7)
  228. (
  229. 1 (2 3 4 5 6 7)
  230. ))
  231.  
  232. (prn ((za (+ za zd zg)) 1 2 3 4 5 6 7)
  233. 12
  234. )
  235.  
  236. (prn ((ya (+ ya yd yg)) 1 2 3 4 5 6 7)
  237. 12
  238. )
  239.  
  240. (prn (cw define c ,(+ 1 0))
  241. (
  242. define c 1
  243. ))
  244.  
  245. (prn (cw define d (+ 1 c))
  246. (
  247. define d (+ 1 c)
  248. ))
  249.  
  250. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  251. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  252. ;;;;;;;; STRESS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  253. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  254. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  255.  
  256. (prn 42
  257. 42
  258. )
  259.  
  260. (prn (+ 21 21)
  261. 42
  262. )
  263.  
  264. (prn (list f o o t)
  265. (
  266. f o o t
  267. ))
  268.  
  269. (prn (list z e l a h)
  270. (
  271. z e l a h
  272. ))
  273.  
  274. (prn (fc + 1 2 3)
  275. 6
  276. )
  277.  
  278. (prn (fc map - '(1 2 3))
  279. (
  280. -1 -2 -3
  281. ))
  282.  
  283. (prn (fc fc fc + 1 2 3)
  284. 6
  285. )
  286.  
  287. (prn ((pred odd?) 1 2)
  288. (
  289. 1 ()
  290. ))
  291.  
  292. (prn ((pred odd?) 2)
  293. ()
  294. )
  295.  
  296. (prn ((pred (pred odd?)) 1)
  297. 1
  298. )
  299.  
  300. (prn ((more 3) 4)
  301. 4
  302. )
  303.  
  304. (prn ((more 3) 3)
  305. ()
  306. )
  307.  
  308. (prn ((more 0) -3 -2 '(-1 0 1 2) () 3)
  309. (
  310. () () (() () 1 2) () 3
  311. ))
  312.  
  313. (prn ((more 0) '(-3 -2 (-1 0 1 2) () 3))
  314. (
  315. () () (() () 1 2) () 3
  316. ))
  317.  
  318. (prn ((less 3) 4)
  319. ()
  320. )
  321.  
  322. (prn ((less 3) 2)
  323. 2
  324. )
  325.  
  326. (prn ((less 0) -3 -2 '(-1 0 1 2) () 3)
  327. (
  328. -3 -2 (-1 () () ()) () ()
  329. ))
  330.  
  331. (prn ((less 0) '(-3 -2 (-1 0 1 2) () 3))
  332. (
  333. -3 -2 (-1 () () ()) () ()
  334. ))
  335.  
  336. (prn ((y= 0) 0)
  337. 0
  338. )
  339.  
  340. (prn ((y= 0) 1)
  341. ()
  342. )
  343.  
  344. (prn ((y= 0) 0 '(1) 0 '(1) '(1) 0 '(1) 0)
  345. (
  346. 0 (()) 0 (()) (()) 0 (()) 0
  347. ))
  348.  
  349. (prn ((y= 0) '(0 (1) 0 (1) (1) 0 (1) 0))
  350. (
  351. 0 (()) 0 (()) (()) 0 (()) 0
  352. ))
  353.  
  354. (prn ((== "123") "123")
  355. ()
  356. )
  357.  
  358. (prn ((=== "123") "123")
  359. "123"
  360. )
  361.  
  362. (prn ((==== "123") "124" "123")
  363. (
  364. () "123"
  365. ))
  366.  
  367. (prn ((== ()) ())
  368. #t
  369. )
  370.  
  371. (prn ((=== ()) ())
  372. #t
  373. )
  374.  
  375. (prn ((==== ()) ())
  376. #t
  377. )
  378.  
  379. (prn ((n== 0) ())
  380. #t
  381. )
  382.  
  383. (prn ((n=== 0) ())
  384. #t
  385. )
  386.  
  387. (prn ((n==== 0) ())
  388. #t
  389. )
  390.  
  391. (prn ((make-adder -1) 43)
  392. 42
  393. )
  394.  
  395. (prn ((make-adder -1) '((1 2 (3) 4 ((5))) 6))
  396. (
  397. (0 1 (2) 3 ((4)))
  398. 5
  399. ))
  400.  
  401. (prn ((make-adder -1) '(((1 2 (3) 4 ((5))) 6)))
  402. (
  403. ((0 1 (2) 3 ((4))) 5)
  404. ))
  405.  
  406. (prn ((predor number? null?) 3 "3" ())
  407. (
  408. #t () #t
  409. ))
  410.  
  411. (prn ((predand (more 0) (less 43)) 42 43 1)
  412. (
  413. 42 () 1
  414. ))
  415.  
  416. (prn ((predfn - number? odd?) 3)
  417. -3
  418. )
  419.  
  420. (prn ((predfn - number? odd?) 4)
  421. ()
  422. )
  423.  
  424. (prn ((predfn not null?) ())
  425. #t
  426. )
  427.  
  428. (prn ((predfn not null?) 3 4 5)
  429. (
  430. () () ()
  431. ))
  432.  
  433. (prn ((fnfn 2x -) 3)
  434. -6
  435. )
  436.  
  437. (prn ((type - number?) 3)
  438. -3
  439. )
  440.  
  441. (prn ((type - number?) "three")
  442. "three"
  443. )
  444.  
  445. (prn ((mapped -) 1 2 3)
  446. (
  447. -1 -2 -3
  448. ))
  449.  
  450. (prn ((tree-mapped -) 1 2 3)
  451. (
  452. -1 -2 -3
  453. ))
  454.  
  455. (prn ((tree-mapped -) '(1 ((2)) 3))
  456. (
  457. -1 ((-2)) -3
  458. ))
  459.  
  460. (prn ((nthcdr 0) '(1 2 3))
  461. (
  462. 1 2 3
  463. ))
  464.  
  465. (prn ((nthcdr 2) '(1 2 3) '(4 5 6))
  466. (
  467. (3) (6)
  468. ))
  469.  
  470. (prn ((subseq 1 3) '(1 2 3))
  471. (
  472. 2 3
  473. ))
  474.  
  475. (prn ((subseq 1 3) '(1 2 3) '(4 5 6 7 8 9))
  476. (
  477. (2 3) (5 6)
  478. ))
  479.  
  480. (prn (abc ((findcar odd?) '(2 3 4 5)) (list a b))
  481. (
  482. 3 (3 4 5)
  483. ))
  484.  
  485. (prn ((findcar odd?) '(2 3 4 5 7) '(5 4 3 2))
  486. (
  487. 3 5
  488. ))
  489.  
  490. (prn (append1 '(1 2 3) 4)
  491. (
  492. 1 2 3 4
  493. ))
  494.  
  495. (prn (conc1 '(1 2 3) 4)
  496. (
  497. 1 2 3 4
  498. ))
  499.  
  500. (prn (abc ((longer '(1 2 3 4)) '(1 2)) (if a c b))
  501. (1 2 3 4)
  502. )
  503.  
  504. (prn ((longer '(1 2 3)) "007" '(good job) 2 5 '(very very good job))
  505. (
  506. () () () 5 (very very good job)
  507. ))
  508.  
  509. (prn ((longer-object '(1 2 3)) "007" '(good job) 2 5 '(very very good job))
  510. (
  511. "007" (1 2 3) (1 2 3) 5 (very very good job)
  512. ))
  513.  
  514. (prn ((shorter-object '(1 2 3)) "007" '(good job) 2 5 '(very very good job))
  515. (
  516. "007" (good job) 2 (1 2 3) (1 2 3)
  517. ))
  518.  
  519. (prn ((filter (predfn - number? odd?)) '(1 2 3 4 5 6 7 8 9))
  520. (
  521. -1 -3 -5 -7 -9
  522. ))
  523.  
  524. (prn ((filter (predfn - number? odd?)) '(1 2 3) '(4 5 6))
  525. (
  526. (-1 -3) (-5)
  527. ))
  528.  
  529. (prn ((group 4) '(has every value quantum computer zelah) )
  530. (
  531. (has every value quantum) (computer zelah)
  532. ))
  533.  
  534. (prn ((group 2) '(a reusable program izza good program) '(what good does zelah mind unleash ?))
  535. (
  536. ((a reusable) (program izza) (good program)) ((what good) (does zelah) (mind unleash) (?))
  537. ))
  538.  
  539. (prn ((prune (more 3)) '((1 2 (3) ((4))) 5 6 (7)))
  540. (
  541. (1 2 (3) (())) ()
  542. ))
  543.  
  544. (prn ((prune (more 3)) '(1 2 (3) 4) '(3 5 6 (7)))
  545. (
  546. (1 2 (3)) (3 ())
  547. ))
  548.  
  549. (prn (abc ((find#t odd?) '(2 3 4 5)) (list a b))
  550. (
  551. 3 #t
  552. ))
  553.  
  554. (prn ((find#t odd?) '(1) '(2 3 4 5))
  555. (
  556. 1 3
  557. ))
  558.  
  559. (prn (before 1 3 '(1 2 3))
  560. (
  561. 1 2 3
  562. ))
  563.  
  564. (prn (after 1 3 '(1 2 3))
  565. ()
  566. )
  567.  
  568. (prn (duplicate 'good '(good enough is good enough))
  569. (
  570. good enough
  571. ))
  572.  
  573. (prn (abc ((split-at (== 'quantum)) '(has every value quantum computer zelah)) (list a b))
  574. (
  575. (has every value) (quantum computer zelah)
  576. ))
  577.  
  578. (prn ((split-at (more 3)) '(1 2 3 4 5 6 7) '(7 6 5 4 3 2 1))
  579. (
  580. (1 2 3) ()
  581. ))
  582.  
  583. (prn (2x 2)
  584. 4
  585. )
  586.  
  587. (prn (2x 1 2 3)
  588. (
  589. 2 4 6
  590. ))
  591.  
  592. (prn (2x '(((1 (2) 3))))
  593. (
  594. ((2 (4) 6))
  595. ))
  596.  
  597. (prn (last1 '(1 2 3))
  598. 3
  599. )
  600.  
  601. (prn (last1 '(3 2 1) '(1) '(7 6 5 4 3 2 1))
  602. (
  603. 1 1 1
  604. ))
  605.  
  606. (prn (single '(one two))
  607. ()
  608. )
  609.  
  610. (prn (single '(solo))
  611. (
  612. solo
  613. ))
  614.  
  615. (prn (single '(3 2 1) '(1) '(2 1))
  616. (
  617. () (1) ()
  618. ))
  619.  
  620. (prn (mklist 'solo)
  621. (
  622. solo
  623. ))
  624.  
  625. (prn (mklist '(solo))
  626. (
  627. solo
  628. ))
  629.  
  630. (prn (mklist '(solo) 'solo '(solo))
  631. (
  632. (solo) (solo) (solo)
  633. ))
  634.  
  635. (prn (flatten '(((()(buried)((()treasure()))))))
  636. (
  637. buried treasure
  638. ))
  639.  
  640. (prn (flatten '(()()) '((())) () '(()()()))
  641. (
  642. () () () ()
  643. ))
  644.  
  645. (prn (sy s y)
  646. sy
  647. )
  648.  
  649. (prn (sy a #\b "c" (ch #\+) '(((k i s s + (m (e))))))
  650. abc+kiss+me
  651. )
  652.  
  653. (prn (ch #\Z #\Z #\Z)
  654. (
  655. 90 90 90
  656. ))
  657.  
  658. (prn ((mp '(2 4 6)) - (z (* z z)) (z (* z z z)))
  659. (
  660. (-2 -4 -6)
  661. (4 16 36)
  662. (8 64 216)
  663. ))
  664.  
  665. (prn ((tp '((2) 4 ((6)))) - (z (* z z)) (z (* z z z)))
  666. (
  667. ((-2) -4 ((-6)))
  668. ((4) 16 ((36)))
  669. ((8) 64 ((216)))
  670. ))
  671.  
  672. (prn ((ma -) '(1 2))
  673. (
  674. -1 -2
  675. ))
  676.  
  677. (prn ((ma -) '(1 2 3) '(4 5 6))
  678. (
  679. -3 -3 -3
  680. ))
  681.  
  682. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  683. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  684. ;;;;;;;; DEMO ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  685. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  686. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  687.  
  688. '(prnt (sy))
  689.  
  690. '(prnt (sy "(define" sp x sp "4)"))
  691.  
  692. '(prnt (spy "(" 'define x "4" ")"))
  693.  
  694. (prn ((mp '(((2)) ((1 2) (2 3)))) 2x (z (apply (ma -) z)))
  695. (
  696. (((4)) ((2 4) (4 6)))
  697. (
  698. (-2)
  699. (-1 -1)
  700. )
  701. ))
  702.  
  703. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  704. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  705. ;;;;;;;; WASTES ;;;;;;;;;;;;;;;;;;;;;;;;;;
  706. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  707. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  708.  
  709. (define-macro (four . p) (cw eval (read (make-string-input-stream (string-append "(for-each eval (quote (" (col (quote ,p)) ")))")))))
  710.  
  711. (define col (z (letrec ((com (type (y (list 'com (+ (round (* 100 (- (* 10 y) (truncate (* 10 y))))) (truncate (* 10 y))))) number? (less 1) (more 0))) (col (xa (if xa (if (and (list? xc) (list? (cdr xc)) ((== 'com) (car xc))) (col (cdr xa) (cons (apply spy (cons #\( (append1 (reverse ((subseq 0 (cadr xc)) xb)) #\)))) ((nthcdr (cadr xc)) xb)) (car xa)) (col (cdr xa) (cons xc xb) (car xa))) (string-downcase (symbol->string (apply spy (reverse xb)))))))) (col (apply com (append1 (cdr z) 0)) () (car z)))))
  712.  
  713. (prnt (sy (col (cw
  714. ;;;;;;;;;;
  715. defn dub ([x]) * 2 x .3 .4
  716. println dub ,(sy 34 "21" 34) .2 .2
  717. ;;;;;;;;;;
  718. ))))
  719.  
  720. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  721. (newline)(newline)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement