impls/powershell/step8_macros.ps1

   1 $ErrorActionPreference = "Stop"
   2
   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
   8
   9 # READ
  10 function READ([String] $str) {
  11     return read_str($str)
  12 }
  13
  14 # EVAL
  15 function pair?($ast) {
  16     (sequential? $ast) -and $ast.values.Count -gt 0
  17 }
  18
  19 function quasiquote($ast) {
  20     if (-not (pair? $ast)) {
  21         return (new-list @((new-symbol "quote"), $ast))
  22     } else {
  23         $a0 = $ast.nth(0)
  24         if ((symbol? $a0) -and $a0.value -ceq "unquote") {
  25             return $ast.nth(1)
  26         } elseif (pair? $a0) {
  27             $a00 = $a0.nth(0)
  28             if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") {
  29                 return (new-list @((new-symbol "concat"),
  30                                    $a0.nth(1),
  31                                    (quasiquote $ast.rest())))
  32             }
  33         }
  34         return (new-list @((new-symbol "cons"),
  35                            (quasiquote $a0),
  36                            (quasiquote $ast.rest())))
  37     }
  38 }
  39
  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
  45 }
  46
  47 function macroexpand($ast, $env) {
  48     while (macro? $ast $env) {
  49         $mac = $env.get($ast.nth(0)).fn
  50         $margs = $ast.rest().values
  51         $ast = &$mac @margs
  52     }
  53     return $ast
  54 }
  55
  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 }) }
  62         "HashMap" {
  63             $hm = new-hashmap @()
  64             foreach ($k in $ast.values.Keys) {
  65                 $hm.values[$k] = EVAL $ast.values[$k] $env
  66             }
  67             return $hm
  68         }
  69         default   { return $ast }
  70     }
  71 }
  72
  73 function EVAL($ast, $env) {
  74   while ($true) {
  75     #Write-Host "EVAL $(pr_str $ast)"
  76     if (-not (list? $ast)) {
  77         return (eval_ast $ast $env)
  78     }
  79
  80     $ast = (macroexpand $ast $env)
  81     if (-not (list? $ast)) {
  82         return (eval_ast $ast $env)
  83     }
  84     if (empty? $ast) { return $ast }
  85
  86     $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2)
  87     switch -casesensitive ($a0.value) {
  88         "def!" {
  89             return $env.set($a1, (EVAL $a2 $env))
  90         }
  91         "let*" {
  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))
  95             }
  96             $env = $let_env
  97             $ast = $a2  # TCO
  98         }
  99         "quote" {
 100             return $a1
 101         }
 102         "quasiquote" {
 103             $ast = quasiquote $a1
 104         }
 105         "defmacro!" {
 106             $m = EVAL $a2 $env
 107             $m.macro = $true
 108             return $env.set($a1, $m)
 109         }
 110         "macroexpand" {
 111             return (macroexpand $a1 $env)
 112         }
 113         "do" {
 114             if ($ast.values.Count -gt 2) {
 115                 $middle = new-list $ast.values[1..($ast.values.Count-2)]
 116                 $_ = eval_ast $middle $env
 117             }
 118             $ast = $ast.last()  # TCO
 119         }
 120         "if" {
 121             $cond = (EVAL $a1 $env)
 122             if ($cond -eq $null -or
 123                 ($cond -is [Boolean] -and $cond -eq $false)) {
 124                 $ast = $ast.nth(3)  # TCO
 125             } else {
 126                 $ast = $a2  # TCO
 127             }
 128         }
 129         "fn*" {
 130             # Save EVAL into a variable that will get closed over
 131             $feval = Get-Command EVAL
 132             $fn = {
 133                 return (&$feval $a2 (new-env $env $a1.values $args))
 134             }.GetNewClosure()
 135             return new-malfunc $a2 $a1.values $env $fn
 136         }
 137         default {
 138             $el = (eval_ast $ast $env)
 139             $f, $fargs = $el.first(), $el.rest().values
 140             if (malfunc? $f) {
 141                 $env = (new-env $f.env $f.params $fargs)
 142                 $ast = $f.ast  # TCO
 143             } else {
 144                 return &$f @fargs
 145             }
 146         }
 147     }
 148   }
 149 }
 150
 151 # PRINT
 152 function PRINT($exp) {
 153     return pr_str $exp $true
 154 }
 155
 156 # REPL
 157 $repl_env = new-env
 158
 159 function REP([String] $str) {
 160     return PRINT (EVAL (READ $str) $repl_env)
 161 }
 162
 163 # core.EXT: defined using PowerShell
 164 foreach ($kv in $core_ns.GetEnumerator()) {
 165     $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value)
 166 }
 167 $_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) })
 168 $_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count]))
 169
 170 # core.mal: defined using the language itself
 171 $_ = REP('(def! not (fn* (a) (if a false true)))')
 172 $_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)")))))')
 173 $_ = 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)))))))")
 174
 175
 176 if ($args.Count -gt 0) {
 177     $_ = REP('(load-file "' + $args[0] + '")')
 178     exit 0
 179 }
 180
 181 while ($true) {
 182     Write-Host "user> " -NoNewline
 183     $line = [Console]::ReadLine()
 184     if ($line -eq $null) {
 185         break
 186     }
 187     try {
 188         Write-Host (REP($line))
 189     } catch {
 190         Write-Host "Exception: $($_.Exception.Message)"
 191     }
 192 }