#t and #f added to language, datetime fixes

Readme.md

@@ -71,18 +71,16 @@ utils/local_install.sh
 - add some mem stats to benchmark
 
 #### Code
+- MlEnvironment::get should be map instead of many if's
 - add documentation
 - add more unit test, mainly for usql
-- rename constants in ml_profiler.h
 - add instrumentation (time, nr of evals, num of atoms, debug info, debug environment etc)
 
 #### Language
-- support for "#t" or "t" symbol as a true and "#f" for false
 - string functions
     - compare - needed for sorting, cmp ignore case
     - regexp match, regexp tokens    
 - date support
-  - local-time - convert epoch to local time
   - decode-universal-time (http://www.lispworks.com/documentation/HyperSpec/Body/f_dec_un.htm)
 - env functions 
   - get-env, set-env; set-env cannot be implemented in stdlib.lsp, because popen is in fact subshell

clib/json11.cpp

@@ -141,7 +141,7 @@ namespace json11 {
     }
 
     static MlValue ivalualize(bool value) {
-	    return MlValue((long)value);
+	    return MlValue(value);
     }
 
     static MlValue ivalualize(const string &value) {

debug.lsp

@@ -1,8 +1,7 @@
-(print (str-to-date "2021-10-11 16:57:00" "%Y-%m-%d %H:%M:%S"))
+;; (include "/usr/local/var/mlisp/ut.lsp")
-(print (date-to-str 1633971420 "%Y-%m-%d %H:%M:%S"))
+;; (ut::define-test "result of (get-localtime-offset)" '(ut::assert-equal 7200 (get-localtime-offset)))
+;; (ut::run-tests)
 
-;; (define time (get-universal-time))
-;; (str-to-date (date-to-str time "%Y-%m-%d %H:%M:%S") "%Y-%m-%d %H:%M:%S")
 
 
 ;; (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))")
@@ -16,11 +15,6 @@
 
 ;; (print (usql "select to_string(datetime, '%d.%m.%Y %H:%M:%S'), symbol, prev_close, open, price, change, change_prct from prices"))
 
-;; (define var "promena var")
-;; (define var2 "promena var2")
-;; (print var)
-;; (print var2)
-
 ;;  (print (+ "select min(adjClose), max(adjClose) from history_prices where symbol = '" var "'"))
 
 ;; (print (usql "create table data (ticker varchar(8), price float null)"))

doc/Doc.md

@@ -6,6 +6,7 @@
 |-c code|Runs given code|
 |-f source_file ..|Executes code in files|
 |-i|Runs REPL|
+|-d|Turns on better stacktrace|
 |-p|Prints profile info at the end|
 |-v|Prints version string|
 
@@ -22,6 +23,7 @@
 |Special Form|Argument Evaluations|Purpose|
 |:-|-|-|
 |`(if cond a b)`|`if` only evaluates its `cond` argument. If `cond` is truthy (non-zero), then `a` is evaluated. Otherwise, `b` is evaluated.|This special form is the main method of control flow.|
+|`(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.|
 |`(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.|
 |`(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.|
 |`(defun name params body)`|`defun` evaluates none of its arguments.|This special form allows the user to conveniently define functions.|
@@ -85,6 +87,7 @@
 |`(parse-json json_string)`|Parse JSON string||
 |`(save-csv ..)`|||
 |`(get-universal-time)`|Get current time as secs from epoch||
+|`(get-localtime-offset)`|Offset in seconds between local time and gmt time||
 |`(date-to-str date format)`|Converts date to formated string. Format is strftime format (https://www.tutorialspoint.com/c_standard_library/c_function_strftime.htm)|`>>> (date-to-str (get-universal-time) "%Y-%m-%d %H:%M:%S")
  => "2021-03-13 19:53:01"`|
 |`(str-to-date string format)`|Converst string to time of secs since epoch. |`>>> (str-to-date "2021-03-13 19:53:01" "%Y-%m-%d %H:%M:%S") => 1615665181`|

ml.cpp

@@ -51,6 +51,7 @@
 #define INT_TYPE "int"
 #define FLOAT_TYPE "float"
 #define NIL_TYPE "nil"
+#define TRUE_TYPE "#t"
 #define FUNCTION_TYPE "function"
 #define ATOM_TYPE "atom"
 #define QUOTE_TYPE "quote"
@@ -70,11 +71,8 @@ MlValue::MlValue(long i) : type(INT) { stack_data.i = i; }
 MlValue::MlValue(double f) : type(FLOAT) { stack_data.f = f; }
 
 MlValue::MlValue(bool b) {
-	if (b) {
+	if (b) type = TRUE;
-		type = INT;
+	else type = NIL;
-		stack_data.i = 1;
-	}
-	else { type = NIL; }
 }
 
 MlValue::MlValue(const std::vector<MlValue> &list) : type(LIST), list(list) {}
@@ -186,7 +184,7 @@ bool MlValue::is_list() const {
 }
 
 bool MlValue::as_bool() const {
-	return type != NIL && *this != MlValue(0l);        // TODO remove 0 as false
+	return type != NIL;
 }
 
 long MlValue::as_int() const {
@@ -313,6 +311,8 @@ bool MlValue::operator==(MlValue other) const {
 			return list[0] == other.list[0];
 		case NIL:
 			return other.type == NIL;
+		case TRUE:
+			return other.type == TRUE;
 		default:
 			return true;
 	}
@@ -515,6 +515,8 @@ std::string MlValue::get_type_name() const {
 			return FUNCTION_TYPE;
 		case NIL:
 			return NIL_TYPE;
+		case TRUE:
+			return TRUE_TYPE;
 		default:
 			// This should never be reached.
 			throw MlError(*this, MlEnvironment(), INTERNAL_ERROR);
@@ -550,6 +552,8 @@ std::string MlValue::display() const {
 			return "<" + str + " at " + std::to_string(long(stack_data.b)) + ">";
 		case NIL:
 			return "nil";
+		case TRUE:
+			return "#t";
 		default:
 			// This should never be reached.
 			throw MlError(*this, MlEnvironment(), INTERNAL_ERROR);
@@ -589,6 +593,8 @@ std::string MlValue::debug() const {
 			return "<" + str + " at " + std::to_string(long(stack_data.b)) + ">";
 		case NIL:
 			return "nil";
+		case TRUE:
+			return "#t";
 		default:
 			// This should never be reached.
 			throw MlError(*this, MlEnvironment(), INTERNAL_ERROR);
@@ -840,6 +846,10 @@ MlValue parse(std::string &s, int &ptr) {
 		skip_whitespace(s, ptr);
 		if (x == "nil")
 			return MlValue::nil();
+		else if(x == "#f")
+			return MlValue(false);
+		else if (x == "#t")
+			return MlValue(true);
 		else
 			return MlValue::atom(x);
 
@@ -872,6 +882,9 @@ std::vector<MlValue> parse(std::string s) {
 MlValue run(const std::string &code, MlEnvironment &env) {
 	// Parse the code
 	std::vector<MlValue> parsed = parse(code);
+	if (parsed.empty())
+		return MlValue::nil();
+
 	// Iterate over the expressions and evaluate them
 	// in this environment.
 	for (size_t i = 0; i < parsed.size() - 1; i++)
@@ -1033,7 +1046,7 @@ MlValue do_and(std::vector<MlValue> args, MlEnvironment &env) {
 	for (size_t i = 0; i < args.size(); i++)
 		if (!args[i].eval(env).as_bool()) return MlValue::nil();
 
-	return MlValue{1l};
+	return MlValue{true};
 }
 
 // Evaluate logical or on a list of expressions (SPECIAL FORM)
@@ -1042,7 +1055,7 @@ MlValue do_or(std::vector<MlValue> args, MlEnvironment &env) {
 		throw MlError(MlValue("or", do_or), env, TOO_FEW_ARGS);
 
 	for (size_t i = 0; i < args.size(); i++)
-		if (args[i].eval(env).as_bool()) return MlValue{1l};
+		if (args[i].eval(env).as_bool()) return MlValue{true};
 
 	return MlValue::nil();
 }
@@ -1153,7 +1166,7 @@ MlValue write_file(std::vector<MlValue> args, MlEnvironment &env) {
 	if (args.size() != 2)
 		throw MlError(MlValue("write-file", write_file), env, args.size() > 2 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
 
-	return MlValue((long) write_file_contents(args[0].as_string(), args[1].as_string()));
+	return MlValue(write_file_contents(args[0].as_string(), args[1].as_string()));
 }
 
 // Read URL to (code content)
@@ -1210,6 +1223,16 @@ MlValue get_universal_time(std::vector<MlValue> args, MlEnvironment &env) {
 	return MlValue(now());
 }
 
+// Get offsets in secs between local timezone and gmt
+MlValue get_localtime_offset(std::vector<MlValue> args, MlEnvironment &env) {
+	eval_args(args, env);
+
+	if (args.size() != 0)
+		throw MlError(MlValue("get-localtime-offset", get_localtime_offset), env, TOO_MANY_ARGS);
+
+	return MlValue(get_gmt_localtime_offset());
+}
+
 // Converts date to formated string.
 MlValue date_to_str(std::vector<MlValue> args, MlEnvironment &env) {
 	eval_args(args, env);
@@ -1624,7 +1647,7 @@ MlValue string_regex(std::vector<MlValue> args, MlEnvironment &env) {
 	if (args.size() != 2)                // if (args.size() < 2 || args.size() > 3)
 		throw MlError(MlValue("string-regex?", string_regex), env, args.size() > 2 ? TOO_MANY_ARGS : TOO_FEW_ARGS);
 
-	return MlValue((long) regexp_search(args[0].as_string(), args[1].as_string()));
+	return MlValue(regexp_search(args[0].as_string(), args[1].as_string()));
 }
 
 // Splits string by regexp and returns list containing splited parts
@@ -2042,6 +2065,7 @@ MlValue MlEnvironment::get(const std::string &name) const {
 
 	// Datetime operations
 	if (name == "get-universal-time") return MlValue("get-universal-time", builtin::get_universal_time);
+	if (name == "get-localtime-offset") return MlValue("get-localtime-offset", builtin::get_localtime_offset);
 	if (name == "date-to-str") return MlValue("date-to-str", builtin::date_to_str);
 	if (name == "str-to-date") return MlValue("str-to-date", builtin::str_to_date);
 	if (name == "date-add") return MlValue("date-add", builtin::date_add);

ml.h

@@ -6,7 +6,7 @@
 #include <sstream>
 #include <exception>
 
-const std::string VERSION = "ml 0.3 (" __DATE__ " " __TIME__ ")";
+const std::string VERSION = "ml 0.4 (" __DATE__ " " __TIME__ ")";
 
 const std::string STDLIB_LOADER =
 	 R"(
@@ -177,7 +177,8 @@ private:
         STRING,
         LAMBDA,
         BUILTIN,
-        NIL
+        NIL,
+        TRUE
     } type;
 
     union {

ml_date.cpp

@@ -8,6 +8,14 @@ long now() {	// get-universal-time
 	return now;
 }
 
+long get_gmt_localtime_offset() {
+	std::time_t current_time;
+	std::time(&current_time);
+	struct std::tm *timeinfo = std::localtime(&current_time);
+	long offset = timeinfo->tm_gmtoff;
+	return offset;
+}
+
 std::string date_to_string(const long datetime, const std::string format) {
 	// std::locale::global(std::locale("en-US.UTF8"));
 
@@ -56,7 +64,7 @@ long string_to_date(const std::string &datestr, const std::string &format) {
 	    struct tm * timeinfo;
                 
 	    time(&curTime );
-	    timeinfo = localtime(&curTime);
+	    timeinfo = std::gmtime(&curTime);
                 
 	    timeinfo->tm_year = tm.tm_year;
 	    timeinfo->tm_mon = tm.tm_mon;
@@ -65,9 +73,7 @@ long string_to_date(const std::string &datestr, const std::string &format) {
 	    timeinfo->tm_min = tm.tm_min;
 	    timeinfo->tm_sec = tm.tm_sec;
         
-	    // int offset = -1 * timeinfo->tm_gmtoff;	// for local time
+	    return time_to_epoch(timeinfo, 0);
-	    int offset = 0;
-	    return time_to_epoch(timeinfo, offset);
 	}
 
 	throw std::runtime_error("invalid date string or format (" + datestr + ", " + format + ")" );

ml_date.h

@@ -9,6 +9,8 @@
 
 long now();
 
+long get_gmt_localtime_offset();
+
 std::string date_to_string(const long datetime, const std::string format);
 
 long string_to_date(const std::string &datestr, const std::string &format);

ml_io.cpp

@@ -23,12 +23,14 @@ std::string read_file_contents(const std::string &filename) {
 	return contents;
 }
 
-int write_file_contents(const std::string &filename, const std::string &content) {
+bool write_file_contents(const std::string &filename, const std::string &content) {
-	std::ofstream f;
+	std::ofstream f(filename.c_str());
-	f.open(filename.c_str());
+	if (f) {
-	int result = (f << content) ? 1 : 0;
+		f << content;
-	f.close();
+		f.close();
-	return result;
+		return true;
+	}
+	return false;
 }
 
 MlValue list_dir(const std::string &path) {

ml_io.h

@@ -9,7 +9,7 @@
 
 std::string read_file_contents(const std::string &filename);
 
-int write_file_contents(const std::string &filename, const std::string &content);
+bool write_file_contents(const std::string &filename, const std::string &content);
 
 MlValue list_dir(const std::string &path);
 

stdlib/stdlib.lsp

@@ -1,5 +1,5 @@
 ; not a bool
-(defun not (x) (if x nil 1))
+(defun not (x) (if x nil #t))
 
 (defun is-pos? (n) (> n nil))
 (defun is-neg? (n) (< n nil))
@@ -70,13 +70,13 @@
 
         (while (and (< i lst_len) (= found_index -1))
             (if (= itm (index lst i))
-                (define found_index i)
+                (set! found_index i)
-                (define i (+ i 1))
+                (set! i (+ i 1))
                 ))
 
         ; TODO when nil will be implemented itm / nil
         (if (!= -1 found_index)
-            1
+            #t
             nil)
     ))
 

stdlib/ut.lsp

@@ -3,16 +3,15 @@
 (defun ut::assert-equal (expected form) (do 
 		(define returned (eval form))
 		(if (= expected returned)
-			(list 1 expected returned)
+			(list #t expected returned)
 			(list nil expected returned))
 	))
 
-(defun ut::assert-true (test) (ut::assert-equal 1 test))
+(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))
 
+
 (defun ut::define-test (name exp_list)
     (set! ut::tests_list (push ut::tests_list (list name exp_list)))) 
 
@@ -20,14 +19,14 @@
 		(define oks 0)
 		(define errs 0)
 		(for t ut::tests_list
-			(define test_name (index t 0)) 
+			(define test_name (first t)) 
-			(define test_result (eval (index t 1))) 
+			(define test_result (eval (second t))) 
 			(if (index test_result 0) 
 				(do (set! oks (+ oks 1)) (print (+ (term-green "OK") "  -> " test_name))) 
-				(do (set! errs (+ errs 1))  
+				(do	(set! errs (+ errs 1))  
-											(print (+ (term-red "ERR") " -> " test_name))
+					(print (+ (term-red "ERR") " -> " test_name))
-											(print " " (index test_result 1) " <> " (index test_result 2))
+					(print " " (second test_result) " <> " (third test_result))
-					))
+				))
 		)
 		(if (= errs 0)
 			(print (term-green (+ (string oks) " test(s) OK")))

tests/test.lsp

@@ -18,6 +18,8 @@
 (define counter (lambda (ln) (do (set! ii (+ ii 1)) )))
 (define ii 0)
 
+(define a 20)
+(define b 30)
 
 (define json_list (parse-json "{\"k1\":\"v1\", \"k2\":42, \"k3\":[\"a\",123,true,false,null]}"))
 
@@ -32,6 +34,8 @@
 (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 (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 (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)))
@@ -58,7 +62,7 @@
 (ut::define-test "result of (string-rtrim \"abc     \")" '(ut::assert-equal "abc" (string-rtrim "abc     ")))
 (ut::define-test "result of (string-ltrim \"     abc\")" '(ut::assert-equal "abc" (string-ltrim "     abc")))
 (ut::define-test "result of (string-trim \"  abc  \")" '(ut::assert-equal "abc" (string-trim "  abc   ")))
-(ut::define-test "result of (string-regex? \"test.lsp\" \"^.*\.l(i)?sp$\")" '(ut::assert-equal 1 (string-regex? "test.lsp" "^.*\.l(i)?sp$")))
+(ut::define-test "result of (string-regex? \"test.lsp\" \"^.*\.l(i)?sp$\")" '(ut::assert-true (string-regex? "test.lsp" "^.*\.l(i)?sp$")))
 
 (ut::define-test "result of (string-split \"split me by space\" \"\\s+\")" '(ut::assert-equal '("split" "me" "by" "space") (string-split "split me by space" "\\s+")))
 (ut::define-test "result of (string-upcase \"abcABCD\")" '(ut::assert-equal "ABCABCD" (string-upcase "abcABCD")))
@@ -82,7 +86,7 @@
 (ut::define-test "result of (ktoi \"A\")" '(ut::assert-equal 65 (ktoi "A")))
 (ut::define-test "result of (ktoi \"0\")" '(ut::assert-equal 48 (ktoi "0")))
 
-(ut::define-test "result of (write-file \"/tmp/file\" \"write-file test\")" '(ut::assert-equal 1 (write-file "/tmp/file" "write-file test\n")))
+(ut::define-test "result of (write-file \"/tmp/file\" \"write-file test\")" '(ut::assert-equal #t (write-file "/tmp/file" "write-file test\n")))
 (ut::define-test "result of (is-file? \"/tmp/file\")" '(ut::assert-true (is-file? "/tmp/file")))
 (ut::define-test "result of (is-file? \"/tmp/file_whichnotex_ists\")" '(ut::assert-false (is-file? "/tmp/file_whichnotex_ists")))
 (ut::define-test "result of (is-dir? \"/tmp/file_whichnotex_ists\")" '(ut::assert-false (is-dir? "/tmp/file_whichnotex_ists")))
@@ -98,12 +102,14 @@
 (ut::define-test "result of (get-env \"HOME\")" '(ut::assert-equal "/Users/vaclavt" (get-env "HOME")))
 
 (ut::define-test "result of (!= nil nil)" '(ut::assert-false (!= nil nil)))
+(ut::define-test "result of (= #t #t)" '(ut::assert-true (= #t #t)))
+(ut::define-test "result of (!= #f #t)" '(ut::assert-false (= #f #t)))
 
-
+(ut::define-test "result of (get-localtime-offset)" '(ut::assert-equal 7200 (get-localtime-offset)))
-; it is not in local time
 (ut::define-test "result of (str-to-date \"01.01.1970\" \"%d.%m.%Y\")" '(ut::assert-equal 0 (str-to-date "01.01.1970" "%d.%m.%Y")))
 (ut::define-test "result of (date-add (str-to-date \"01.01.1970\" \"%d.%m.%Y\") 1 \"day\")" '(ut::assert-equal 86400 (date-add (str-to-date "01.01.1970" "%d.%m.%Y") 1 "day")))
-
+(ut::define-test "result of (str-to-date \"2021-10-11 16:57:00\" \"%Y-%m-%d %H:%M:%S\")" '(ut::assert-equal 1633971420 (str-to-date "2021-10-11 16:57:00" "%Y-%m-%d %H:%M:%S")))
+(ut::define-test "result of (date-to-str 1633971420 \"%Y-%m-%d %H:%M:%S\")" '(ut::assert-equal "2021-10-11 16:57:00" (date-to-str 1633971420 "%Y-%m-%d %H:%M:%S")))
 (ut::define-test "result of (start-of-day)" '(ut::assert-equal 1620864000 (start-of-day (str-to-date "2021-05-13 10:32:12" "%Y-%m-%d %H:%M:%S"))))
 (ut::define-test "result of (end-of-day)" '(ut::assert-equal 1620950399 (end-of-day (str-to-date "2021-05-13 10:32:12" "%Y-%m-%d %H:%M:%S"))))
 (ut::define-test "result of (start-of-month)" '(ut::assert-equal 1619827200 (start-of-month (str-to-date "2021-05-13 10:32:12" "%Y-%m-%d %H:%M:%S"))))