Qiita Teams that are logged in
You are not logged in to any team

Log in to Qiita Team
Community
OrganizationAdvent CalendarQiitadon (β)
Service
Qiita JobsQiita ZineQiita Blog
Help us understand the problem. What is going on with this article?

PowerShell で Lisp っぽいものを動かす

More than 3 years have passed since last update.

PowerShellの引数の区切りには空白が使われる。また、PowerShell は$argsという自動変数に引数の配列が格納される。そのため下記のように適当な関数を定義すると、空白区切りで配列を作成できる。

PS C:\demo\lisp_ps> filter : {$args}
PS C:\demo\lisp_ps> (: 1 2 3) -join ', '
1, 2, 3

つまり頑張れば、PowerShellでLispっぽく書けるはずである。

結果

結果としては、評価器 lisp.ps1 を読み込んだ状態で、lispっぽく書いたソート処理 mergesort_lisp.ps1 が動く。

PS C:\demo\lisp_ps> powershell -v 3 -nologo
PS C:\demo\lisp_ps> ls -name
lisp.ps1
mergesort_lisp.ps1
PS C:\demo\lisp_ps> . .\lisp.ps1
PS C:\demo\lisp_ps> . .\mergesort_lisp.ps1
(1, (2, (3, (4, (5, (6, ))))))

mergesort_lisp.ps1

