python: remove extraneous macroexpand call.

[jackhill/mal.git] / powershell / stepA_mal.ps1

$ErrorActionPreference = "Stop"

Import-Module $PSScriptRoot/types.psm1
Import-Module $PSScriptRoot/reader.psm1
Import-Module $PSScriptRoot/printer.psm1
Import-Module $PSScriptRoot/env.psm1
Import-Module $PSScriptRoot/core.psm1

# READ
function READ([String] $str) {
    return read_str($str)
}

# EVAL
function pair?($ast) {
    (sequential? $ast) -and $ast.values.Count -gt 0
}

function quasiquote($ast) {
    if (-not (pair? $ast)) {
        return (new-list @((new-symbol "quote"), $ast))
    } else {
        $a0 = $ast.nth(0)
        if ((symbol? $a0) -and $a0.value -ceq "unquote") {
            return $ast.nth(1)
        } elseif (pair? $a0) {
            $a00 = $a0.nth(0)
            if ((symbol? $a00) -and $a00.value -ceq "splice-unquote") {
                return (new-list @((new-symbol "concat"),
                                   $a0.nth(1),
                                   (quasiquote $ast.rest())))
            }
        }
        return (new-list @((new-symbol "cons"),
                           (quasiquote $a0),
                           (quasiquote $ast.rest())))
    }
}

function macro?($ast, $env) {
    return (list? $ast) -and
           (symbol? $ast.nth(0)) -and
           $env.find($ast.nth(0)) -and
           $env.get($ast.nth(0)).macro
}

function macroexpand($ast, $env) {
    while (macro? $ast $env) {
        $mac = $env.get($ast.nth(0)).fn
        $margs = $ast.rest().values
        $ast = &$mac @margs
    }
    return $ast
}

function eval_ast($ast, $env) {
    if ($ast -eq $null) { return $ast }
    switch ($ast.GetType().Name) {
        "Symbol"  { return $env.get($ast) }
        "List"    { return new-list ($ast.values | ForEach { EVAL $_ $env }) }
        "Vector"  { return new-vector ($ast.values | ForEach { EVAL $_ $env }) }
        "HashMap" {
            $hm = new-hashmap @()
            foreach ($k in $ast.values.Keys) {
                $hm.values[$k] = EVAL $ast.values[$k] $env
            }
            return $hm
        }
        default   { return $ast }
    }
}

function EVAL($ast, $env) {
  while ($true) {
    #Write-Host "EVAL $(pr_str $ast)"
    if (-not (list? $ast)) {
        return (eval_ast $ast $env)
    }

    $ast = (macroexpand $ast $env)
    if (-not (list? $ast)) {
        return (eval_ast $ast $env)
    }
    if (empty? $ast) { return $ast }

    $a0, $a1, $a2 = $ast.nth(0), $ast.nth(1), $ast.nth(2)
    switch -casesensitive ($a0.value) {
        "def!" {
            return $env.set($a1, (EVAL $a2 $env)) 
        }
        "let*" {
            $let_env = new-env $env
            for ($i=0; $i -lt $a1.values.Count; $i+=2) {
                $_ = $let_env.set($a1.nth($i), (EVAL $a1.nth(($i+1)) $let_env))
            }
            $env = $let_env
            $ast = $a2  # TCO
        }
        "quote" {
            return $a1
        }
        "quasiquote" {
            $ast = quasiquote $a1
        }
        "defmacro!" {
            $m = EVAL $a2 $env
            $m.macro = $true
            return $env.set($a1, $m)
        }
        "macroexpand" {
            return (macroexpand $a1 $env)
        }
        "try*" {
            try {
                return EVAL $a1 $env
            } catch {
                if ($a2 -and ($a2.nth(0).value -ceq "catch*")) {
                    if ($_.Exception.GetType().Name -eq "MalException") {
                        $e = @($_.Exception.object)
                    } else {
                        $e = @($_.Exception.Message)
                    }
                    return (EVAL $a2.nth(2) (new-env $env @($a2.nth(1)) $e))
                } else {
                    throw
                }
            }
        }
        "do" {
            if ($ast.values.Count -gt 2) {
                $middle = new-list $ast.values[1..($ast.values.Count-2)]
                $_ = eval_ast $middle $env
            }
            $ast = $ast.last()  # TCO
        }
        "if" {
            $cond = (EVAL $a1 $env)
            if ($cond -eq $null -or
                ($cond -is [Boolean] -and $cond -eq $false)) {
                $ast = $ast.nth(3)  # TCO
            } else {
                $ast = $a2  # TCO
            }
        }
        "fn*" {
            # Save EVAL into a variable that will get closed over
            $feval = Get-Command EVAL
            $fn = {
                return (&$feval $a2 (new-env $env $a1.values $args))
            }.GetNewClosure()
            return new-malfunc $a2 $a1.values $env $fn
        }
        default {
            $el = (eval_ast $ast $env)
            $f, $fargs = $el.first(), $el.rest().values
            if (malfunc? $f) {
                $env = (new-env $f.env $f.params $fargs)
                $ast = $f.ast  # TCO
            } else {
                return &$f @fargs
            }
        }
    }
  }
}

# PRINT
function PRINT($exp) {
    return pr_str $exp $true
}

# REPL
$repl_env = new-env

function REP([String] $str) {
    return PRINT (EVAL (READ $str) $repl_env)
}

# core.EXT: defined using PowerShell
foreach ($kv in $core_ns.GetEnumerator()) {
    $_ = $repl_env.set((new-symbol $kv.Key), $kv.Value)
}
$_ = $repl_env.set((new-symbol "eval"), { param($a); (EVAL $a $repl_env) })
$_ = $repl_env.set((new-symbol "*ARGV*"), (new-list $args[1..$args.Count]))

# core.mal: defined using the language itself
$_ = REP('(def! *host-language* "powershell")')
$_ = REP('(def! not (fn* (a) (if a false true)))')
$_ = REP('(def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) ")")))))')
$_ = 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)))))))")
$_ = REP('(def! *gensym-counter* (atom 0))')
$_ = REP('(def! gensym (fn* [] (symbol (str "G__" (swap! *gensym-counter* (fn* [x] (+ 1 x)))))))')
$_ = REP('(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) (let* (condvar (gensym)) `(let* (~condvar ~(first xs)) (if ~condvar ~condvar (or ~@(rest xs)))))))))')


if ($args.Count -gt 0) {
    $_ = REP('(load-file "' + $args[0] + '")')
    exit 0
}

$_ = REP('(println (str "Mal [" *host-language* "]"))')
while ($true) {
    Write-Host "user> " -NoNewline
    $line = [Console]::ReadLine()
    if ($line -eq $null) {
        break
    }
    try {
        Write-Host (REP($line))
    } catch {
        if ($_.Exception.GetType().Name -eq "MalException") {
            Write-Host "Exception: $(pr_str $_.Exception.object)"
        } else {
            Write-Host "Exception: $($_.Exception.Message)"
        }
    }
}