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