mirror of
https://github.com/kanaka/mal.git
synced 2024-08-17 17:50:24 +03:00
- Reorder README to have implementation list after "learning tool" bullet. - This also moves tests/ and libs/ into impls. It would be preferrable to have these directories at the top level. However, this causes difficulties with the wasm implementations which need pre-open directories and have trouble with paths starting with "../../". So in lieu of that, symlink those directories to the top-level. - Move the run_argv_test.sh script into the tests directory for general hygiene.
127 lines
3.4 KiB
Tcl
127 lines
3.4 KiB
Tcl
oo::class create Reader {
|
|
variable pos tokens
|
|
|
|
constructor {tokens_list} {
|
|
set tokens $tokens_list
|
|
set pos 0
|
|
}
|
|
|
|
method peek {} {
|
|
lindex $tokens $pos
|
|
}
|
|
|
|
method next {} {
|
|
set token [my peek]
|
|
incr pos
|
|
return $token
|
|
}
|
|
}
|
|
|
|
proc tokenize str {
|
|
set re {[\s,]*(~@|[\[\]\{\}()'`~^@]|\"(?:\\.|[^\\\"])*\"?|;[^\n]*|[^\s\[\]\{\}('\"`~^@,;)]*)}
|
|
set tokens {}
|
|
foreach {_ capture} [regexp -all -inline $re $str] {
|
|
if {[string length $capture] > 0 && [string range $capture 0 0] != ";"} {
|
|
lappend tokens $capture
|
|
}
|
|
}
|
|
return $tokens
|
|
}
|
|
|
|
proc read_tokens_list {reader start_char end_char} {
|
|
set token [$reader next]
|
|
if {$token != $start_char} {
|
|
error "expected '$start_char', got EOF"
|
|
}
|
|
|
|
set elements {}
|
|
set token [$reader peek]
|
|
while {$token != $end_char} {
|
|
if {$token == ""} {
|
|
error "expected '$end_char', got EOF"
|
|
}
|
|
lappend elements [read_form $reader]
|
|
set token [$reader peek]
|
|
}
|
|
$reader next
|
|
return $elements
|
|
}
|
|
|
|
proc read_list {reader} {
|
|
set elements [read_tokens_list $reader "(" ")"]
|
|
list_new $elements
|
|
}
|
|
|
|
proc read_vector {reader} {
|
|
set elements [read_tokens_list $reader "\[" "\]"]
|
|
vector_new $elements
|
|
}
|
|
|
|
proc read_hashmap {reader} {
|
|
set res [dict create]
|
|
foreach {keytoken valtoken} [read_tokens_list $reader "{" "}"] {
|
|
dict set res [obj_val $keytoken] $valtoken
|
|
}
|
|
hashmap_new $res
|
|
}
|
|
|
|
proc parse_string {str} {
|
|
set res [string range $str 1 end-1]
|
|
string map {"\\n" "\n" "\\\"" "\"" "\\\\" "\\"} $res
|
|
}
|
|
|
|
proc parse_keyword {str} {
|
|
# Remove initial ":"
|
|
string range $str 1 end
|
|
}
|
|
|
|
proc read_atom {reader} {
|
|
set token [$reader next]
|
|
switch -regexp $token {
|
|
^-?[0-9]+$ { return [obj_new "integer" $token] }
|
|
^nil$ { return $::mal_nil }
|
|
^true$ { return $::mal_true }
|
|
^false$ { return $::mal_false }
|
|
^: { return [keyword_new [parse_keyword $token]] }
|
|
^\"(\\\\.|[^\\\\\"])*\"$
|
|
{ return [string_new [parse_string $token]] }
|
|
^\" { error "expected '\"', got EOF" }
|
|
default { return [symbol_new $token] }
|
|
}
|
|
}
|
|
|
|
proc symbol_shortcut {symbol_name reader} {
|
|
$reader next
|
|
list_new [list [symbol_new $symbol_name] [read_form $reader]]
|
|
}
|
|
|
|
proc read_form {reader} {
|
|
switch [$reader peek] {
|
|
"'" { return [symbol_shortcut "quote" $reader] }
|
|
"`" { return [symbol_shortcut "quasiquote" $reader] }
|
|
"~" { return [symbol_shortcut "unquote" $reader] }
|
|
"~@" { return [symbol_shortcut "splice-unquote" $reader] }
|
|
"^" {
|
|
$reader next
|
|
set meta [read_form $reader]
|
|
return [list_new [list [symbol_new "with-meta"] [read_form $reader] $meta]]
|
|
}
|
|
"@" { return [symbol_shortcut "deref" $reader] }
|
|
"(" { return [read_list $reader] }
|
|
")" { error "unexpected ')'" }
|
|
"\[" { return [read_vector $reader] }
|
|
"\]" { error "unexpected '\]'" }
|
|
"\{" { return [read_hashmap $reader] }
|
|
"\}" { error "unexpected '\}'" }
|
|
default { return [read_atom $reader] }
|
|
}
|
|
}
|
|
|
|
proc read_str str {
|
|
set tokens [tokenize $str]
|
|
set reader [Reader new $tokens]
|
|
set res [read_form $reader]
|
|
$reader destroy
|
|
return $res
|
|
}
|