Clojure Какие интересные концепции есть в Лиспе?

defn f (i) (cond (< i 2) 1 (* i (f (- i 1))))
OK
defn g (i a) (cond (< i 2) a (g (- i 1) (* i a)))
OK
tray f 3
  1 <- (f 3)
    2 <- f
    2 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
    2 <- (cond (< i 2) 1 (* i (f (- i 1))))
      3 <- (< i 2)
        4 <- i
        4 -> 3
      3 -> false
      3 <- (* i (f (- i 1)))
        4 <- i
        4 -> 3
        4 <- (f (- i 1))
          5 <- f
          5 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
          5 <- (- i 1)
            6 <- i
            6 -> 3
          5 -> 2
          5 <- (cond (< i 2) 1 (* i (f (- i 1))))
            6 <- (< i 2)
              7 <- i
              7 -> 2
            6 -> false
            6 <- (* i (f (- i 1)))
              7 <- i
              7 -> 2
              7 <- (f (- i 1))
                8 <- f
                8 -> (lambda (i) (cond (< i 2) 1 (* i (f (- i 1)))))
                8 <- (- i 1)
                  9 <- i
                  9 -> 2
                8 -> 1
                8 <- (cond (< i 2) 1 (* i (f (- i 1))))
                  9 <- (< i 2)
                    10 <- i
                    10 -> 1
                  9 -> true
                8 -> 1
              7 -> 1
            6 -> 2
          5 -> 2
        4 -> 2
      3 -> 6
    2 -> 6
  1 -> 6
6
tray g 3 1
  1 <- (g 3 1)
    2 <- g
    2 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 3
      3 -> false
      3 <- (g (- i 1) (* i a))
        4 <- g
        4 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
        4 <- (- i 1)
          5 <- i
          5 -> 3
        4 -> 2
        4 <- (* i a)
          5 <- i
          5 -> 3
          5 <- a
          5 -> 1
        4 -> 3
      3 -> FUNCALL: {a=3, i=2}
    2 -> FUNCALL: {a=3, i=2}
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 2
      3 -> false
      3 <- (g (- i 1) (* i a))
        4 <- g
        4 -> (lambda (i a) (cond (< i 2) a (g (- i 1) (* i a))))
        4 <- (- i 1)
          5 <- i
          5 -> 2
        4 -> 1
        4 <- (* i a)
          5 <- i
          5 -> 2
          5 <- a
          5 -> 3
        4 -> 6
      3 -> FUNCALL: {a=6, i=1}
    2 -> FUNCALL: {a=6, i=1}
    2 <- (cond (< i 2) a (g (- i 1) (* i a)))
      3 <- (< i 2)
        4 <- i
        4 -> 1
      3 -> true
      3 <- a
      3 -> 6
    2 -> 6
  1 -> 6
6

