Merge pull request #169 from dubek/issue_166_tcl

tcl: add seq and string?

tcl/core.tcl

@@ -28,6 +28,10 @@ proc mal_symbol_q {a} {
     bool_new [symbol_q [lindex $a 0]]
 }
 
+proc mal_string_q {a} {
+    bool_new [string_q [lindex $a 0]]
+}
+
 proc mal_keyword {a} {
     keyword_new [obj_val [lindex $a 0]]
 }
@@ -305,6 +309,35 @@ proc mal_conj {a} {
     }
 }
 
+proc mal_seq {a} {
+    lassign $a a0
+    if {[string_q $a0]} {
+        set str [obj_val $a0]
+        if {$str == ""} {
+            return $::mal_nil
+        }
+        set res {}
+        foreach char [split $str {}] {
+            lappend res [string_new $char]
+        }
+        list_new $res
+    } elseif {[list_q $a0]} {
+        if {[llength [obj_val $a0]] == 0} {
+            return $::mal_nil
+        }
+        return $a0
+    } elseif {[vector_q $a0]} {
+        if {[llength [obj_val $a0]] == 0} {
+            return $::mal_nil
+        }
+        list_new [obj_val $a0]
+    } elseif {[nil_q $a0]} {
+        return $::mal_nil
+    } else {
+        error "seq requires string or list or vector or nil"
+    }
+}
+
 proc mal_meta {a} {
     obj_meta [lindex $a 0]
 }
@@ -347,6 +380,7 @@ set core_ns [dict create \
     "false?"       [nativefunction_new mal_false_q] \
     "symbol"       [nativefunction_new mal_symbol] \
     "symbol?"      [nativefunction_new mal_symbol_q] \
+    "string?"      [nativefunction_new mal_string_q] \
     "keyword"      [nativefunction_new mal_keyword] \
     "keyword?"     [nativefunction_new mal_keyword_q] \
     \
@@ -393,6 +427,7 @@ set core_ns [dict create \
     "map"          [nativefunction_new mal_map] \
     \
     "conj"         [nativefunction_new mal_conj] \
+    "seq"          [nativefunction_new mal_seq] \
     \
     "meta"         [nativefunction_new mal_meta] \
     "with-meta"    [nativefunction_new mal_with_meta] \

tcl/types.tcl

@@ -85,6 +85,10 @@ proc string_new {val} {
     obj_new "string" $val
 }
 
+proc string_q {obj} {
+    expr {[obj_type $obj] == "string" && [string index [obj_val $obj] 0] != "\u029E"}
+}
+
 proc keyword_new {val} {
     string_new "\u029E$val"
 }