Merge pull request #396 from inkydragon/fix-test-on-windows
[jackhill/mal.git] / perl6 / step5_tco.pl
CommitLineData
a7081401
HÖS
1use v6;
2use lib IO::Path.new($?FILE).dirname;
3use reader;
4use printer;
5use types;
6use env;
7use core;
8
9sub read ($str) {
10 return read_str($str);
11}
12
13sub eval_ast ($ast, $env) {
14 given $ast {
15 when MalSymbol { $env.get($ast.val) || die X::MalNotFound.new(name => $ast.val) }
16 when MalList { MalList([$ast.map({ eval($_, $env) })]) }
17 when MalVector { MalVector([$ast.map({ eval($_, $env) })]) }
18 when MalHashMap { MalHashMap($ast.kv.map({ $^a => eval($^b, $env) }).Hash) }
19 default { $ast // $NIL }
20 }
21}
22
23sub eval ($ast is copy, $env is copy) {
24 loop {
25 return eval_ast($ast, $env) if $ast !~~ MalList;
26 return $ast if !$ast.elems;
27
28 my ($a0, $a1, $a2, $a3) = $ast.val;
29 given $a0.val {
30 when 'def!' {
31 return $env.set($a1.val, eval($a2, $env));
32 }
33 when 'let*' {
34 my $new_env = MalEnv.new($env);
35 for |$a1.val -> $key, $value {
36 $new_env.set($key.val, eval($value, $new_env));
37 }
38 $env = $new_env;
39 $ast = $a2;
40 }
41 when 'do' {
42 eval_ast(MalList([$ast[1..*-2]]), $env);
43 $ast = $ast[*-1];
44 }
45 when 'if' {
46 if eval($a1, $env) ~~ MalNil|MalFalse {
47 return $NIL if $a3 ~~ $NIL;
48 $ast = $a3;
49 }
50 else {
51 $ast = $a2;
52 }
53 }
54 when 'fn*' {
55 my @binds = $a1 ?? $a1.map(*.val) !! ();
56 my &fn = -> *@args {
57 eval($a2, MalEnv.new($env, @binds, @args));
58 };
59 return MalFunction($a2, $env, @binds, &fn);
60 }
61 default {
62 my ($func, @args) = eval_ast($ast, $env).val;
63 return $func.apply(|@args) if $func !~~ MalFunction;
64 $ast = $func.ast;
65 $env = MalEnv.new($func.env, $func.params, @args);
66 }
67 }
68 }
69}
70
71sub print ($exp) {
72 return pr_str($exp, True);
73}
74
75my $repl_env = MalEnv.new;
76
77sub rep ($str) {
78 return print(eval(read($str), $repl_env));
79}
80
81sub MAIN {
82 $repl_env.set(.key, .value) for %core::ns;
83 rep(q{(def! not (fn* (a) (if a false true)))});
84
85 while (my $line = prompt 'user> ').defined {
86 say rep($line);
87 CATCH {
88 when X::MalException { .Str.say }
89 }
90 }
91}