(defun fun-excel nil
  (let ((xlsApp    (gensym 'xlsApp))
        (xlsBooks  (gensym 'xlsBooks))
        (xlsBook   (gensym 'xlsBook))
        (xlsSheet  (genSym 'xlsSheet))
        (xlsCell   (genSym 'xlsCell))
        (xlsRange  (genSym 'xlsRange))
        (xlsCharts (genSym 'xlsCharts))
        (xlsChart  (genSym 'xlsChart)))
        (comCreateObject xlsApp "Excel.Application")
        (comPropGetO xlsApp "WorkBooks" xlsBooks)
        (comPropLet xlsApp "Visible" -1)
        (comPropLet xlsApp "displayalerts" 0)
        (comMethodO xlsBooks "ADD" xlsBook)
        (compropGetO xlsBook "Sheets" xlsSheet 1)
        (compropGetO xlsSheet "cells" xlsCell 1 1)
        (comPropLet xlsCell "Value" 5)
        (comDestroyObject xlsCell)
        (compropGetO xlsSheet "cells" xlsCell 1 2)
        (comPropLet xlsCell "Value" 10)
        (comDestroyObject xlsCell)
        (compropGetO xlsSheet "cells" xlsCell 1 3)
        (comPropLet xlsCell "Value" 15)
        (comDestroyObject xlsCell)
        (comPropGetO xlsSheet "range" xlsRange "A1:C1")
        (comMethod xlsRange "select")
        (comPropGetO xlsApp "charts" xlsCharts)
        (comMethodO xlsCharts "ADD" xlsChart)
        (comPropLet xlsChart "Type" -4100)
        (iter (for i from 1 to 36) (for j from 5 to 180 by 5)
              (comPropLet xlsChart "Rotation" j)
              (sleep* 200))
        (iter (for i from 1 to 36) (for j from 180 to 5 by -5)
              (comPropLet xlsChart "Rotation" j)
              (sleep* 200))
        (comDestroyObject xlsBooks)
        (comDestroyObject xlsBook)
        (comDestroyObject xlsSheet)
        (comDestroyObject xlsCharts)
        (comDestroyObject xlsChart)
        (comDestroyObject xlsRange)
        (comMethod xlsApp "quit")
        (comDestroyObject xlsApp)))

//
//  Программа отображения диалога _Dlg_
//
 
(prog nil
 
      (try (dlgDestroy '_Dlg_) except Nil)
      (dlgCreate '_Dlg_ 510 406 "Проба" &H8000000F)
      (dlgAddControl '_Dlg_ '_BUT_1 _BUTTON 380 326 100 36 '("Tahoma" 8,25 1 0 0) "Закрыть")
      (dlgAddControl '_Dlg_ '_BUT_2 _BUTTON 267 326 100 36 '("Tahoma" 8,25 1 0 0) "Выполнить")
      
      (defun f (x) (* (exp (* x -0.3))(sin (* 8 x))))
      
      (defun scale (x y wXmin wXmax wYmin wYmax x0 y0 W H) 
             (list (+ x0 (flo2fix (/ (* (- x wXmin) W) (- wXmax wXmin 0.0))))
                   (+ y0 (flo2fix (/ (* (- wYmax y) H) (- wYmax wYmin 0.0))))))
 
      (defun Graphic ()
          (let* ((user32 (loadlibrary "user32.dll"))
                 (gdi32  (loadlibrary "gdi32.dll")) 
                 (hwnd   (callAPI user32 "GetActiveWindow"))
                 (hdc    (callAPI user32 "GetDC" (list 'val hwnd)))
                 (penR   (callAPI gdi32  "CreatePen" (list 'val (bit2fix (QBColor 12))) (list 'val 3) (list 'val 1)))
                 (penB   (callAPI gdi32  "CreatePen" (list 'val (bit2fix (QBColor 8)))  (list 'val 1) (list 'val 1)))
                 (hbr    (callAPI gdi32 "CreateSolidBrush" (list 'val (bit2fix (QBColor 15)))))
                 (lp     (gensym 'lp))
                 (flg    t))
 
                (bloCreate lp 100)
 
                (callAPI gdi32 "SelectObject" (list 'val hbr) (list 'val hdc))
                (callAPI gdi32 "Rectangle" (list 'val 300) (list 'val 500) (list 'val 2) (list 'val 2) (list 'val hdc))
                (callAPI gdi32 "DeleteObject" (list 'val hbr))
 
                (callAPI gdi32 "SelectObject" (list 'val penB) (list 'val hdc)) 
                
                (iter (for xx from 0.0 to 10.9 by 1.0)
                  (let ((l1 (scale xx -1.0 -0.1 11.0 -1.1 1.1 2 2 500 300))
                        (l2 (scale xx  1.0 -0.1 11.0 -1.1 1.1 2 2 500 300)))
                       (callAPI gdi32 "MoveToEx" (list 'ref lp) (list 'val (cadr l1)) (list 'val (car l1)) (list 'val hdc))
                       (callAPI gdi32 "LineTo" (list 'val (cadr l2)) (list 'val (car l2)) (list 'val hdc))))
 
                (iter (for yy from -1.0 to 1.0 by 0.2)
                  (let ((l1 (scale -0.1  yy -0.1 10.9 -1.1 1.1 2 2 500 300))
                        (l2 (scale 10.9  yy -0.1 10.9 -1.1 1.1 2 2 500 300)))
                       (callAPI gdi32 "MoveToEx" (list 'ref lp) (list 'val (cadr l1)) (list 'val (car l1)) (list 'val hdc))
                       (callAPI gdi32 "LineTo" (list 'val (cadr l2)) (list 'val (car l2)) (list 'val hdc))))
 
 
                (callAPI gdi32 "DeleteObject" (list 'val penB))
 
                (callAPI gdi32 "SelectObject" (list 'val penR) (list 'val hdc)) 
 
                (iter (for xx from 0.01 to 10.9 by 0.05)
                   (let* ((yy (f xx))
                          (ll (scale xx yy -0.1 11.0 -1.1 1.1 2 2 500 300)))
                         (if flg
                          (callAPI gdi32 "MoveToEx" (list 'ref lp) (list 'val (cadr ll)) (list 'val (car ll)) (list 'val hdc))
                          (callAPI gdi32 "LineTo" (list 'val (cadr ll)) (list 'val (car ll)) (list 'val hdc)))
                          (setq flg nil)))
 
               (bloDestroy lp)           
               (callAPI gdi32 "DeleteObject" (list 'val penR))
               (freeLibrary gdi32)
               (freeLibrary user32)
               (gc)))      
      
      //
      // Пролог загрузки диалога _DLG_
      //
      (Prog () 
 
      )
      //
      // Обработчик события CLICK для кнопки _BUT_1
      //
      (defun _BUT_1_Click  Nil 
         (dlgHide '_DLG_)
         (dlgDestroy '_DLG_)
      )
      //
      //   Назначение процедуры-события _BUT_1_Click  контролу _BUT_1
      //
      (dlgSetEvent '_BUT_1 '_BUT_1_Click )
      //
      // Обработчик события CLICK для кнопки _BUT_2
      //
      (defun _BUT_2_Click  Nil 
          (Graphic)      
       )
      //
      //   Назначение процедуры-события _BUT_2_Click  контролу _BUT_2
      //
      (dlgSetEvent '_BUT_2 '_BUT_2_Click )
      //
      //   Отображение диалога _Dlg_
      //
      (dlgShow '_Dlg_))

(def cls (compile "class Test {public int tst() {return 33;}}"))
(def cls-obj (java cls 'new))
(java cls-obj 'tst)
=> 33

; генератор замыканий ;
(defn f (x y) lambda ())
; создание пары объектов-замыканий с разными параметрами ;
(def a (f 1 2) b (f 10 20))
; вычисления в контексте переданного замыкания ;
(print (eval-in a (+ x y)) \n)
(print (eval-in b (def x 30) (+ x y)) \n)
 
........
 
=> 3
50
OK

; генератор замыканий, принимающих макрос для выполнения в своем контексте ;
(defn f (x y) lambda (m) m)
; создание пары объектов-замыканий с разными параметрами ;
(def a (f 1 2) b (f 10 20))
; вычисления макросов в контексте переданного замыкания ;
(print (a (macro () + x y)) \n)
(print (b (macro () (def x 30) (+ x y))) \n)