Initial commit - fix problems & refactor code

examples/TR.py

@@ -0,0 +1,27 @@
+from typing import Callable
+
+class TR:
+    def __init__(self, f, *args, **kwargs):
+        self.f = f
+        self.args = args
+        self.kwargs = kwargs
+    def __call__(self):
+        return self.f(*self.args, **self.kwargs)
+
+def evalTR(value):
+    while isinstance(value, TR):
+        value = value()
+    return value
+
+def suman(n, acc):
+    return acc if n <= 0 else TR(suman, n - 1, acc + n)
+
+def isOdd(n):
+    return False if n == 0 else TR(isEven, n - 1)
+
+def isEven(n):
+    return True if n == 0 else TR(isOdd, n - 1)
+
+while n := int(input()):
+    print(evalTR(suman(n, 0)))
+    # print(evalTR(isEven(n)), evalTR(isOdd(n)))

examples/class.lsp

@@ -0,0 +1,20 @@
+; (def endl "
+; ")
+
+(def acc-class
+  (lambda ()
+    (do
+      (def get '(lambda () val))
+      (def add
+        '(lambda (delta)
+          (do
+            (set! val (+ val delta))
+            val)))
+      (def sub
+        '(lambda (delta)
+          (do
+            (def new (- val delta))
+            (if (< new 0) (print (++ "аяяй" endl)) (set val new))
+            val)))
+      (def acc-constructor (lambda (val) (lambda (method) (eval (eval method)))))
+      acc-constructor)))

examples/factorial.lsp

