diff --git a/debug.lsp b/debug.lsp index 3270147..f3444fe 100644 --- a/debug.lsp +++ b/debug.lsp @@ -56,11 +56,12 @@ ; (sleep 1.5) -(define multiply-by (lambda (n) (lambda (y) (* y n)))) -(define doubler (multiply-by 2)) -(define tripler (multiply-by 3)) -(doubler 4) -(tripler 4) +;; does not work aif n is defined. in that case it is copied to lambda_scope +;; (define multiply-by (lambda (n) (lambda (y) (* y n)))) +;; (define doubler (multiply-by 2)) +;; (define tripler (multiply-by 3)) +;; (doubler 4) +;; (tripler 4) ;https://github.com/anthay/Lisp90/blob/master/lisp90.cpp @@ -77,8 +78,7 @@ x ; still 3 x ; is now 4 -(defun mini-uuid (uuid_len) - (do +(defun mini-uuid (uuid_len) (do (define a_list '("_" "-" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "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" "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")) (reduce (lambda (acc y) (+ acc y)) "" (map (lambda (e) (index a_list (random 0 (- (len a_list) 1)))) (range 0 uuid_len))) )) @@ -86,40 +86,24 @@ x ; is now 4 (benchmark "uuid 1000x :" (define i 0) (while (< i 1000) (do (mini-uuid 5) (define i (+ i 1))))) -(defun ut::assert-equal (value form) (do - (define fvalue (eval form)) - (if (= value fvalue) - 1 - nil - ) - )) - -(define ut::assert-true (test) (ut::assert-equal 1 test)) -(assert-false (test)() (asertt-equal nil test) -(defun ut::assert-true test) () -(defun ut::assert-false test) -(define ut::tests_list '()) -(defun ut::define-test (name exp_list) ( - define test_list (push ut::tests_list (list name exp_list)))) -(run-tests name1 name2 ...) +(defun plus-jedna() (do (set! xx (+ 1 xx)))) +(define xx 3) - - -(defun define-test (name exp_list) (set! test_list (push test_list (list name exp_list)))) -(defun run-tests () (do (for t test_list (if (eval (index t 1)) (print (+ "OK -> " (index t 0))) (print (+ "ERR -> " (index t 0))))))) -;(run-test name) - -(define test_list '()) - -(define-test "je to dvojka" '(assert-equal 2 (+ 1 1))) -(define-test "je to trojka" '(assert-equal 3 (+ 1 1))) - -(run-tests) +(plus-jedna) +(plus-jedna) -(define-test "je to dvojka" '(assert-equal 2 (+ 1 1))) \ No newline at end of file +(define first_tid (thread-create (while 1 (do (thread-under-lock "ilock" (print 1)) (thread-sleep 50))))) +(define second_tid (thread-create (while 1 (do (thread-under-lock "ilock" (print 2)) (thread-sleep 75))))) + +(print "first thread id:" first_tid) +(print "second thread id:" second_tid) + + +(threads-join) +(print "ok") diff --git a/ml.cpp b/ml.cpp index b2efb51..1234154 100644 --- a/ml.cpp +++ b/ml.cpp @@ -21,6 +21,8 @@ #include #include #include +#include + #define TOO_FEW_ARGS "too few arguments to function" #define TOO_MANY_ARGS "too many arguments to function" @@ -1745,6 +1747,68 @@ namespace builtin { return acc; } + + + std::mutex register_mutex; + std::vector threads_register; + std::vector mutexes_register; + std::mutex interpreter_mutex; + + MlValue thread_create(std::vector args, MlEnvironment &env) { + auto functor = [](std::vector args, MlEnvironment &env) -> void { + for (size_t i = 0; i < args.size(); i++) + MlValue acc = args[i].eval(env); + }; + + std::thread th(functor, args, std::ref(env)); + auto th_id = th.get_id(); + + std::lock_guard lockGuard(register_mutex); + threads_register.push_back(std::move(th)); + + static_assert(sizeof(std::thread::id)==sizeof(uint64_t), "size of thead::id is not equal to the size of uint_64"); + uint64_t* ptr=(uint64_t*) &th_id; + long tid = (*ptr); + + return MlValue(tid); + } + + MlValue thread_under_lock(std::vector args, MlEnvironment &env) { + if (args.size() != 2) + throw MlError(MlValue("thread_under_lock", thread_under_lock), env, args.size() > 2 ? TOO_MANY_ARGS : TOO_FEW_ARGS); + + if (args[0].as_string() != "ilock") + throw MlError(MlValue("thread_under_lock", thread_under_lock), env, UNKNOWN_ERROR); + + + std::lock_guard lockGuard(interpreter_mutex); + + MlValue acc; + for (size_t i = 0; i < args.size(); i++) + acc = args[i].eval(env); + + return acc; + } + + MlValue threads_join(std::vector args, MlEnvironment &env) { + if (args.size() != 0) + throw MlError(MlValue("threads_join", threads_join), env, TOO_MANY_ARGS); + + for (auto &th : threads_register) + if (th.joinable()) th.join(); + + return MlValue::nil(); + } + + MlValue thread_sleep(std::vector args, MlEnvironment &env) { + eval_args(args, env); + + if (args.size() != 1) + throw MlError(MlValue("thread-sleep", thread_sleep), env, args.size() > 1 ? TOO_MANY_ARGS : TOO_FEW_ARGS); + + std::this_thread::sleep_for(std::chrono::milliseconds(args[0].as_int())); + return args[0]; + } } void repl(MlEnvironment &env) { @@ -1819,7 +1883,6 @@ MlValue MlEnvironment::get(const std::string &name) const { if (name == "quote") return MlValue("quote", builtin::quote); if (name == "defun") return MlValue("defun", builtin::defun); if (name == "lambda") return MlValue("lambda", builtin::lambda); - if (name == "benchmark") return MlValue("benchmark", builtin::benchmark); if (name == "and") return MlValue("and", builtin::do_and); if (name == "or") return MlValue("or", builtin::do_or); if (name == "set!") return MlValue("set!", builtin::setx); @@ -1907,6 +1970,15 @@ MlValue MlEnvironment::get(const std::string &name) const { // Constants if (name == "endl") return MlValue::string("\n"); + // Other special forms + if (name == "benchmark") return MlValue("benchmark", builtin::benchmark); + + // Threading operations + if (name == "thread-create") return MlValue("thread-create", builtin::thread_create); + if (name == "thread-under-lock") return MlValue("thread-under-lock", builtin::thread_under_lock); + if (name == "thread-sleep") return MlValue("thread-sleep", builtin::thread_sleep); + if (name == "threads-join") return MlValue("threads-join", builtin::threads_join); + std::map::const_iterator itr = defs.find(name); if (itr != defs.end()) return itr->second; else if (parent_scope != nullptr) { @@ -2004,4 +2076,3 @@ int main(int argc, char *argv[]) { return 1; } -