git @ Cat's Eye Technologies Decoy / master src / decoy / desugar.lua
master

Tree @master (Download .tar.gz)

desugar.lua @master — raw · history · blame 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
--
-- decoy.desugar
--

-- SPDX-FileCopyrightText: Copyright (c) 2023-2024 Chris Pressey, Cat's Eye Technologies.
-- This work is distributed under a 2-clause BSD license. For more information, see:
-- SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Decoy

table = require "table"
string = require "string"
io = require "io"

require "decoy.model"
local ast = require "decoy.ast"


local Desugarer = {}

function Desugarer:desugar_exprs(sexp)
    if sexp == Nil then
        return Nil
    elseif Cons.is_class_of(sexp) then
        return Cons.new(
            self:desugar_expr(sexp:head()),
            self:desugar_exprs(sexp:tail())
        )
    else
        error("Not a proper list")
    end
end

function Desugarer:desugar_expr(expr)
    debug("desugar", depict(expr))
    if Cons.is_class_of(expr) then
        local head = expr:head()
        if Symbol.is_class_of(head) then
            if head:text() == "quote" then
                return expr
            elseif head:text() == "let*" then
                local bindings = expr:tail():head()
                local body = expr:tail():tail():head()
                local result = self:desugar_let_star(bindings, body)
                debug("desugar", "let* desugar result:" .. depict(result))
                return result
            elseif head:text() == "cond" then
                local result = self:desugar_cond(expr:tail())
                debug("desugar", "cond desugar result:" .. depict(result))
                return result
            elseif head:text() == "if" then
                local test_ = self:desugar_expr(expr:tail():head())
                local then_ = self:desugar_expr(expr:tail():tail():head())
                local else_ = self:desugar_expr(expr:tail():tail():tail():head())
                return (
                    Cons.new(Symbol.new("if"),
                        Cons.new(test_,
                            Cons.new(then_,
                                Cons.new(else_, Nil))))
                )
            elseif head:text() == "lambda" then
                local formals = expr:tail():head()
                local body = expr:tail():tail():head()
                return (
                    Cons.new(Symbol.new("lambda"),
                        Cons.new(formals,
                            Cons.new(self:desugar_expr(body), Nil)))
                )
            else
                return Cons.new(head, self:desugar_exprs(expr:tail()))
            end
        else
            debug("desugar", "desugaring application head:" .. depict(expr:head()))
            local head = self:desugar_expr(expr:head())
            debug("desugar", "head:" .. depict(head))
            debug("desugar", "desugaring application tail:" .. depict(expr:tail()))
            local tail = self:desugar_exprs(expr:tail())
            debug("desugar", "tail:" .. depict(tail))
            return Cons.new(head, tail)
        end
    elseif ast.Define.is_class_of(expr) then
        return ast.Define.new(expr.name, self:desugar_expr(expr.defn))
    elseif ast.ImportFrom.is_class_of(expr) then
        return expr
    else
        --error("Unsupported form for desugaring: " ..  depict(expr))
        return expr
    end
end

function Desugarer:desugar_let_star(bindings, body)
    if bindings == Nil then
        return self:desugar_expr(body)
    else
        local binding = bindings:head()
        local name = binding:head()
        local expr = binding:tail():head()
        return (
            Cons.new(Symbol.new("bind"),
                Cons.new(name,
                    Cons.new(self:desugar_expr(expr),
                        Cons.new(self:desugar_let_star(bindings:tail(), body), Nil))))
        )
    end
end

function Desugarer:desugar_cond(expr)
    debug("desugar", "desugar_cond:" .. depict(expr))
    if expr == Nil then
        return Nil
    end
    local branch = expr:head()
    debug("desugar", "desugar_cond branch:" .. depict(branch))
    local test = branch:head()
    if Symbol.is_class_of(test) and test:text() == "else" then
        debug("desugar", "desugar_cond else:" .. depict(branch:tail():head()))
        result = self:desugar_expr(branch:tail():head())
        debug("desugar", "desugar_cond else result:" .. depict(result))
            return result
    end
    return (
        Cons.new(Symbol.new("if"),
            Cons.new(self:desugar_expr(test),
                Cons.new(self:desugar_expr(branch:tail():head()),
                    Cons.new(self:desugar_cond(expr:tail()), Nil))))
    )
end

Desugarer.new = function()
    local self = {
    }
    setmetatable(self, {__index = Desugarer})
    return self
end

return Desugarer