@@ -0,0 +1,32 @@
+(def comment (macro (some) '()))
+
+(comment
+  (print "input a number")
+  (def n (read))
+  (def res 1)
+  ; (print (_+_ n 1))
+  (def f '(do
+	    (set! res (_*_ res n))
+	    (set! n (_-_ n 1))
+	    (if (_<_ 0 n) (eval f) 0)
+	    ))
+  (eval f)
+  (print res)
+
+  (def t (macro (x) (do (def z 42) (print x) x)))
+  (def m (dambda (a) (do (print z) (_+_ a a) (print z))))
+  (print (m (t 3)))
+  )
+
+
+(def dact (dambda (n self) (
+		if (_<_ n 2) 1
+		(_*_ n (self (_-_ n 1) self))
+	)))
+
+(def lact (lambda (n self) (
+		if (_<_ n 2) 1
+		(_*_ n (lact (_-_ n 1) self))
+	)))
+
+(def foo (lambda (f, n) (do (def lact 43) (def dact 42) (f n f))))

examples/factorial_dambda.lsp

@@ -0,0 +1,5 @@
+(def fact (dambda (n) (
+		if (_<_ n 2) 1
+		(_*_ n (fact (_-_ n 1)))
+	)))
+

examples/factorial_macro.lsp

@@ -0,0 +1,9 @@
+(defmacro fact (n)
+  ; (prints 'n \n)
+  (if (< n 3) n
+    (* n (fact (- n 1)))))
+
+(defmacro facc (n acc)
+  ; (prints 'acc \n)
+  (if (< n 2) acc
+    (facc (- n 1) (* n acc))))

examples/factorialambda.lsp

@@ -0,0 +1,6 @@
+(def fact (lambda (n) (
+		if (_<_ n 2) 1
+		(_*_ n (fact (_-_ n 1)))
+	)))
+; (def foo fact)
+; (set! fact (lambda (n) (_+_ n 1)))

examples/horsey.clj

@@ -0,0 +1,116 @@
+; path: list of points ((1 3) (3 5) (5 7))
+;                         ^
+; stack - список ещё не проверенных направлений
+; 
+
+; (((1 2) (1 -2) (-1 2) (-1 -2)) ((1 -2) (-1 2) (-1 -2)) ((-1 2) (-1 -2)))
+; (( ... ) ((1 -2) (-1 2) (-1 -2)) ((1 -2) (-1 2) (-1 -2)) ((-1 2) (-1 -2)))
+; (() ((1 -2) (-1 2) (-1 -2)) ((-1 2) (-1 -2)))
+; ((2 5) (1 3) (3 5) (5 7))
+
+;; Сделать так, чтобы код работал для доски 8x8
+;; Необходимо сделать Tail Call Optimization 
+
+(def m 6)
+(def n 6)
+(def nm (* n m))
+(def start-position '(1 1))
+
+;;   
+
+;; (defn check-step? (step path)  ; '(to from)
+;;     (cond (or (nil? path) (nil? (cdr path))) false
+;;         (= (take 2 path) step) true
+;;         (check-step? step (cdr path))))
+
+;; (a b c d e a b f g)
+
+(defn in-borders? (p) (and (<= 1 (car p) n) (<= 1 (car (cdr p)) m)))
+
+;; (defn duplicated-step? (path) (check-step? (take 2 path) (cdr path)))
+
+;; (def all-dirs '((2 1) (2 -1) (-2 1) (-2 -1) (1 2) (1 -2) (-1 2) (-1 -2)))
+;; (def all-dirs '((1 2) (2 1) (2 -1) (1 -2) (-1 -2) (-2 -1) (-2 1) (-1 2)))
+(def all-dirs '((2 1) (1 2) (-1 2) (-2 1) (-2 -1) (-1 -2) (1 -2) (2 -1)))
+;; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+(def all-cells
+    (concat (map (lambda (r) 
+         (map (lambda (c)
+              (list r c))
+              (range 1 (+ 1 m)))) 
+         (range 1 (+ 1 n)))))
+
+
+(def all-moves (concat (map (lambda (cell)
+                      (filter (lambda (step) (in-borders? (car step)))
+                              (map (lambda (delta-move) (list (zip-with + cell delta-move) cell))
+                                   all-dirs)))
+    all-cells)))
+
+
+(defn steps-set-gen ()
+  (eval (cons do (map (lambda (step) (list def (symbol (++ step)) false)) all-moves)))
+  (defn add (x) (eval (list set! (symbol (++ x)) true)))
+  (defn has? (x) (eval (symbol (++ x))))
+  (defn remove (x) (eval (list set! (symbol (++ x)) false)))
+  (lambda (cmd) (eval cmd))
+)
+
+(def steps-set (steps-set-gen))
+
+(defn step-was? (step) ((steps-set 'has?) step))
+
+;; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+(defmacro -= (x v) (set! x (- x v)))
+(defmacro += (x v) (set! x (+ x v)))
+
+(defn cells-multiset-gen ()
+  (eval (cons do (map (lambda (cell) (list def (symbol (++ cell)) 0)) all-cells)))
+  (def distinct 0)
+  (defn add (x) (do
+                (def name (symbol (++ x)))
+                (when (= (eval name) 0) (+= distinct 1))
+                (eval (list += name 1))))
+  (defn remove (x) (do
+                (def name (symbol (++ x)))
+                (when (= (eval name) 1) (-= distinct 1))
+                (eval (list -= name 1))))
+;;   (defn distinct () xxx)
+  (lambda (cmd) (eval cmd))
+)
+
+(def cells-multiset (cells-multiset-gen))
+
+(defn path-isgood? (path) (and (= (car path) start-position) (= (cells-multiset 'distinct) nm)))
+
+;; @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+
+(defn dfs-tail (path stack)
+    ;; (print path)
+    (if
+        ; success
+        (path-isgood? path) path (if
+        ; если мы выше начала - нет решения
+        (nil? path) false (if
+        ; если некуда ходить из текущей позиции
+        (nil? (car stack)) (do
+                                (if (not (nil? (cdr path))) ((steps-set 'remove) (take 2 path)) nil)
+                                ((cells-multiset 'remove) (car path))
+                                (dfs-tail (cdr path) (cdr stack)))
+        ; иначе нам есть что делать
+        (do (def next-pos (zip-with + (car path) (car (car stack))))
+            (def step (list next-pos (car path)))
+            (def new-stack (cons (cdr (car stack)) (cdr stack)))
+            (if
+                ; если мы резко оказались вне доски
+                (not (in-borders? next-pos)) (dfs-tail path new-stack) (if
+                ; если этот ход мы уже делали
+                (step-was? step) (dfs-tail path new-stack)
+                (do
+                    ((steps-set 'add) step)
+                    ((cells-multiset 'add) next-pos)
+                    (dfs-tail (cons next-pos path) (cons all-dirs new-stack))))))))))
+
+(print (dfs-tail (list start-position) (list all-dirs)))

examples/knight.clj

@@ -0,0 +1,79 @@
+(def n 5)
+(def m 4)
+(def start-position '(1 1))
+
+;; path - '((1 1) (4 2) (0 0))
+
+(def knight-moves '((2 1) (2 -1) (-2 1) (-2 -1) (1 2) (1 -2) (-1 2) (-1 -2)))
+
+(defn check-pos? (p) (and (<= 1 (car p) n) (<= 1 (car (cdr p)) m)))
+
+
+(def all-cells
+    (concat (map (lambda (r) 
+         (map (lambda (c)
+              (list r c))
+              (range 1 (+ 1 m)))) 
+         (range 1 (+ 1 n)))))
+
+
+(def all-moves (concat (map (lambda (cell)
+                      (filter (lambda (step) (check-pos? (car step)))
+                              (map (lambda (delta-move) (list (zip-with + cell delta-move) cell))
+                                   knight-moves)))
+    all-cells)))
+
+
+(defn steps-set-gen ()
+  (eval (cons do (map (lambda (step) (list def (symbol (++ step)) false)) all-moves)))
+  (defn add (x) (eval (list set! (symbol (++ x)) true)))
+  (defn has? (x) (eval (symbol (++ x))))
+  (defn remove (x) (eval (list set! (symbol (++ x)) false)))
+  (lambda (cmd) (eval cmd))
+)
+
+(def steps-set (steps-set-gen))
+
+(defn check-step? (step path) (not ((steps-set 'has?) step)))
+
+(defmacro -= (x v) (set! x (- x v)))
+(defmacro += (x v) (set! x (+ x v)))
+
+(defn cells-multiset-gen ()
+  (eval (cons do (map (lambda (cell) (list def (symbol (++ cell)) 0)) all-cells)))
+  (def distinct 0)
+  (defn add (x) (do
+                (def name (symbol (++ x)))
+                (when (= (eval name) 0) (+= distinct 1))
+                (eval (list += name 1))))
+  (defn remove (x) (do
+                (def name (symbol (++ x)))
+                (when (= (eval name) 1) (-= distinct 1))
+                (eval (list -= name 1))))
+;;   (defn distinct () xxx)
+  (lambda (cmd) (eval cmd))
+)
+
+(def cells-multiset (cells-multiset-gen))
+
+(defn dfs (path)
+;; (def current-position (car path))
+;;   (print path)
+  (if (and (= (car path) start-position) (= (cells-multiset 'distinct) (* n m)))
+      path
+      (reduce (lambda (acc, x) 
+                (if (!= acc false) acc
+                    (do
+                        (def new-pos (zip-with + x (car path)))
+                        (def step (list new-pos (car path)))
+                        (if (and (check-pos? new-pos) (check-step? step path))
+                            (do ((steps-set 'add) step)
+                                ((cells-multiset 'add) new-pos)
+                                (def res (dfs (cons new-pos path)))
+                                ((steps-set 'remove) step)
+                                ((cells-multiset 'remove) new-pos)
+                                res
+                            )
+                            false))))
+        false knight-moves))
+)

examples/oddeven.lsp

@@ -0,0 +1,4 @@
+(defn maybeprint (n) (when (= (% n 50) 0) (do (prints n " ") (flush))))
+(defn odd? (n) (if (= n 0) false (do (maybeprint n) (even? (- n 1)))))
+(defn even? (n) (if (= n 0) true (do (maybeprint n) (odd? (- n 1)))))
+; (print (odd? (read)))

examples/oop.lsp

@@ -0,0 +1,50 @@
+"(def \n "
+")
+(def acc-class (lambda () 
+  (do
+  (def get (dambda () val))
+  (def add (dambda (delta)
+    (do
+      (set! val (_+_ val delta))
+      val
+    )))
+  (def sub (dambda (delta)
+    (do
+      (def new (_-_ val delta))
+      (if (_<_ new 0) (print (_++_ "аяяй" \n)) (set! val new))
+      val
+    )))
+  (def acc-constructor (lambda (val) (lambda (method-name) (eval (eval method-name) ))))
+  acc-constructor
+)))"
+
+(def nil '())
+
+(def acc-class (lambda (initial-val)
+  (do
+    (def val initial-val)
+    (lambda (all-args)
+      (do
+        (def method (car all-args))
+        (def args (cdr all-args))
+
+        (def get (dambda () val))
+        (def add (dambda (delta)
+          (do
+            (set! val (_+_ val delta))
+            val
+          )))
+        (def sub (dambda (delta)
+          (do
+            (def new (_-_ val delta))
+            (if (_<_ new 0) (print (_++_ "аяяй" "\n")) (set! val new))
+            val
+          )))
+
+        (if (_==_ method (symbol "get"))
+          (get)
+          (if (_==_ method (symbol "add"))
+            (add (car args))
+            (if (_==_ method (symbol "sub"))
+              (sub (car args))
+              nil))))))))

examples/test.lsp

@@ -0,0 +1,2 @@
+(defun selfactorial (self, n) (* n (if (< n 3) 1 (f f (- n 1)))))
+(defun factorial (n) (selfactorial selfactorial n))