vaclavt/mlisp
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

define renamed to def, defun renamed to defn

Browse Source
This commit is contained in:
vaclavt
2022-01-25 19:50:59 +01:00
parent 62015c2ff8
commit e6f61c9d9f
14 changed files with 189 additions and 189 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
Readme.md
View File

@@ -6,11 +6,11 @@ is a small lisp interpreter based on Adam McDaniel's wisp interpreter (https://g
### Example of use
```
cat <<EOT > /tmp/qs.lsp
(defun qs (l)
(defn qs (l)
(if (<= (len l) 1)
l
(do
(define pivot (first l))
(def pivot (first l))
(+
(qs (filter (lambda (n) (> pivot n)) l))
(list pivot)
@@ -88,12 +88,10 @@ utils/local_install.sh
#### Code
- tcpnet should use RAII
- add documentation - some code lide (doc::add func_name desc example flags), (doc::help name), (doc::appropos text)
- add more unit test, mainly for usql
- add more unit test, especially for usql
- add instrumentation (time, nr of evals, num of atoms, debug info, debug environment etc)
#### Language
- rename define -> def, defun -> defn
- string functions
- compare - needed for sorting, cmp ignore case
- regexp match, regexp tokens

2
debug.lsp
View File

@@ -1,3 +1,3 @@
(define l '(nil 1 2 3))
(def l '(nil 1 2 3))
(print (filter (lambda (e) (eval e)) l))
(print (filter (lambda (eval e) (print e)) l))

4
doc/Doc.md
View File

@@ -27,8 +27,8 @@
|`(cond (test1 action1) (test2 action2) ... (testn actionn))`|The first clause whose test evaluates to non-nil is selected; all other clauses are ignored, and the consequents of the selected clause are evaluated in order. If none of the test conditions are evaluated to be true, then the cond statement returns nil.|This special form is method of control flow.|Language|
|`(do a b c ...)`|`do` takes a list of s-expressions and evaluates them in the order they were given (in the current scope), and then returns the result of the last s-expression.|This special form allows lambda functions to have multi-step bodies.|Language|
|`(scope a b c ...)`|`scope` takes a list of s-expressions and evaluates them in the order they were given _in a new scope_, and then returns the result of the last s-expression.|This special form allows the user to evaluate blocks of code in new scopes.|Language|
|`(defun name params body)`|`defun` evaluates none of its arguments.|This special form allows the user to conveniently define functions.|Language|
|`(define name value)`|`define` evaluates the `value` argument, which is then assigned to `name` in the current scope.|This special form allows the user to bind atoms to values in a scope.|Language|
|`(defn name params body)`|`defn` evaluates none of its arguments.|This special form allows the user to conveniently define functions.|Language|
|`(def name value)`|`def` evaluates the `value` argument, which is then assigned to `name` in the current scope.|This special form allows the user to bind atoms to values in a scope.|Language|
|`(lambda params body)`|`lambda` evaluates none of its arguments.|This special form allows the user to define anonymous functions.|Language|
|`(quote x)`|`quote` evaluates none of its arguments.|This is equivalent to the `'expr` syntactic sugar.|Language|
|`(for x list ...)`|`for` evaluates only its list argument.|`for` iterates through the list storing each element in `x`, and then evaluating all of the rest of the values in the `for` body. It then returns the last value evaluated.|Language|

12
ml.cpp
View File

