mirror of
https://github.com/kanaka/mal.git
synced 2024-11-13 01:43:50 +03:00
parent
f16ca502ff
commit
0e198b2cc6
35
tcl/core.tcl
35
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] \
|
||||
|
@ -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"
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user