src/lib/extension/H-runtime.mlua

   1 require 'walk.id'
   2 -{ extension 'log' }
   3
   4 --------------------------------------------------------------------------------
   5 --
   6 -- H params:
   7 -- * H.alpha is the `Local{ } (or `Set{ }) statement which will
   8 --   receive the alpha-conversions required to restore the free
   9 --   variables of the transformed term. For instance,
  10 --   H+{print(1)} will be transformed into +{.1.X.print(1)},
  11 --   and alpha will contain +{local -{`Id '.1.X.print} = print }.
  12 --   alpha is reused and augmented by successive calls to H().
  13 --
  14 -- * H.side contains 'inside', 'outside', 'both' or nil (equivalent to
  15 --   'both'). It indicates the kind of hygienization that's to be
  16 --   performed.
  17 --
  18 -- * H.keep contain a set of free variable names which must not be
  19 --   renamed.
  20 --
  21 -- * H.kind is the kind of walker that must be used ('expr', 'stat',
  22 --   'block'...) and defaults to 'guess'.
  23 --
  24 -- * H:set (field, val) sets a field in H and returns H, so that calls
  25 --   can be chained, e.g.:
  26 --   > H:set(keep, {'print'}):set('side', outside)+{print(x)}
  27 --
  28 -- * H:reset(field) sets a field to nil, and returns the value of that
  29 --   field prior to nilification.
  30 --------------------------------------------------------------------------------
  31
  32 H = { } --setmetatable(H, H)
  33 H.__index=H
  34 H.template = { alpha = { } }
  35
  36 --------------------------------------------------------------------------------
  37 --
  38 --------------------------------------------------------------------------------
  39 function H:new(x)
  40    local instance = table.deep_copy(self.template)
  41    if x then instance <- x end
  42    setmetatable(instance, self)
  43    return instance
  44 end
  45
  46 --------------------------------------------------------------------------------
  47 --
  48 --------------------------------------------------------------------------------
  49 function H:__call (ast)
  50    assert (type(ast)=='table', "H expects an AST")
  51
  52    local local_renames -- only set if inside hygienization's required
  53
  54    -----------------------------------------------------------------------------
  55    -- kind of hygienization(s) to perform: h_inseide and/or h_outside
  56    -----------------------------------------------------------------------------
  57    local h_inside, h_outside do
  58       local side = self.side or 'both'
  59       h_inside   = side=='inside'  or side=='both'
  60       h_outside  = side=='outside' or side=='both'
  61    end
  62
  63    -----------------------------------------------------------------------------
  64    -- Initialize self.keep:
  65    -- self.keep is a dictionary of free var names to be protected from capture
  66    -----------------------------------------------------------------------------
  67    do
  68       local k = self.keep
  69       -- If there's no self.keep, that's an empty dictionary
  70       if not k then k = { }; self.keep = k
  71       -- If it's a string, consider it as a single-element dictionary
  72       elseif type(k)=='string' then k = { [k] = true }; self.keep=k
  73       -- If there's a list-part in self.keep, transpose it:
  74       else for i, v in ipairs(k) do k[v], k[i] = true, nil end end
  75    end
  76
  77    -----------------------------------------------------------------------------
  78    -- Config skeleton for the id walker
  79    -----------------------------------------------------------------------------
  80    local cfg = { expr = { }, stat = { }, id = { } }
  81
  82    -----------------------------------------------------------------------------
  83    -- Outside hygienization: all free variables are renamed to fresh ones,
  84    -- and self.alpha is updated to contain the assignments required to keep
  85    -- the AST's semantics.
  86    -----------------------------------------------------------------------------
  87    if h_outside then
  88       local alpha = self.alpha
  89
  90       -- free_vars is an old_name -> new_name dictionary computed from alpha:
  91       -- self.alpha is not an efficient representation for searching.
  92       if not alpha then alpha = { }; self.alpha = alpha end
  93       -- FIXME: alpha should only be overridden when there actually are some
  94       -- globals renamed.
  95       if #alpha==0 then alpha <- `Local{ { }, { } } end
  96       local new, old = unpack(alpha)
  97       local free_vars  = { }
  98
  99       assert (#new==#old, "Invalid alpha list")
 100       for i = 1, #new do
 101          assert (old[i].tag=='Id' and #old[i]==1, "Invalid lhs in alpha list")
 102          assert (new[i].tag=='Id' and #new[i]==1, "Invalid rhs in alpha list")
 103          free_vars[old[i][1]] = new[i][1]
 104       end
 105
 106       -- Rename free variables that are not supposed to be captured.
 107       function cfg.id.free (id)
 108          local old_name = id[1]
 109          if self.keep[old_name] then return end
 110          local new_name = free_vars[old_name]
 111          if not new_name then
 112             new_name = mlp.gensym('X.'..old_name)[1]
 113             free_vars[old_name] = new_name
 114             table.insert(alpha[1], `Id{new_name})
 115             table.insert(alpha[2], `Id{old_name})
 116          end
 117          id[1] = new_name
 118       end
 119    end
 120
 121    -----------------------------------------------------------------------------
 122    -- Inside hygienization: rename all local variables and their ocurrences.
 123    -----------------------------------------------------------------------------
 124    if h_inside then
 125
 126       ----------------------------------------------------------------
 127       -- Renamings can't performed on-the-spot, as it would
 128       -- transiently break the link between binders and bound vars,
 129       -- thus preventing the algo to work. They're therefore stored
 130       -- in local_renames, and performed after the whole tree has been
 131       -- walked.
 132       ----------------------------------------------------------------
 133
 134       local_renames = { }    -- `Id{ old_name } -> new_name
 135       local bound_vars = { } -- binding statement -> old_name -> new_name
 136
 137       ----------------------------------------------------------------
 138       -- Give a new name to newly created local vars, store it in
 139       -- bound_vars
 140       ----------------------------------------------------------------
 141       function cfg.binder (id, binder)
 142          if id.h_boundary then return end
 143          local old_name = id[1]
 144          local binder_table = bound_vars[binder]
 145          if not binder_table then
 146             binder_table = { }
 147             bound_vars[binder] = binder_table
 148          end
 149          local new_name = mlp.gensym('L.'..old_name)[1]
 150          binder_table[old_name] = new_name
 151          local_renames[id] = new_name
 152       end
 153
 154       ----------------------------------------------------------------
 155       -- List a bound var for renaming.  The new name has already been
 156       -- chosen and put in bound_vars by cfg.binder().
 157       ----------------------------------------------------------------
 158       function cfg.id.bound (id, binder)
 159          if id.h_boundary then return end
 160          local old_name = id[1]
 161          local new_name = bound_vars[binder][old_name]
 162          --.log(bound_vars[binder])
 163          assert(new_name, "no alpha conversion for a bound var?!")
 164          local_renames[id] = new_name
 165       end
 166    end
 167
 168    -----------------------------------------------------------------------------
 169    -- Don't traverse subtrees marked by '!'
 170    -----------------------------------------------------------------------------
 171    local cut_boundaries = |x| x.h_boundary and 'break' or nil
 172    cfg.stat.down, cfg.expr.down = cut_boundaries, cut_boundaries
 173
 174    -----------------------------------------------------------------------------
 175    -- The walker's config is ready, let's go.
 176    -- After that, ids are renamed in ast, free_vars and bound_vars are set.
 177    -----------------------------------------------------------------------------
 178    walk_id [self.kind or 'guess'] (cfg, ast)
 179
 180    if h_inside then -- Apply local name changes
 181       for id, new_name in pairs(local_renames) do id[1] = new_name end
 182    end
 183
 184    return ast
 185 end
 186
 187 --------------------------------------------------------------------------------
 188 -- Return H to allow call chainings
 189 --------------------------------------------------------------------------------
 190 function H:set(field, val)
 191    local t = type(field)
 192    if t=='string' then self[field]=val
 193    elseif t=='table' then self <- field
 194    else error("Can't set H, field arg can't be of type "..t) end
 195    return self
 196 end
 197
 198 --------------------------------------------------------------------------------
 199 -- Return the value before reset
 200 --------------------------------------------------------------------------------
 201 function H:reset(field)
 202    if type(field) ~= 'string' then error "Can only reset H string fields" end
 203    local r = H[field]
 204    H[field] = nil
 205    return r
 206 end
 207
 208 -- local function commit_locals_to_chunk(x)
 209 --    local alpha = H:reset 'alpha'
 210 --    --$log ('commit locals', x, alpha, 'nohash')
 211 --    if not alpha or not alpha[1][1] then return end
 212 --    if not x then return alpha end
 213 --    table.insert(x, 1, alpha)
 214 -- end
 215
 216 -- mlp.chunk.transformers:add (commit_locals_to_chunk)