@@ -977,7 +977,7 @@ MlValue cond(std::vector<MlValue> args, MlEnvironment &env) {
// Define a variable with a value (SPECIAL FORM)
MlValue define(std::vector<MlValue> args, MlEnvironment &env) {
if (args.size() != 2)
throw MlError(MlValue("define", define), env, args.size() > 2 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
throw MlError(MlValue("def", define), env, args.size() > 2 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
MlValue result = args[1].eval(env);
env.set(args[0].display(), result);
@@ -987,10 +987,10 @@ MlValue define(std::vector<MlValue> args, MlEnvironment &env) {
// Define a function with parameters and a result expression (SPECIAL FORM)
MlValue defun(std::vector<MlValue> args, MlEnvironment &env) {
if (args.size() != 3)
throw MlError(MlValue("defun", defun), env, args.size() > 3 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
throw MlError(MlValue("defn", defun), env, args.size() > 3 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
if (args[1].get_type_name() != LIST_TYPE)
throw MlError(MlValue("defun", defun), env, INVALID_LAMBDA);
throw MlError(MlValue("defn", defun), env, INVALID_LAMBDA);
MlValue f = MlValue(args[1].as_list(), args[2], env);
env.set(args[0].display(), f);
@@ -2100,7 +2100,7 @@ bool MlEnvironment::has(const std::string &name) const {
std::map <const std::string, Builtin> builtin_funcs
{
// Special forms
std::make_pair("define", builtin::define),
std::make_pair("def", builtin::define),
std::make_pair("lambda", builtin::lambda),
std::make_pair("if", builtin::if_then_else),
std::make_pair("cond", builtin::cond),
@@ -2109,7 +2109,7 @@ std::map <const std::string, Builtin> builtin_funcs
std::make_pair("while", builtin::while_loop),
std::make_pair("scope", builtin::scope),
std::make_pair("quote", builtin::quote),
std::make_pair("defun", builtin::defun),
std::make_pair("defn", builtin::defun),
std::make_pair("and", builtin::do_and),
std::make_pair("or", builtin::do_or),
std::make_pair("set!", builtin::setx),
@@ -2225,7 +2225,7 @@ std::map <const std::string, Builtin> builtin_funcs
// Get the value associated with this name in this scope
MlValue MlEnvironment::get(const std::string &name) const {
// PERF, here can be a few of for fast access
if (name == "define") return MlValue("define", builtin::define);
if (name == "defe") return MlValue("def", builtin::define);
if (name == "if") return MlValue("if", builtin::if_then_else);
if (name == "lambda") return MlValue("lambda", builtin::lambda);

6
ml.h
View File

@@ -7,14 +7,14 @@
#include <exception>
#ifdef NDEBUG
const std::string VERSION = "ml 0.4 (" __DATE__ " " __TIME__ "), Release";
const std::string VERSION = "ml 0.5 (" __DATE__ " " __TIME__ "), Release";
#else
const std::string VERSION = "ml 0.4 (" __DATE__ " " __TIME__ "), Debug";
const std::string VERSION = "ml 0.5 (" __DATE__ " " __TIME__ "), Debug";
#endif
const std::string STDLIB_LOADER =
R"(
(do (define ___lib_path "/usr/local/var/mlisp")
(do (def ___lib_path "/usr/local/var/mlisp")
(if (is-dir? ___lib_path)
(for file (ls-dir ___lib_path)
(if (string-regex? file "^stdlib\.lsp$")

4
ml_util.cpp
View File

@@ -5,8 +5,8 @@
#include <vector>
const std::vector<std::string> commands {
"eval", "type", "parse", "do", "if", "for", "while", "scope", "quote", "defun",
"define", "lambda", "benchmark", "=", "!=", ">", "<", ">=", "<=", "+", "-", "*", "/", "%",
"eval", "type", "parse", "do", "if", "for", "while", "scope", "quote", "defn",
"def", "lambda", "benchmark", "=", "!=", ">", "<", ">=", "<=", "+", "-", "*", "/", "%",
"list", "insert", "index", "remove", "len", "push", "pop", "head", "tail", "first", "last",
"range", "map", "filter", "reduce", "exit", "quit", "print", "input", "random", "include",
"read-file", "write-file", "read-url", "system-cmd", "ls-dir", "is-file?", "is-dir?",

46
stdlib/doc.lsp
View File

@@ -1,17 +1,17 @@
(include "/usr/local/var/mlisp/terminal.lsp")
(defun doc::strip-backticks (s)
(defn doc::strip-backticks (s)
(if (and (> (string-len s) 2)
(= (string-substr s 0 1) "`")
(= (string-substr s -1 1) "`"))
(string-substr s 1 (- (string-len s) 2))
s))
(defun doc::read-doc-file (filename)
(do (define parse-line (lambda (ln)
(defn doc::read-doc-file (filename)
(do (def parse-line (lambda (ln)
(if (string-regex? ln "^|.*|")
(do (define tokens (tail (string-split (string-rltrim ln " \n\r\t" "trim") "\|"))) ; first element is ""
(do (def tokens (tail (string-split (string-rltrim ln " \n\r\t" "trim") "\|"))) ; first element is ""
(if (= (len tokens) 4)
(insert tokens 0 (string-replace-re (first (string-split (first tokens) "\s+|\)")) "`|\(" ""))
nil)
@@ -19,19 +19,19 @@
nil)
))
(define lines (string-split (read-file filename) "\n") )
(define lines (map (lambda (ln) (parse-line ln)) lines))
(define lines (filter (lambda (e) (!= e nil)) lines))
(def lines (string-split (read-file filename) "\n") )
(def lines (map (lambda (ln) (parse-line ln)) lines))
(def lines (filter (lambda (e) (!= e nil)) lines))
(set! doc::doc_entries lines)
'loaded
))
(defun doc::print (entry)
(defn doc::print (entry)
(do (print (term-green (doc::strip-backticks (second entry))) "-" (third entry))
; (print (last entry) "\n") ; doc section
(if (> (string-len (fourth entry)) 2)
(do (define examp (doc::strip-backticks (fourth entry)))
(define pos (string-find examp "=>" 0))
(do (def examp (doc::strip-backticks (fourth entry)))
(def pos (string-find examp "=>" 0))
(if (and pos (> pos 0))
(print (term-magenta
(+ (string-substr examp 0 (- pos 1))
@@ -43,21 +43,21 @@
nil
))
(defun doc::man (what)
(do (define man (filter (lambda (x) (= (first x) what)) doc::doc_entries))
(defn doc::man (what)
(do (def man (filter (lambda (x) (= (first x) what)) doc::doc_entries))
(if man
(doc::print (first man))
(print (term-red (+ "No entry for " what)))
)
))
(defun doc::look (what)
(do (define what_list (string-split (string-downcase what) "\s+"))
(define scores '()) ; ((score entry)..)
(defn doc::look (what)
(do (def what_list (string-split (string-downcase what) "\s+"))
(def scores '()) ; ((score entry)..)
(for entry doc::doc_entries
; ("throw-exception" "`(throw-exception exp_desc)`" "Throws an exception with exp_desc describing what happened " "" "Exceptions"
(define entry_score 0)
(def entry_score 0)
(for kw what_list
; name matches
(if (= (string-downcase (first entry)) kw)
@@ -73,23 +73,23 @@
(set! scores (push scores (list entry_score entry))))
)
(define sorted (quick-sort-by scores (lambda (a b) (< (first a) (first b)))))
(def sorted (quick-sort-by scores (lambda (a b) (< (first a) (first b)))))
(for e (take sorted 10)
(define entry (second e))
(define call (doc::strip-backticks (second entry)))
(define desc (doc::strip-backticks (third entry)))
(def entry (second e))
(def call (doc::strip-backticks (second entry)))
(def desc (doc::strip-backticks (third entry)))
(print (term-red (first entry)) "-" (term-green (doc::strip-backticks (second entry))) "-" (third entry))
)
(if (> (len sorted) 10) (print "..."))
))
(defun doc::appropos (which)
(defn doc::appropos (which)
(doc::look which))
;(defun doc::section (which)
;(defn doc::section (which)
; (print (term-red "implement me!")))
(define doc::doc_entries '()) ; must be here
(def doc::doc_entries '()) ; must be here
; read doc into memory
(doc::read-doc-file "/usr/local/var/mlisp/Doc.md")

180
stdlib/stdlib.lsp
View File

@@ -1,72 +1,72 @@
; not a bool
(defun not (x) (if x nil #t))
(defn not (x) (if x nil #t))
(defun is-pos? (n) (> n nil))
(defun is-neg? (n) (< n nil))
(defn is-pos? (n) (> n nil))
(defn is-neg? (n) (< n nil))
(defun neg (n) (- 0 n))
(defun dec (n) (- n 1))
(defun inc (n) (+ n 1))
(defn neg (n) (- 0 n))
(defn dec (n) (- n 1))
(defn inc (n) (+ n 1))
(defun string-ltrim (str)
(defn string-ltrim (str)
(string-rltrim str " \n\r\t" "ltrim"))
(defun string-rtrim (str)
(defn string-rtrim (str)
(string-rltrim str " \n\r\t" "rtrim"))
(defun string-trim (str)
(defn string-trim (str)
(string-rltrim str " \n\r\t" "trim"))
(defun string-rpad (str length pad_char)
(defn string-rpad (str length pad_char)
(string-pad str length pad_char "rpad"))
(defun string-lpad (str length pad_char)
(defn string-lpad (str length pad_char)
(string-pad str length pad_char "lpad"))
(defun string-upcase (str)
(defn string-upcase (str)
(string-case str "upper"))
(defun string-downcase (str)
(defn string-downcase (str)
(string-case str "lower"))
(defun string-join (lst sep)
(defn string-join (lst sep)
(do
(define rslt "")
(define i 0)
(def rslt "")
(def i 0)
(for e lst
(if (= i 0)
(do (define rslt (display e)) (define i 1))
(define rslt (+ rslt (display sep) (display e)))
(do (def rslt (display e)) (def i 1))
(def rslt (+ rslt (display sep) (display e)))
))
rslt
))
(defun itok (ascii) (sprintf "%c" (list ascii)))
(defun ktoi (char) (int (sprintf "%d" (list char))))
(defn itok (ascii) (sprintf "%c" (list ascii)))
(defn ktoi (char) (int (sprintf "%d" (list char))))
; pause for interval of seconds
(defun sleep (time)
(defn sleep (time)
(system-cmd (+ "sleep " (string time))))
(defun get-env (var)
(defn get-env (var)
(second (system-cmd (+ "echo ${" var "} | tr -d \"\n\""))))
(defun third (l) (index l 2))
(defun fourth (l) (index l 3))
(defun fifth (l) (index l 4))
(defun sixth (l) (index l 5))
(defun seventh (l) (index l 6))
(defun eight (l) (index l 7))
(defun nineth (l) (index l 8))
(defun tenth (l) (index l 9))
(defun nth (i l) (index l (- i 1)))
(defn third (l) (index l 2))
(defn fourth (l) (index l 3))
(defn fifth (l) (index l 4))
(defn sixth (l) (index l 5))
(defn seventh (l) (index l 6))
(defn eight (l) (index l 7))
(defn nineth (l) (index l 8))
(defn tenth (l) (index l 9))
(defn nth (i l) (index l (- i 1)))
; return 1 when list contains item otherwise nil
(defun member (lst itm)
(defn member (lst itm)
(do
; TODO check if is empty list
(define found_index -1)
(define i 0)
(define lst_len (len lst))
(def found_index -1)
(def i 0)
(def lst_len (len lst))
(while (and (< i lst_len) (= found_index -1))
(if (= itm (index lst i))
@@ -79,59 +79,59 @@
nil)
))
(defun make-list-of (size val)
(defn make-list-of (size val)
(do
(define lst '())
(define i 0)
(def lst '())
(def i 0)
(while (< i size)
(define lst (push lst val))
(define i (inc i)))
(def lst (push lst val))
(def i (inc i)))
lst
))
(defun make-list (size)
(defn make-list (size)
(make-list-of size nil))
(defun empty-list? (lst) (and (= (type lst) "list") (= (len lst) 0)))
(defn empty-list? (lst) (and (= (type lst) "list") (= (len lst) 0)))
(defun uniq (lst)
(defn uniq (lst)
(do
(define rslt '())
(define i 0)
(define lst_len (len lst))
(def rslt '())
(def i 0)
(def lst_len (len lst))
(while (< i lst_len)
(define e (index lst i))
(def e (index lst i))
(if (not (member rslt e))
(define rslt (push rslt e)))
(def rslt (push rslt e)))
(define i (inc i)))
(def i (inc i)))
rslt
))
(defun flatten (lst)
(defn flatten (lst)
(do
(define rslt '())
(def rslt '())
(for e lst
(if (= (type e) "list")
(do
(for ee (flatten e)
(define rslt (push rslt ee))))
(define rslt (push rslt e))
(def rslt (push rslt ee))))
(def rslt (push rslt e))
))
rslt
))
(defun take (lst n)
(defn take (lst n)
(if (> (len lst) n)
(map (lambda (i) (index lst i)) (range 0 n))
lst))
(defun quick-sort-by (l cmp)
(defn quick-sort-by (l cmp)
(if (<= (len l) 1)
l
(do
(define pivot (first l))
(def pivot (first l))
(+
(quick-sort-by (filter (lambda (n) (cmp pivot n)) l) cmp)
(list pivot)
@@ -139,57 +139,57 @@
))
))
(defun quick-sort (l)
(defn quick-sort (l)
(quick-sort-by l (lambda (a b) (> a b))))
(defun quick-sort-reverse (l)
(defn quick-sort-reverse (l)
(quick-sort-by l (lambda (a b) (> b a))))
(defun start-of-day (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m-%d") " " "00:00:00") "%Y-%m-%d %H:%M:%S"))
(defun end-of-day (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m-%d") " " "23:59:59") "%Y-%m-%d %H:%M:%S"))
(defun start-of-month (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m") "-01 00:00:00") "%Y-%m-%d %H:%M:%S"))
(defun start-of-next-month (datetime) (date-add (start-of-month datetime) 1 "month"))
(defun end-of-next-month (datetime) (date-add (end-of-month datetime) 1 "month"))
(defun end-of-month (datetime) (date-add (date-add (start-of-month datetime) 1 "month") -1 "second"))
(defun start-of-prev-month (datetime) (date-add (start-of-month datetime) -1 "month"))
(defun end-of-prev-month (datetime) (date-add (end-of-month datetime) -1 "month"))
(defun start-of-year (datetime) (str-to-date (+ (date-to-str datetime "%Y") "-01-01 00:00:00") "%Y-%m-%d %H:%M:%S"))
(defun end-of-year (datetime) (str-to-date (+ (date-to-str datetime "%Y") "-12-31 23:59:59") "%Y-%m-%d %H:%M:%S"))
(defn start-of-day (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m-%d") " " "00:00:00") "%Y-%m-%d %H:%M:%S"))
(defn end-of-day (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m-%d") " " "23:59:59") "%Y-%m-%d %H:%M:%S"))
(defn start-of-month (datetime) (str-to-date (+ (date-to-str datetime "%Y-%m") "-01 00:00:00") "%Y-%m-%d %H:%M:%S"))
(defn start-of-next-month (datetime) (date-add (start-of-month datetime) 1 "month"))
(defn end-of-next-month (datetime) (date-add (end-of-month datetime) 1 "month"))
(defn end-of-month (datetime) (date-add (date-add (start-of-month datetime) 1 "month") -1 "second"))
(defn start-of-prev-month (datetime) (date-add (start-of-month datetime) -1 "month"))
(defn end-of-prev-month (datetime) (date-add (end-of-month datetime) -1 "month"))
(defn start-of-year (datetime) (str-to-date (+ (date-to-str datetime "%Y") "-01-01 00:00:00") "%Y-%m-%d %H:%M:%S"))
(defn end-of-year (datetime) (str-to-date (+ (date-to-str datetime "%Y") "-12-31 23:59:59") "%Y-%m-%d %H:%M:%S"))
; from list of lists creates csv string
; (print (make-csv '(("r1c1" "r1c2") ("r2c1" "r2c2"))))
(defun make-csv (csv_list)
(defn make-csv (csv_list)
(do
(define rows_str "")
(define r 0)
(def rows_str "")
(def r 0)
(for row csv_list
(define cols_str "")
(define c 0)
(def cols_str "")
(def c 0)
(for col row
(if (= c 0)
(define cols_str col)
(define cols_str (+ cols_str "," (display col))))
(define c (inc c)))
(def cols_str col)
(def cols_str (+ cols_str "," (display col))))
(def c (inc c)))
(if (= r 0)
(define rows_str cols_str)
(define rows_str (+ rows_str "\n" cols_str)))
(define r (inc r)))
(def rows_str cols_str)
(def rows_str (+ rows_str "\n" cols_str)))
(def r (inc r)))
rows_str
))
; looks into lst's elements and when there is a list with first item with name, it returns the _second_ element of that list
(defun find-val-in-list (lst name)
(defn find-val-in-list (lst name)
(do
(define found_val nil)
(define i 0)
(def found_val nil)
(def i 0)
(define list_len (len lst))
(def list_len (len lst))
(while (and (>= i 0) (< i list_len))
(define e (index lst i))
(def e (index lst i))
(set! i (inc i))
(if (= (type e) "list")
(if (= (type (first e)) "list")
@@ -223,12 +223,12 @@
))
(defun min (l)
(defn min (l)
(if (or (not l) (= (len l) 0))
nil
(do
(define minn (index l 0))
(define i 1)
(def minn (index l 0))
(def i 1)
(while (< i (len l))
(if (< (index l i) minn)
(set! minn (index l i)))
@@ -238,12 +238,12 @@
)
))
(defun max (l)
(defn max (l)
(if (or (not l) (= (len l) 0))
nil
(do
(define maxx (index l 0))
(define i 1)
(def maxx (index l 0))
(def i 1)
(while (< i (len l))
(if (> (index l i) maxx)
(set! maxx (index l i)))

38
stdlib/terminal.lsp
View File

@@ -1,22 +1,22 @@
(define term-rst-esc "\x1B[0m")
(define term-red-esc '"\x1B[31m")
(define term-green-esc "\x1B[32m")
(define term-yellow-esc "\x1B[33m")
(define term-blue-esc "\x1B[34m")
(define term-magenta-esc "\x1B[35m")
(define term-cyan-esc "\x1B[36m")
(define term-white-esc "\x1B[37m")
(define term-bold-esc "\x1B[1m")
(define term-underline-esc "\x1B[4m")
(def term-rst-esc "\x1B[0m")
(def term-red-esc '"\x1B[31m")
(def term-green-esc "\x1B[32m")
(def term-yellow-esc "\x1B[33m")
(def term-blue-esc "\x1B[34m")
(def term-magenta-esc "\x1B[35m")
(def term-cyan-esc "\x1B[36m")
(def term-white-esc "\x1B[37m")
(def term-bold-esc "\x1B[1m")
(def term-underline-esc "\x1B[4m")
(defun term-red (str) (sprintf (+ term-red-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-green (str) (sprintf (+ term-green-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-yellow (str) (sprintf (+ term-yellow-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-blue (str) (sprintf (+ term-blue-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-magenta (str) (sprintf (+ term-magenta-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-cyan (str) (sprintf (+ term-cyan-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-white (str) (sprintf (+ term-white-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-bold (str) (sprintf (+ term-bold-esc (string-replace str "%" "%%") term-rst-esc)))
(defun term-underline (str) (sprintf (+ term-underline-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-red (str) (sprintf (+ term-red-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-green (str) (sprintf (+ term-green-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-yellow (str) (sprintf (+ term-yellow-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-blue (str) (sprintf (+ term-blue-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-magenta (str) (sprintf (+ term-magenta-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-cyan (str) (sprintf (+ term-cyan-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-white (str) (sprintf (+ term-white-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-bold (str) (sprintf (+ term-bold-esc (string-replace str "%" "%%") term-rst-esc)))
(defn term-underline (str) (sprintf (+ term-underline-esc (string-replace str "%" "%%") term-rst-esc)))

26
stdlib/ut.lsp
View File

@@ -1,23 +1,23 @@
(include "/usr/local/var/mlisp/terminal.lsp")
(defun ut::assert-equal (expected form) (do
(define returned (eval form))
(defn ut::assert-equal (expected form) (do
(def returned (eval form))
(if (= expected returned)
(list #t expected returned)
(list nil expected returned))
))
(defun ut::assert-true (test) (ut::assert-equal #t test))
(defun ut::assert-false (test) (ut::assert-equal nil test))
(defun ut::assert-nil (test) (ut::assert-false test))
(defn ut::assert-true (test) (ut::assert-equal #t test))
(defn ut::assert-false (test) (ut::assert-equal nil test))
(defn ut::assert-nil (test) (ut::assert-false test))
(defun ut::define-test (name exp_list)
(defn ut::define-test (name exp_list)
(set! ut::tests_list (push ut::tests_list (list name exp_list))))
(defun ut::exec-test (test_name code) (do
(define test_result (eval code))
(defn ut::exec-test (test_name code) (do
(def test_result (eval code))
(if (first test_result)
(do (print (+ (term-green "OK") " -> " test_name))
#t
@@ -28,15 +28,15 @@
))
))
(defun ut::run-test (name)
(defn ut::run-test (name)
(for t ut::tests_list
(if (= (first t) name)
(ut::exec-test (first t) (second t)))
))
(defun ut::run-tests () (do
(define oks 0)
(define errs 0)
(defn ut::run-tests () (do
(def oks 0)
(def errs 0)
(for t ut::tests_list
(if (ut::exec-test (first t) (second t))
(set! oks (+ oks 1))
@@ -48,7 +48,7 @@
(print (term-red (+ (string errs) " test(s) FAILED"))))
))
(define ut::tests_list '())
(def ut::tests_list '())
;; example of usage

26
tests/test.lsp
View File

@@ -1,30 +1,30 @@
(include "/usr/local/var/mlisp/ut.lsp")
(define local_time_offset 3600)
(def local_time_offset 3600)
;; prepare some code to be used in tests
(defun fact (n)
(defn fact (n)
(if (<= n 1)
1
(* n (fact (- n 1)))
))
; for scitej 4000 stack must be 16MB, otherwise 1000 is ok
(defun scitej (n)
(defn scitej (n)
(if (<= n 1)
1
(+ n (scitej (- n 1)))
))
(write-file "/tmp/f.txt" "line 1\nline 2\nline3")
(define counter (lambda (ln) (do (set! ii (+ ii 1)) )))
(define ii 0)
(def counter (lambda (ln) (do (set! ii (+ ii 1)) )))
(def ii 0)
(define a 20)
(define b 30)
(def a 20)
(def b 30)
(define json_list (parse-json "{\"k1\":\"v1\", \"k2\":42, \"k3\":[\"a\",123,true,false,null]}"))
(define fvil_list '(("a" ("av" "avv")) ("b" "bv") (31 32 33) (41 42 43)))
(def json_list (parse-json "{\"k1\":\"v1\", \"k2\":42, \"k3\":[\"a\",123,true,false,null]}"))
(def fvil_list '(("a" ("av" "avv")) ("b" "bv") (31 32 33) (41 42 43)))
(thread-create (tcp-server 7778 (lambda (str) (list #t (+ "(print \"" (string-upcase str) "\")")))))
@@ -38,14 +38,14 @@
(ut::define-test "result of (not 1)" '(ut::assert-false (not 1)))
(ut::define-test "result of (not nil)" '(ut::assert-true (not nil)))
(ut::define-test "result of (if '() \"true\" \"empty list/nil\")" '(ut::assert-equal "\"empty list/nil\"" (if '() "true" "empty list/nil")))
(ut::define-test "result of (if '() \"true\" \"empty list/nil\")" '(ut::assert-equal "empty list/nil" (if '() "true" "empty list/nil")))
(ut::define-test "result of (define a 20) (cond ((> a 30)" '(ut::assert-equal "a <= 20" (cond ((> a 30) "a > 30") ((> a 20) "a > 20")(#t "a <= 20"))))
(ut::define-test "result of (define b 30) (cond ((> b 30)" '(ut::assert-equal "b > 20" (cond ((> b 30) "b > 30") ((> b 20) "b > 20")(#t "b <= 20"))))
(ut::define-test "result of (def a 20) (cond ((> a 30)" '(ut::assert-equal "a <= 20" (cond ((> a 30) "a > 30") ((> a 20) "a > 20")(#t "a <= 20"))))
(ut::define-test "result of (def b 30) (cond ((> b 30)" '(ut::assert-equal "b > 20" (cond ((> b 30) "b > 30") ((> b 20) "b > 20")(#t "b <= 20"))))
(ut::define-test "result of (member '(1 2 3) 1" '(ut::assert-true (member '(1 2 3) 1)))
(ut::define-test "result of (member '(1 2 3) 3" '(ut::assert-true (member '(1 2 3) 3)))
(ut::define-test "result of (member '(1 2 3) 4" '(ut::assert-false (take '(1 2 3) 4)))
(ut::define-test "result of (member '(1 2 3) 4" '(ut::assert-false (member '(1 2 3) 4)))
(ut::define-test "result of (take '(1 2 3 4) 3" '(ut::assert-equal '(1 2 3) (take '(1 2 3 4) 3)))

4
utils/Lisp.tmLanguage
View File

@@ -51,7 +51,7 @@
</dict>
</dict>
<key>match</key>
<string>(?:\()((?i:defun|define|lambda)+)</string>
<string>(?:\()((?i:defn|def|lambda)+)</string>
<key>name</key>
<string>meta.function.lisp</string>
</dict>
@@ -136,7 +136,7 @@
</dict>
<dict>
<key>match</key>
<string>(?<=\()(?i:\*|\*\*|\*\*\*|\+|\+\+|\+\+\+|\-|/|//|///|/=|1\+|1\-|<|<=|=|>|>=|if|cond|do|for|while|scope|quote|defun|and|or|set!|eval|type|parse|list|insert|index|remove|len|push|pop|head|tail|first|last|range|map|filter|reduce|exit|quit|print|input|random|include|read-file|read-file-lines|write-file|read-url|system-cmd|ls-dir|is-file?|is-dir?|tcp-server|tcp-client|parse-csv|parse-json|get-universal-time|date-to-str|str-to-date|date-add|debug|sprintf|display|string-replace|string-replace-re|string-regex?|string-regex-list|string-split|string-pad|string-rltrim|string-case|string-len|string-substr|string-find|benchmark|thread-create|thread-under-lock|thread-sleep|threads-join|try|throw|usql|first|second|third|fourth|fifth|sixth|seventh|eight|nth|print|get-universal-time|not|is-pos?|is-neg?|neg|dec|inc|string-ltrim|string-rtrim|string-trim|string-rpad|string-lpad|string-upcase|string-downcase|string-join|itok|ktoi|sleep|get-env|member|make-list-of|make-list|empty-list?|uniq|flatten|quick-sort-by|quick-sort|quick-sort-reverse|start-of-day|end-of-day|start-of-month|start-of-next-month|end-of-next-month|end-of-month|start-of-prev-month|end-of-prev-month|start-of-year|end-of-year|make-csv)(?=\s+)</string>
<string>(?<=\()(?i:\*|\*\*|\*\*\*|\+|\+\+|\+\+\+|\-|/|//|///|/=|1\+|1\-|<|<=|=|>|>=|if|cond|do|for|while|scope|quote|defn|and|or|set!|eval|type|parse|list|insert|index|remove|len|push|pop|head|tail|first|last|range|map|filter|reduce|exit|quit|print|input|random|include|read-file|read-file-lines|write-file|read-url|system-cmd|ls-dir|is-file?|is-dir?|tcp-server|tcp-client|parse-csv|parse-json|get-universal-time|date-to-str|str-to-date|date-add|debug|sprintf|display|string-replace|string-replace-re|string-regex?|string-regex-list|string-split|string-pad|string-rltrim|string-case|string-len|string-substr|string-find|benchmark|thread-create|thread-under-lock|thread-sleep|threads-join|try|throw|usql|first|second|third|fourth|fifth|sixth|seventh|eight|nth|print|get-universal-time|not|is-pos?|is-neg?|neg|dec|inc|string-ltrim|string-rtrim|string-trim|string-rpad|string-lpad|string-upcase|string-downcase|string-join|itok|ktoi|sleep|get-env|member|make-list-of|make-list|empty-list?|uniq|flatten|quick-sort-by|quick-sort|quick-sort-reverse|start-of-day|end-of-day|start-of-month|start-of-next-month|end-of-next-month|end-of-month|start-of-prev-month|end-of-prev-month|start-of-year|end-of-year|make-csv)(?=\s+)</string>
<key>name</key>
<string>keyword.control.lisp</string>
</dict>

2
utils/local_install.sh
View File

@@ -17,6 +17,8 @@ cp ./build/ml /usr/local/bin/ml
echo ""
echo "if syntax has changed you may use"
echo "cp utils/Lisp.tmLanguage ~/.vscode/extensions/mattn.lisp-0.1.12/syntaxes/"
echo "or"
echo "cp utils/Lisp.tmLanguage ~/.vscode/extensions/mattn.lisp-0.1.12/syntaxes/"
echo ""
ml -v

20
wip.lsp
View File

@@ -1,4 +1,4 @@
(define l '(nil 1 2 3))
(def l '(nil 1 2 3))
(print (filter (lambda (e) (eval e)) l))
(print (filter (lambda (eval e) (print e)) l))
@@ -10,13 +10,13 @@
(thread-sleep 1)
(thread-create
(define code (tcp-client "127.0.0.1" 7777 ("abcd" "xyz")))
(def code (tcp-client "127.0.0.1" 7777 ("abcd" "xyz")))
(for c code
(print "executing code:" c)
(eval (parse c))
)
(define code (tcp-client "127.0.0.1" 7777 "abcd"))
(def code (tcp-client "127.0.0.1" 7777 "abcd"))
(print "executing code:" code)
(eval (parse code))
)
@@ -41,9 +41,9 @@
;; (define create_tbl_sql "create table prices (datetime integer, symbol varchar(8), prev_close float, open float, price float, change float, change_prct varchar(16))")
;; (define insert_sql "insert into prices (datetime, symbol, prev_close, open, price, change, change_prct) values (1626979443, 'MPC', 54.08, 53.82, 53.63, -0.832101, '-0.83 %')")
;; (define select_sql "select to_string(datetime, '%d.%m.%Y %H:%M:%S'), symbol, prev_close, open, price, change, change_prct from prices")
;; (def create_tbl_sql "create table prices (datetime integer, symbol varchar(8), prev_close float, open float, price float, change float, change_prct varchar(16))")
;; (def insert_sql "insert into prices (datetime, symbol, prev_close, open, price, change, change_prct) values (1626979443, 'MPC', 54.08, 53.82, 53.63, -0.832101, '-0.83 %')")
;; (def select_sql "select to_string(datetime, '%d.%m.%Y %H:%M:%S'), symbol, prev_close, open, price, change, change_prct from prices")
;; (print (usql create_tbl_sql))
@@ -61,11 +61,11 @@
;; (read-url "https://api.nasdaq.com/api/calendar/dividends/")
;; (define fc 5)
;; (define sc 5)
;; (def fc 5)
;; (def sc 5)
;; (define first_tid (thread-create (while (> fc 0) (do (thread-under-lock "ilock" (do (set! fc (dec fc))(print 1))) (thread-sleep 500)))))
;; (define second_tid (thread-create (while (> sc 0) (do (thread-under-lock "ilock" (do (set! sc (dec sc))(print 2))) (thread-sleep 750)))))
;; (def first_tid (thread-create (while (> fc 0) (do (thread-under-lock "ilock" (do (set! fc (dec fc))(print 1))) (thread-sleep 500)))))
;; (def second_tid (thread-create (while (> sc 0) (do (thread-under-lock "ilock" (do (set! sc (dec sc))(print 2))) (thread-sleep 750)))))
;; (print "first thread id:" first_tid)
;; (print "second thread id:" second_tid)