mal/tcl/step3_env.tcl

source mal_readline.tcl
source types.tcl
source reader.tcl
source printer.tcl
source env.tcl

proc READ str {
    read_str $str
}

proc eval_ast {ast env} {
    switch [obj_type $ast] {
        "symbol" {
            set varname [obj_val $ast]
            return [$env get $varname]
        }
        "list" {
            set res {}
            foreach element [obj_val $ast] {
                lappend res [EVAL $element $env]
            }
            return [list_new $res]
        }
        "vector" {
            set res {}
            foreach element [obj_val $ast] {
                lappend res [EVAL $element $env]
            }
            return [vector_new $res]
        }
        "hashmap" {
            set res [dict create]
            dict for {k v} [obj_val $ast] {
                dict set res $k [EVAL $v $env]
            }
            return [hashmap_new $res]
        }
        default { return $ast }
    }
}

proc EVAL {ast env} {
    if {![list_q $ast]} {
        return [eval_ast $ast $env]
    }
    set a0 [lindex [obj_val $ast] 0]
    if {$a0 == ""} {
        return $ast
    }
    set a1 [lindex [obj_val $ast] 1]
    set a2 [lindex [obj_val $ast] 2]
    switch [obj_val $a0] {
        "def!" {
            set varname [obj_val $a1]
            set value [EVAL $a2 $env]
            return [$env set $varname $value]
        }
        "let*" {
            set letenv [Env new $env]
            set bindings_list [obj_val $a1]
            foreach {varnameobj varvalobj} $bindings_list {
                $letenv set [obj_val $varnameobj] [EVAL $varvalobj $letenv]
            }
            return [EVAL $a2 $letenv]
        }
        default {
            set lst_obj [eval_ast $ast $env]
            set lst [obj_val $lst_obj]
            set f [lindex $lst 0]
            set call_args [lrange $lst 1 end]
            return [apply $f $call_args]
        }
    }
}

proc PRINT exp {
    pr_str $exp 1
}

proc REP {str env} {
    PRINT [EVAL [READ $str] $env]
}

proc mal_add {a} {
    integer_new [expr {[obj_val [lindex $a 0]] + [obj_val [lindex $a 1]]}]
}

proc mal_sub {a} {
    integer_new [expr {[obj_val [lindex $a 0]] - [obj_val [lindex $a 1]]}]
}

proc mal_mul {a} {
    integer_new [expr {[obj_val [lindex $a 0]] * [obj_val [lindex $a 1]]}]
}

proc mal_div {a} {
    integer_new [expr {[obj_val [lindex $a 0]] / [obj_val [lindex $a 1]]}]
}

set repl_env [Env new]
$repl_env set "+" {{a} {mal_add $a}}
$repl_env set "-" {{a} {mal_sub $a}}
$repl_env set "*" {{a} {mal_mul $a}}
$repl_env set "/" {{a} {mal_div $a}}

fconfigure stdout -translation binary

# repl loop
while {true} {
    set res [_readline "user> "]
    if {[lindex $res 0] == "EOF"} {
        break
    }
    set line [lindex $res 1]
    if {$line == ""} {
        continue
    }
    if { [catch { puts [REP $line $repl_env] } exception] } {
        puts "Error: $exception"
    }
}
puts ""