190 lines
8.4 KiB
Plaintext
190 lines
8.4 KiB
Plaintext
;(def! main (fn* (argv) 2))
|
|
;(def! main (fn* () (let* (a 13 b 12 c 11) b)))
|
|
;(def! main (fn* () (do 13 12 11)))
|
|
;(def! main (fn* () (if false 1 2)))
|
|
;(def! main (fn* () (+ 13 1)))
|
|
;(def! main (fn* () (- 13 -1)))
|
|
;(def! main (fn* () (- 13 -1)))
|
|
;(def! main (fn* () (+ 13 -)))
|
|
;(def! main (fn* () (+ 13 1 2)))
|
|
;(def! main (fn* () (cond false 1 false 2 true 3 true 4 false 5)))
|
|
;(def! main (fn* () ((fn* () (+ (+ 1 2) 3)) 13 1 2)))
|
|
;(def! main (fn* () (((fn* () (fn* () 1))))))
|
|
;(def! main (fn* () ((fn* (a b c) (- (+ a b) c)) 13 1 4)))
|
|
;(def! main (fn* () (fn* () 1)))
|
|
|
|
;(def! other (fn* (a b c) (- (+ a b) c)))
|
|
;(def! main (fn* () (other 13 1 4)))
|
|
|
|
;(def! other 12)
|
|
;(def! main (fn* () (+ other 4)))
|
|
|
|
;(def! fact (fn* (n) (if (<= n 1) 1 (* (fact (- n 1)) n))))
|
|
;(def! main (fn* () (let* (to_ret (fact 5)) (do (println to_ret) to_ret))))
|
|
|
|
;(def! ret_with_call (fn* (n) (fn* (x) (+ n x))))
|
|
;(def! main (fn* () ((ret_with_call 3) 5)))
|
|
|
|
(def! test (fn* () (let* (
|
|
;(l (list 3 4 5))
|
|
a 5
|
|
;l '(a 4 5)
|
|
;l (vector 3 4 5)
|
|
;l [a 4 5]
|
|
l '[3 4 5]
|
|
;l '[a 4 5]
|
|
)
|
|
(nth l 0))))
|
|
;(def! main (fn* () (let* (it (test)) (do (println it) it))))
|
|
;(def! main (fn* () (let* (it "asdf") (do (println it) 0))))
|
|
;(def! main (fn* () (let* (it 'sym_baby) (do (println it) 0))))
|
|
;(def! main (fn* () (let* (it [1 2 3]) (do (println it) 0))))
|
|
;(def! main (fn* () (let* (it '(1 2 3)) (do (println it) 0))))
|
|
;(def! my_str "asdf")
|
|
;(def! main (fn* () (do (println my_str) 0)))
|
|
|
|
;(def! main (fn* () (let* (it (atom 7)) (do
|
|
; (println it)
|
|
; (println (deref it))
|
|
; (reset! it 8)
|
|
; (println (deref it))
|
|
; (deref it)
|
|
; ))))
|
|
;(def! my_atom (atom 5))
|
|
;(def! main (fn* () (do
|
|
; (println my_atom)
|
|
; (println (deref my_atom))
|
|
; (reset! my_atom 1337)
|
|
; (println my_atom)
|
|
; (println (deref my_atom))
|
|
; 7)))
|
|
|
|
|
|
;(def! inner (fn* (x) (do (throw (+ x 1)) (+ x 2))))
|
|
;(def! inner (fn* (x) (do (println 7) (+ x 2))))
|
|
;(def! main (fn* () (do (println (try*
|
|
; (inner 7)
|
|
; (catch* exp (+ exp 10))))
|
|
; 7)))
|
|
;(def! main (fn* () (do (println (try*
|
|
; (inner 7)))
|
|
; 7)))
|
|
|
|
(def! to_be_saved (with-meta [1] [2]))
|
|
(def! to_be_saved_s "asdfasdf")
|
|
|
|
(let* ( a [0]
|
|
b (with-meta a (fn* () (set-nth! b 0 (+ 1 (nth b 0))))))
|
|
(do
|
|
(println "testing meta stuff!")
|
|
(println b)
|
|
((meta b))
|
|
(println b)
|
|
((meta b))
|
|
(println b)))
|
|
|
|
|
|
|
|
; Use the power of GLL reader macros to implement
|
|
; BF support
|
|
|
|
; Define our tokens as BF atoms
|
|
; Ugly b/c using 1-length vectors as atoms
|
|
(add_grammer_rule 'bfs_atom ["<"] (fn* (xs) '(set-nth! cursor 0 (- (nth cursor 0) 1))))
|
|
(add_grammer_rule 'bfs_atom [">"] (fn* (xs) '(set-nth! cursor 0 (+ (nth cursor 0) 1))))
|
|
(add_grammer_rule 'bfs_atom ["\\+"] (fn* (xs) '(set-nth! tape (nth cursor 0) (+ (nth tape (nth cursor 0)) 1))))
|
|
(add_grammer_rule 'bfs_atom ["-"] (fn* (xs) '(set-nth! tape (nth cursor 0) (- (nth tape (nth cursor 0)) 1))))
|
|
(add_grammer_rule 'bfs_atom [","] (fn* (xs) '(let* (value (nth input (nth inptr 0))) (do (set-nth! inptr 0 (+ 1 (nth inptr 0))) (do (set-nth! tape (nth cursor 0) value))))))
|
|
(add_grammer_rule 'bfs_atom ["."] (fn* (xs) '(set-nth! output 0 (cons (nth tape (nth cursor 0)) (nth output 0)))))
|
|
|
|
; Define strings of BF atoms
|
|
(add_grammer_rule 'non_empty_bfs_list ['bfs_atom] (fn* (xs) (vector (nth xs 0))))
|
|
(add_grammer_rule 'non_empty_bfs_list ['bfs_atom 'optional_WS 'non_empty_bfs_list] (fn* (xs) (cons (nth xs 0) (nth xs 2))))
|
|
(add_grammer_rule 'bfs_list [] (fn* (xs) xs))
|
|
(add_grammer_rule 'bfs_list ['non_empty_bfs_list] (fn* (xs) (nth xs 0)))
|
|
|
|
; Add loop as an atom
|
|
(add_grammer_rule 'bfs_atom ["\\[" 'bfs_list "]"] (fn* (xs)
|
|
`(let* (f (fn* (f)
|
|
(if (= 0 (nth tape (nth cursor 0)))
|
|
nil
|
|
(do ,(nth xs 1) (f f)))))
|
|
(f f))))
|
|
|
|
; Top level BFS rule
|
|
(add_grammer_rule 'bfs ['bfs_list] (fn* (xs) (nth xs 0)))
|
|
|
|
; For now, stick BFS rule inside an unambigious BFS block
|
|
; and add compilation/implementation
|
|
; Note that this compilation into the underlying Lisp
|
|
; happens at macro evaluation time. If this code were
|
|
; to be compiled to C, it would be compiled all the way
|
|
; to C code with no trace of the original BF code.
|
|
(add_grammer_rule 'form ["bf" 'optional_WS "{" 'optional_WS 'bfs 'optional_WS "}"]
|
|
(fn* (xs)
|
|
`(fn* (input)
|
|
(let* (
|
|
tape (vector 0 0 0 0 0)
|
|
cursor (vector 0)
|
|
inptr (vector 0)
|
|
output (vector (vector))
|
|
)
|
|
(do ,(nth xs 4) (nth output 0))))))
|
|
|
|
; Let's try it out! This BF program prints the input 3 times
|
|
;(println (bf { ,>+++[<.>-] } [1337]))
|
|
;(println "BF: " (bf { ++-. } [1337]))
|
|
|
|
(def! our_obj (with-meta [0] (fn* () (set-nth! our_obj 0 (+ 1 (nth our_obj 0))))))
|
|
|
|
(def! get-value-helper (fn* (dict key idx) (if (>= idx (count dict)) nil (if (= key (nth dict idx)) (nth dict (+ idx 1)) (get-value-helper dict key (+ idx 2))))))
|
|
(def! get-value (fn* (dict key) (get-value-helper dict key 0)))
|
|
(def! method-call (fn* (object method & arguments) (let* (method_fn (get-value (meta object) method))
|
|
(if (= method_fn nil)
|
|
(println "no method " method)
|
|
(apply method_fn object arguments)))))
|
|
|
|
(def! actual_obj (with-meta [0] [
|
|
'inc (fn* (o) (set-nth! o 0 (+ (nth o 0) 1)))
|
|
'dec (fn* (o) (set-nth! o 0 (- (nth o 0) 1)))
|
|
'get (fn* (o) (nth o 0))
|
|
]))
|
|
|
|
(def! main (fn* () (let* ( a 7
|
|
b [1]
|
|
c (with-meta b "yolo") )
|
|
(do
|
|
(try*
|
|
((fn* () (do
|
|
(println b)
|
|
(set-nth! b 0 2)
|
|
(println b)
|
|
(println c)
|
|
(println (meta c))
|
|
(println "world")
|
|
(println to_be_saved)
|
|
(println (meta to_be_saved))
|
|
(println to_be_saved_s)
|
|
(println "Here in main testing our_obj")
|
|
(println our_obj)
|
|
((meta our_obj))
|
|
(println our_obj)
|
|
((meta our_obj))
|
|
(println our_obj)
|
|
(println (bf { ,>+++[<.>-] } [1337]))
|
|
(println "actual_obj" actual_obj)
|
|
(method-call actual_obj 'inc)
|
|
(println "actual_obj" actual_obj)
|
|
(println (method-call actual_obj 'get))
|
|
(println "actual_obj" actual_obj)
|
|
(method-call actual_obj 'dec)
|
|
(method-call actual_obj 'dec)
|
|
(println "actual_obj" actual_obj)
|
|
a)))
|
|
)))))
|
|
(do
|
|
(println "interp-main")
|
|
(main)
|
|
(println "done interp-main")
|
|
nil)
|