1 $ErrorActionPreference = "Stop"
3 Import-Module
$PSScriptRoot/types
.psm1
4 Import-Module
$PSScriptRoot/reader
.psm1
5 Import-Module
$PSScriptRoot/printer
.psm1
6 Import-Module
$PSScriptRoot/env
.psm1
7 Import-Module
$PSScriptRoot/core
.psm1
10 function READ
([String
] $str) {
15 function pair
?($ast) {
16 (sequential
? $ast) -and
$ast.values
.Count
-gt
0
19 function quasiquote
($ast) {
20 if (-not
(pair
? $ast)) {
21 return (new-list @
((new-symbol
"quote"), $ast))
24 if ((symbol
? $a0) -and
$a0.value
-ceq
"unquote") {
26 } elseif
(pair
? $a0) {
28 if ((symbol
? $a00) -and
$a00.value
-ceq
"splice-unquote") {
29 return (new-list @
((new-symbol
"concat"),
31 (quasiquote
$ast.rest
())))
34 return (new-list @
((new-symbol
"cons"),
36 (quasiquote
$ast.rest
())))
40 function macro
?($ast, $env) {
41 return (list
? $ast) -and
42 (symbol
? $ast.nth
(0)) -and
43 $env.find
($ast.nth
(0)) -and
44 $env.get
($ast.nth
(0)).macro
47 function macroexpand
($ast, $env) {
48 while (macro
? $ast $env) {
49 $mac = $env.get
($ast.nth
(0)).fn
50 $margs = $ast.rest
().values
56 function eval_ast
($ast, $env) {
57 if ($ast -eq
$null) { return $ast }
58 switch ($ast.GetType
().Name
) {
59 "Symbol" { return $env.get
($ast) }
60 "List" { return new-list
($ast.values
| ForEach
{ EVAL
$_ $env }) }
61 "Vector" { return new-vector
($ast.values
| ForEach
{ EVAL
$_ $env }) }
64 foreach ($k in $ast.values
.Keys
) {
65 $hm.values
[$k] = EVAL
$ast.values
[$k] $env
69 default
{ return $ast }
73 function EVAL
($ast, $env) {
75 #Write-Host "EVAL $(pr_str $ast)"
76 if (-not
(list
? $ast)) {
77 return (eval_ast
$ast $env)
80 $ast = (macroexpand
$ast $env)
81 if (-not
(list
? $ast)) {
82 return (eval_ast
$ast $env)
84 if (empty
? $ast) { return $ast }
86 $a0, $a1, $a2 = $ast.nth
(0), $ast.nth
(1), $ast.nth
(2)
87 switch -casesensitive
($a0.value
) {
89 return $env.set($a1, (EVAL
$a2 $env))
92 $let_env = new-env
$env
93 for
($i=0; $i -lt
$a1.values
.Count
; $i+=2) {
94 $_ = $let_env.set($a1.nth
($i), (EVAL
$a1.nth
(($i+1)) $let_env))
103 $ast = quasiquote
$a1
108 return $env.set($a1, $m)
111 return (macroexpand
$a1 $env)
117 if ($a2 -and
($a2.nth
(0).value
-ceq
"catch*")) {
118 if ($_.Exception
.GetType
().Name
-eq
"MalException") {
119 $e = @
($_.Exception
.object
)
121 $e = @
($_.Exception
.Message
)
123 return (EVAL
$a2.nth
(2) (new-env
$env @
($a2.nth
(1)) $e))
130 if ($ast.values
.Count
-gt
2) {
131 $middle = new-list
$ast.values
[1..($ast.values
.Count-2
)]
132 $_ = eval_ast
$middle $env
134 $ast = $ast.last
() # TCO
137 $cond = (EVAL
$a1 $env)
138 if ($cond -eq
$null -or
139 ($cond -is
[Boolean
] -and
$cond -eq
$false)) {
140 $ast = $ast.nth
(3) # TCO
146 # Save EVAL into a variable that will get closed over
147 $feval = Get-Command EVAL
149 return (&$feval $a2 (new-env
$env $a1.values
$args))
151 return new-malfunc
$a2 $a1.values
$env $fn
154 $el = (eval_ast
$ast $env)
155 $f, $fargs = $el.first
(), $el.rest
().values
157 $env = (new-env
$f.env
$f.params
$fargs)
168 function PRINT
($exp) {
169 return pr_str
$exp $true
175 function REP
([String
] $str) {
176 return PRINT
(EVAL
(READ
$str) $repl_env)
179 # core.EXT: defined using PowerShell
180 foreach ($kv in $core_ns.GetEnumerator
()) {
181 $_ = $repl_env.set((new-symbol
$kv.Key
), $kv.Value
)
183 $_ = $repl_env.set((new-symbol
"eval"), { param
($a); (EVAL
$a $repl_env) })
184 $_ = $repl_env.set((new-symbol
"*ARGV*"), (new-list
$args[1..$args.Count
]))
186 # core.mal: defined using the language itself
187 $_ = REP
('(def! not (fn* (a) (if a false true)))')
188 $_ = REP
('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
189 $_ = REP
("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw `"odd number of forms to cond`
")) (cons 'cond (rest (rest xs)))))))")
190 $_ = REP
('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))')
193 if ($args.Count
-gt
0) {
194 $_ = REP
('(load-file "' + $args[0] + '")')
199 Write-Host "user> " -NoNewline
200 $line = [Console
]::ReadLine
()
201 if ($line -eq
$null) {
205 Write-Host (REP
($line))
207 if ($_.Exception
.GetType
().Name
-eq
"MalException") {
208 Write-Host "Exception: $(pr_str $_.Exception.object)"
210 Write-Host "Exception: $($_.Exception.Message)"