lib/metalua/extension/H-runtime.mlua - ldt/org.eclipse.metalua - Git at Google

 -------------------------------------------------------------------------------
 -- Copyright (c) 2006-2013 Fabien Fleutot and others.
 --
 -- All rights reserved.
 --
 -- This program and the accompanying materials are made available
 -- under the terms of the Eclipse Public License v1.0 which
 -- accompanies this distribution, and is available at
 -- http://www.eclipse.org/legal/epl-v10.html
 --
 -- This program and the accompanying materials are also made available
 -- under the terms of the MIT public license which accompanies this
 -- distribution, and is available at http://www.lua.org/license.html
 --
 -- Contributors:
 --     Fabien Fleutot - API and implementation
 --
 -------------------------------------------------------------------------------

 require 'metalua.walk.id'
 -{ extension 'log' }

 --------------------------------------------------------------------------------
 --
 -- H params:
 -- * H.alpha is the `Local{ } (or `Set{ }) statement which will
 --   receive the alpha-conversions required to restore the free
 --   variables of the transformed term. For instance,
 --   H+{print(1)} will be transformed into +{.1.X.print(1)},
 --   and alpha will contain +{local -{`Id '.1.X.print} = print }.
 --   alpha is reused and augmented by successive calls to H().
 --
 -- * H.side contains 'inside', 'outside', 'both' or nil (equivalent to
 --   'both'). It indicates the kind of hygienization that's to be
 --   performed.
 --
 -- * H.keep contain a set of free variable names which must not be
 --   renamed.
 --
 -- * H.kind is the kind of walker that must be used ('expr', 'stat',
 --   'block'...) and defaults to 'guess'.
 --
 -- * H:set (field, val) sets a field in H and returns H, so that calls
 --   can be chained, e.g.:
 --   > H:set(keep, {'print'}):set('side', outside)+{print(x)}
 --
 -- * H:reset(field) sets a field to nil, and returns the value of that
 --   field prior to nilification.
 --------------------------------------------------------------------------------

 H = { } --setmetatable(H, H)
 H.__index=H
 H.template = { alpha = { } }

 --------------------------------------------------------------------------------
 --
 --------------------------------------------------------------------------------
 function H:new(x)
    local instance = table.deep_copy(self.template)
    if x then instance <- x end
    setmetatable(instance, self)
    return instance
 end

 --------------------------------------------------------------------------------
 --
 --------------------------------------------------------------------------------
 function H:__call (ast)
    assert (type(ast)=='table', "H expects an AST")

    local local_renames -- only set if inside hygienization's required

    -----------------------------------------------------------------------------
    -- kind of hygienization(s) to perform: h_inseide and/or h_outside
    -----------------------------------------------------------------------------
    local h_inside, h_outside do
       local side = self.side or 'both'
       h_inside   = side=='inside'  or side=='both'
       h_outside  = side=='outside' or side=='both'
    end

    -----------------------------------------------------------------------------
    -- Initialize self.keep:
    -- self.keep is a dictionary of free var names to be protected from capture
    -----------------------------------------------------------------------------
    do
       local k = self.keep
       -- If there's no self.keep, that's an empty dictionary
       if not k then k = { }; self.keep = k
       -- If it's a string, consider it as a single-element dictionary
       elseif type(k)=='string' then k = { [k] = true }; self.keep=k
       -- If there's a list-part in self.keep, transpose it:
       else for i, v in ipairs(k) do k[v], k[i] = true, nil end end
    end

    -----------------------------------------------------------------------------
    -- Config skeleton for the id walker
    -----------------------------------------------------------------------------
    local cfg = { expr = { }, stat = { }, id = { } }

    -----------------------------------------------------------------------------
    -- Outside hygienization: all free variables are renamed to fresh ones,
    -- and self.alpha is updated to contain the assignments required to keep
    -- the AST's semantics.
    -----------------------------------------------------------------------------
    if h_outside then
       local alpha = self.alpha

       -- free_vars is an old_name -> new_name dictionary computed from alpha:
       -- self.alpha is not an efficient representation for searching.
       if not alpha then alpha = { }; self.alpha = alpha end
       -- FIXME: alpha should only be overridden when there actually are some
       -- globals renamed.
       if #alpha==0 then alpha <- `Local{ { }, { } } end
       local new, old = unpack(alpha)
       local free_vars  = { }

       assert (#new==#old, "Invalid alpha list")
       for i = 1, #new do
          assert (old[i].tag=='Id' and #old[i]==1, "Invalid lhs in alpha list")
          assert (new[i].tag=='Id' and #new[i]==1, "Invalid rhs in alpha list")
          free_vars[old[i][1]] = new[i][1]
       end

       -- Rename free variables that are not supposed to be captured.
       function cfg.id.free (id)
          local old_name = id[1]
          if self.keep[old_name] then return end
          local new_name = free_vars[old_name]
          if not new_name then
             new_name = mlp.gensym('X.'..old_name)[1]
             free_vars[old_name] = new_name
             table.insert(alpha[1], `Id{new_name})
             table.insert(alpha[2], `Id{old_name})
          end
          id[1] = new_name
       end
    end

    -----------------------------------------------------------------------------
    -- Inside hygienization: rename all local variables and their ocurrences.
    -----------------------------------------------------------------------------
    if h_inside then

       ----------------------------------------------------------------
       -- Renamings can't performed on-the-spot, as it would
       -- transiently break the link between binders and bound vars,
       -- thus preventing the algo to work. They're therefore stored
       -- in local_renames, and performed after the whole tree has been
       -- walked.
       ----------------------------------------------------------------

       local_renames = { }    -- `Id{ old_name } -> new_name
       local bound_vars = { } -- binding statement -> old_name -> new_name

       ----------------------------------------------------------------
       -- Give a new name to newly created local vars, store it in
       -- bound_vars
       ----------------------------------------------------------------
       function cfg.binder (id, binder)
          if id.h_boundary then return end
          local old_name = id[1]
          local binder_table = bound_vars[binder]
          if not binder_table then
             binder_table = { }
             bound_vars[binder] = binder_table
          end
          local new_name = mlp.gensym('L.'..old_name)[1]
          binder_table[old_name] = new_name
          local_renames[id] = new_name
       end

       ----------------------------------------------------------------
       -- List a bound var for renaming.  The new name has already been
       -- chosen and put in bound_vars by cfg.binder().
       ----------------------------------------------------------------
       function cfg.id.bound (id, binder)
          if id.h_boundary then return end
          local old_name = id[1]
          local new_name = bound_vars[binder][old_name]
          --.log(bound_vars[binder])
          assert(new_name, "no alpha conversion for a bound var?!")
          local_renames[id] = new_name
       end
    end

    -----------------------------------------------------------------------------
    -- Don't traverse subtrees marked by '!'
    -----------------------------------------------------------------------------
    local cut_boundaries = |x| x.h_boundary and 'break' or nil
    cfg.stat.down, cfg.expr.down = cut_boundaries, cut_boundaries

    -----------------------------------------------------------------------------
    -- The walker's config is ready, let's go.
    -- After that, ids are renamed in ast, free_vars and bound_vars are set.
    -----------------------------------------------------------------------------
    walk_id [self.kind or 'guess'] (cfg, ast)

    if h_inside then -- Apply local name changes
       for id, new_name in pairs(local_renames) do id[1] = new_name end
    end

    return ast
 end

 --------------------------------------------------------------------------------
 -- Return H to allow call chainings
 --------------------------------------------------------------------------------
 function H:set(field, val)
    local t = type(field)
    if t=='string' then self[field]=val
    elseif t=='table' then self <- field
    else error("Can't set H, field arg can't be of type "..t) end
    return self
 end

 --------------------------------------------------------------------------------
 -- Return the value before reset
 --------------------------------------------------------------------------------
 function H:reset(field)
    if type(field) ~= 'string' then error "Can only reset H string fields" end
    local r = H[field]
    H[field] = nil
    return r
 end

 -- local function commit_locals_to_chunk(x)
 --    local alpha = H:reset 'alpha'
 --    --$log ('commit locals', x, alpha, 'nohash')
 --    if not alpha or not alpha[1][1] then return end
 --    if not x then return alpha end
 --    table.insert(x, 1, alpha)
 -- end

 -- mlp.chunk.transformers:add (commit_locals_to_chunk)
	-------------------------------------------------------------------------------
	-- Copyright (c) 2006-2013 Fabien Fleutot and others.
	--
	-- All rights reserved.
	--
	-- This program and the accompanying materials are made available
	-- under the terms of the Eclipse Public License v1.0 which
	-- accompanies this distribution, and is available at
	-- http://www.eclipse.org/legal/epl-v10.html
	--
	-- This program and the accompanying materials are also made available
	-- under the terms of the MIT public license which accompanies this
	-- distribution, and is available at http://www.lua.org/license.html
	--
	-- Contributors:
	-- Fabien Fleutot - API and implementation
	--
	-------------------------------------------------------------------------------

	require 'metalua.walk.id'
	-{ extension 'log' }

	--------------------------------------------------------------------------------
	--
	-- H params:
	-- * H.alpha is the `Local{ } (or `Set{ }) statement which will
	-- receive the alpha-conversions required to restore the free
	-- variables of the transformed term. For instance,
	-- H+{print(1)} will be transformed into +{.1.X.print(1)},
	-- and alpha will contain +{local -{`Id '.1.X.print} = print }.
	-- alpha is reused and augmented by successive calls to H().
	--
	-- * H.side contains 'inside', 'outside', 'both' or nil (equivalent to
	-- 'both'). It indicates the kind of hygienization that's to be
	-- performed.
	--
	-- * H.keep contain a set of free variable names which must not be
	-- renamed.
	--
	-- * H.kind is the kind of walker that must be used ('expr', 'stat',
	-- 'block'...) and defaults to 'guess'.
	--
	-- * H:set (field, val) sets a field in H and returns H, so that calls
	-- can be chained, e.g.:
	-- > H:set(keep, {'print'}):set('side', outside)+{print(x)}
	--
	-- * H:reset(field) sets a field to nil, and returns the value of that
	-- field prior to nilification.
	--------------------------------------------------------------------------------

	H = { } --setmetatable(H, H)
	H.__index=H
	H.template = { alpha = { } }

	--------------------------------------------------------------------------------
	--
	--------------------------------------------------------------------------------
	function H:new(x)
	local instance = table.deep_copy(self.template)
	if x then instance <- x end
	setmetatable(instance, self)
	return instance
	end

	--------------------------------------------------------------------------------
	--
	--------------------------------------------------------------------------------
	function H:__call (ast)
	assert (type(ast)=='table', "H expects an AST")

	local local_renames -- only set if inside hygienization's required

	-----------------------------------------------------------------------------
	-- kind of hygienization(s) to perform: h_inseide and/or h_outside
	-----------------------------------------------------------------------------
	local h_inside, h_outside do
	local side = self.side or 'both'
	h_inside = side=='inside' or side=='both'
	h_outside = side=='outside' or side=='both'
	end

	-----------------------------------------------------------------------------
	-- Initialize self.keep:
	-- self.keep is a dictionary of free var names to be protected from capture
	-----------------------------------------------------------------------------
	do
	local k = self.keep
	-- If there's no self.keep, that's an empty dictionary
	if not k then k = { }; self.keep = k
	-- If it's a string, consider it as a single-element dictionary
	elseif type(k)=='string' then k = { [k] = true }; self.keep=k
	-- If there's a list-part in self.keep, transpose it:
	else for i, v in ipairs(k) do k[v], k[i] = true, nil end end
	end

	-----------------------------------------------------------------------------
	-- Config skeleton for the id walker
	-----------------------------------------------------------------------------
	local cfg = { expr = { }, stat = { }, id = { } }

	-----------------------------------------------------------------------------
	-- Outside hygienization: all free variables are renamed to fresh ones,
	-- and self.alpha is updated to contain the assignments required to keep
	-- the AST's semantics.
	-----------------------------------------------------------------------------
	if h_outside then
	local alpha = self.alpha

	-- free_vars is an old_name -> new_name dictionary computed from alpha:
	-- self.alpha is not an efficient representation for searching.
	if not alpha then alpha = { }; self.alpha = alpha end
	-- FIXME: alpha should only be overridden when there actually are some
	-- globals renamed.
	if #alpha==0 then alpha <- `Local{ { }, { } } end
	local new, old = unpack(alpha)
	local free_vars = { }

	assert (#new==#old, "Invalid alpha list")
	for i = 1, #new do
	assert (old[i].tag=='Id' and #old[i]==1, "Invalid lhs in alpha list")
	assert (new[i].tag=='Id' and #new[i]==1, "Invalid rhs in alpha list")
	free_vars[old[i][1]] = new[i][1]
	end

	-- Rename free variables that are not supposed to be captured.
	function cfg.id.free (id)
	local old_name = id[1]
	if self.keep[old_name] then return end
	local new_name = free_vars[old_name]
	if not new_name then
	new_name = mlp.gensym('X.'..old_name)[1]
	free_vars[old_name] = new_name
	table.insert(alpha[1], `Id{new_name})
	table.insert(alpha[2], `Id{old_name})
	end
	id[1] = new_name
	end
	end

	-----------------------------------------------------------------------------
	-- Inside hygienization: rename all local variables and their ocurrences.
	-----------------------------------------------------------------------------
	if h_inside then

	----------------------------------------------------------------
	-- Renamings can't performed on-the-spot, as it would
	-- transiently break the link between binders and bound vars,
	-- thus preventing the algo to work. They're therefore stored
	-- in local_renames, and performed after the whole tree has been
	-- walked.
	----------------------------------------------------------------

	local_renames = { } -- `Id{ old_name } -> new_name
	local bound_vars = { } -- binding statement -> old_name -> new_name

	----------------------------------------------------------------
	-- Give a new name to newly created local vars, store it in
	-- bound_vars
	----------------------------------------------------------------
	function cfg.binder (id, binder)
	if id.h_boundary then return end
	local old_name = id[1]
	local binder_table = bound_vars[binder]
	if not binder_table then
	binder_table = { }
	bound_vars[binder] = binder_table
	end
	local new_name = mlp.gensym('L.'..old_name)[1]
	binder_table[old_name] = new_name
	local_renames[id] = new_name
	end

	----------------------------------------------------------------
	-- List a bound var for renaming. The new name has already been
	-- chosen and put in bound_vars by cfg.binder().
	----------------------------------------------------------------
	function cfg.id.bound (id, binder)
	if id.h_boundary then return end
	local old_name = id[1]
	local new_name = bound_vars[binder][old_name]
	--.log(bound_vars[binder])
	assert(new_name, "no alpha conversion for a bound var?!")
	local_renames[id] = new_name
	end
	end

	-----------------------------------------------------------------------------
	-- Don't traverse subtrees marked by '!'
	-----------------------------------------------------------------------------
	local cut_boundaries = \|x\| x.h_boundary and 'break' or nil
	cfg.stat.down, cfg.expr.down = cut_boundaries, cut_boundaries

	-----------------------------------------------------------------------------
	-- The walker's config is ready, let's go.
	-- After that, ids are renamed in ast, free_vars and bound_vars are set.
	-----------------------------------------------------------------------------
	walk_id [self.kind or 'guess'] (cfg, ast)

	if h_inside then -- Apply local name changes
	for id, new_name in pairs(local_renames) do id[1] = new_name end
	end

	return ast
	end

	--------------------------------------------------------------------------------
	-- Return H to allow call chainings
	--------------------------------------------------------------------------------
	function H:set(field, val)
	local t = type(field)
	if t=='string' then self[field]=val
	elseif t=='table' then self <- field
	else error("Can't set H, field arg can't be of type "..t) end
	return self
	end

	--------------------------------------------------------------------------------
	-- Return the value before reset
	--------------------------------------------------------------------------------
	function H:reset(field)
	if type(field) ~= 'string' then error "Can only reset H string fields" end
	local r = H[field]
	H[field] = nil
	return r
	end

	-- local function commit_locals_to_chunk(x)
	-- local alpha = H:reset 'alpha'
	-- --$log ('commit locals', x, alpha, 'nohash')
	-- if not alpha or not alpha[1][1] then return end
	-- if not x then return alpha end
	-- table.insert(x, 1, alpha)
	-- end

	-- mlp.chunk.transformers:add (commit_locals_to_chunk)