| 1 | source mal_readline.tcl |
| 2 | source types.tcl |
| 3 | source reader.tcl |
| 4 | source printer.tcl |
| 5 | |
| 6 | proc READ str { |
| 7 | read_str $str |
| 8 | } |
| 9 | |
| 10 | proc eval_ast {ast env} { |
| 11 | switch [obj_type $ast] { |
| 12 | "symbol" { |
| 13 | set varname [obj_val $ast] |
| 14 | if {[dict exists $env $varname]} { |
| 15 | return [dict get $env $varname] |
| 16 | } else { |
| 17 | error "'$varname' not found" |
| 18 | } |
| 19 | } |
| 20 | "list" { |
| 21 | set res {} |
| 22 | foreach element [obj_val $ast] { |
| 23 | lappend res [EVAL $element $env] |
| 24 | } |
| 25 | return [list_new $res] |
| 26 | } |
| 27 | "vector" { |
| 28 | set res {} |
| 29 | foreach element [obj_val $ast] { |
| 30 | lappend res [EVAL $element $env] |
| 31 | } |
| 32 | return [vector_new $res] |
| 33 | } |
| 34 | "hashmap" { |
| 35 | set res [dict create] |
| 36 | dict for {k v} [obj_val $ast] { |
| 37 | dict set res $k [EVAL $v $env] |
| 38 | } |
| 39 | return [hashmap_new $res] |
| 40 | } |
| 41 | default { return $ast } |
| 42 | } |
| 43 | } |
| 44 | |
| 45 | proc EVAL {ast env} { |
| 46 | if {![list_q $ast]} { |
| 47 | return [eval_ast $ast $env] |
| 48 | } |
| 49 | set lst_obj [eval_ast $ast $env] |
| 50 | set lst [obj_val $lst_obj] |
| 51 | set f [lindex $lst 0] |
| 52 | set call_args [lrange $lst 1 end] |
| 53 | apply $f $call_args |
| 54 | } |
| 55 | |
| 56 | proc PRINT exp { |
| 57 | pr_str $exp 1 |
| 58 | } |
| 59 | |
| 60 | proc REP {str env} { |
| 61 | PRINT [EVAL [READ $str] $env] |
| 62 | } |
| 63 | |
| 64 | proc mal_add {a} { |
| 65 | integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}] |
| 66 | } |
| 67 | |
| 68 | proc mal_sub {a} { |
| 69 | integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}] |
| 70 | } |
| 71 | |
| 72 | proc mal_mul {a} { |
| 73 | integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}] |
| 74 | } |
| 75 | |
| 76 | proc mal_div {a} { |
| 77 | integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}] |
| 78 | } |
| 79 | |
| 80 | set repl_env [dict create \ |
| 81 | "+" {{a} {mal_add $a}} \ |
| 82 | "-" {{a} {mal_sub $a}} \ |
| 83 | "*" {{a} {mal_mul $a}} \ |
| 84 | "/" {{a} {mal_div $a}} \ |
| 85 | ] |
| 86 | |
| 87 | fconfigure stdout -translation binary |
| 88 | |
| 89 | # repl loop |
| 90 | while {true} { |
| 91 | set res [_readline "user> "] |
| 92 | if {[lindex $res 0] == "EOF"} { |
| 93 | break |
| 94 | } |
| 95 | set line [lindex $res 1] |
| 96 | if {$line == ""} { |
| 97 | continue |
| 98 | } |
| 99 | if { [catch { puts [REP $line $repl_env] } exception] } { |
| 100 | puts "Error: $exception" |
| 101 | } |
| 102 | } |
| 103 | puts "" |