Commit | Line | Data |
---|---|---|
54d9903c DM |
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 "" |