[string](lisp `
    (: begin `
        (: define mergesort (: lambda (: xs) `
            (: mergeAll (: sequences xs))))`
        `
        (: define sequences (: lambda (: xs) `
            (: cond `
                (: eq? xs nil) nil `
                $true (: cons `
                        (: cons (: fst xs) nil) `
                        (: sequences (: snd xs))))))`
        `
        (: define mergeAll (: lambda  (: xs) `
            (: cond `
                (: eq? xs nil) nil `
                (: eq? (: snd xs) nil) (: fst xs)`
                $true `
                    (: mergeAll (: mergePairs xs)))))`
        `
        (: define mergePairs (: lambda (: xs)`
            (: cond `
                (: eq? xs nil) nil `
                (: eq? (: snd xs) nil) xs `
                $true (: cons `
                        (: merge (: fst xs) (: fst (: snd xs))) `
                        (: mergePairs (: snd (: snd xs)))))))`
        `
        (: define merge (: lambda (: xs ys)`
            (: cond `
                (: eq? xs nil) ys `
                (: eq? ys nil) xs `
                (: lt? (: fst xs) (: fst ys))`
                    (: cons (: fst xs) (: merge (: snd xs) ys))`
                $true `
                    (: cons (: fst ys) (: merge xs (: snd ys))))))`
        `
        (: mergesort (: quote (: 5 4 3 1 2 6)))`
    )`
)

lisp.ps1

# Eval
# ====
filter Invoke-Lisp ($Exp, $Env = (Get-LispBuiltInEnv))
{
    # Variable
    if ($Exp -is [string]) {return (Select-LispEnv $Exp $Env)[$Exp]}

    # Atom
    if (-not (pear? $Exp)) {return $Exp}

    $fst = Invoke-Lisp (fst $Exp) $Env
    $snd = snd $Exp

    # Syntax
    if ($fst -is [ScriptBlock]) {return & $fst $snd $Env}

    # Closure
    if (Test-LispClosure $fst) {return Invoke-LispClosure $fst $snd $Env}

    throw "${Exp} を評価できません。"
}

Set-Alias lisp Invoke-Lisp

# Pear
# ====
filter Get-LispNil {''}

filter New-LispPear
    ($Item1 = (Get-LispNil), $Item2 = (Get-LispNil))
        {[Tuple]::Create($Item1, $Item2)}

filter Get-LispPearFirst
    ([Parameter(ValueFromPipeline=$true)] $Pear)
        {,$Pear.Item1}

filter Get-LispPearSecond
    ([Parameter(ValueFromPipeline=$true)] $Pear)
        {,$Pear.Item2}

filter Test-LispPear
    ([Parameter(ValueFromPipeline=$true)] $InpuObject)
        {$InpuObject -is [Object] -and $InpuObject.GetType().Name -eq 'Tuple`2'}

filter New-LispList {Add-LispList $args}

filter Add-LispList ($Item, $List = (Get-LispNil))
{
    if ($Item.Length -eq 0) {return $List}

    ($Item.Length - 1)..0 |
        % {$l = $List} {$l = New-LispPear $Item[$_] $l} {$l}
}

filter ConvertFrom-LispList
   ([Parameter(ValueFromPipeline=$true)] $Pear)
        {for ($p = $Pear; pear? $p; $p = snd $p) {fst $p}}

Set-Alias : New-LispList
Set-Alias pear? Test-LispPear
Set-Alias fst Get-LispPearFirst
Set-Alias snd Get-LispPearSecond

# Env
# ===
filter Select-LispEnv ([string]$Keyword, $Env)
{
    for ($e = $Env; pear? $e; $e = snd $e)
        {if ((fst $e).Contains($Keyword)) {return fst $e}}

    throw "${Keyword}が定義された環境が見つかりません。"
}

# Closure
# =======
filter New-LispClosure ($ParamList, $BodyList, $ParentEnv, $ScriptBlock)
{
    $o = [PSObject]$PSBoundParameters
    $o | Add-Member -TypeName 'Lisp.Closure'
    $o
}

filter Test-LispClosure ($InputObject)
    {$InputObject -is [PSCustomObject] -and $InputObject.PSTypeNames[0] -eq 'Lisp.Closure'}

filter Invoke-LispClosure ($Closure, $ArgPear, $Env)
{
    # eval argument list
    $arg = $ArgPear | ConvertFrom-LispList | %{Invoke-Lisp $_ $Env}
    if ($arg -isnot [Array]) {$arg = ,$arg}

    # create new env
    $bound = New-LispBoundParameters $Closure.ParamList (Add-LispList $arg)
    $newEnv = New-LispPear $bound $Closure.ParentEnv

    # eval
    & $closure.ScriptBlock $closure.BodyList $newEnv
}

filter New-LispBoundParameters ($ParamPear, $ArgPear)
{
    # init variable
    $bound = @{}
    $pPear = $ParamPear
    $aPear = $ArgPear

    # bound parameter
    while ((pear? $pPear) -and (pear? $aPear))
    {
        $bound[(fst $pPear)] = fst $aPear
        $pPear = snd $pPear
        $aPear = snd $aPear
    }

    # wrong number of arguments
    if (pear? $pPear)
    {
        $ps = ($pPear | ConvertFrom-LispList) -join ', '
        throw "${ps} に対応する引数が不足しています。"
    }

    # rest argument
    $bound['rest'] = $aPear

    $bound
}

# Built In
# ========
filter Get-LispBuiltInEnv
{
    $BuiltIn = @{}

    # Variable
    $BuiltIn += Get-LispBuiltInVariable

    # Syntax
    $BuiltIn += Get-LispBuiltInSyntax

    # Closure
    $BuiltIn += Get-LispBuiltInClosure

    New-LispPear $BuiltIn
}

filter Get-LispBuiltInVariable
{
        $BuiltIn = @{}

        $BuiltIn.nil = Get-LispNil

        $BuiltIn
}

filter Get-LispBuiltInSyntax
{
    $BuiltIn = @{}

    $BuiltIn.cond = {param($body, $Env)
        $test, $list, $body = ($body | fst), ($body | snd | fst), ($body | snd | snd)
        while (-not (Invoke-Lisp $test $Env))
            {$test, $list, $body = ($body | fst), ($body | snd | fst), ($body | snd | snd)}
        Invoke-Lisp $list $Env
    }

    $BuiltIn.define = {param($body, $Env)
        $symbol = fst $body
        $e = fst $Env
        if ($e.Contains($symbol))
            {throw "${symbol}は既に定義されています。"}
        $e[$symbol] = Invoke-Lisp ($body | snd | fst) $Env
    }

    $BuiltIn.lambda = {param($body, $Env)
        New-LispClosure ($body | fst) ($body | snd | fst) $Env `
            {param($bodyList, $newEnv) Invoke-Lisp $bodyList $newEnv}
    }

    $BuiltIn.begin = {param($body, $Env)
        $r = Get-LispNil
        for ($b = $body; pear? $b; $b = snd $b)
            {$r = Invoke-Lisp (fst $b) $Env}
        $r
    }

    $BuiltIn.quote = {param($body, $Env) fst $body}

    $BuiltIn
}

filter Get-LispBuiltInClosure
{
    $BuiltIn = @{}
    $nil = Get-LispNil

    filter fun ($Keyword, $ScriptBlock)
        {$BuiltIn[$Keyword] = New-LispClosure $nil $nil $nil $ScriptBlock}

    fun cons {New-LispPear $arg[0] $arg[1]}
    fun fst {Get-LispPearFirst $arg[0]}
    fun snd {Get-LispPearSecond $arg[0]}
    fun eq? {$arg[0] -eq $arg[1]}
    fun lt? {$arg[0] -lt $arg[1]}

    $BuiltIn
}

参考

yumura_s
Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away