src/samples/metalint/metalint.mlua

   1 -{ extension 'match' }
   2 -{ extension 'log' }
   3
   4 require 'strict'
   5 require 'metalua.compiler'
   6
   7 local VERBOSE          = false
   8 local PARSING_OWN_DECL = false
   9 local MY_GLOBALS       = { }
  10 local LOAD_SOURCE      = nil
  11 local DECLARATIONS     = { }
  12 local AUTOLOCALS       = { }
  13
  14
  15 local function debug_print(...)
  16    if VERBOSE then return printf(...) end
  17 end
  18
  19 -- Lexer --
  20 decl_lexer = lexer.lexer:clone()
  21 decl_lexer:add{ 'module', 'free', 'end', 'private' }
  22
  23 -- Parser --
  24
  25 -- Merge two decl together
  26 local function merge (x, y)
  27    --$log('merge', x, y)
  28    for k, v in pairs (y) do
  29       match x[k], v with
  30       | `Free, _ | `Atom{x}, `Atom{x} -> -- pass
  31       | _, `Free | nil, _ -> x[k] = v
  32       | `Module{ _, mod_x }, `Module{ _, mod_y } -> merge (mod_x, mod_y)
  33       | _, _ ->
  34         $log("Merge failure", x[k], v)
  35         error ("Can't merge type elements")
  36       end
  37    end
  38 end
  39
  40 -- break mutual dependency between decl_elem_parser and decl_parser
  41 local _decl_elem_parser = |...| decl_elem_parser(...)
  42
  43 -- Parse a name, presented as an `Id or a `String
  44 local function name(lx)
  45    local a = lx:next()
  46    if a.tag=='String' or a.tag=='Id' then return a[1]
  47    else error("Name expected, got "..table.tostring(a,'nohash')) end
  48 end
  49
  50 function decl_builder(x)
  51    --$log('decl_builder', x)
  52    local r = { }
  53    for y in ivalues(x) do
  54       if y.tag ~= 'Private' then merge (r, {[y[1]]=y}) end
  55    end
  56    return r
  57 end
  58
  59 decl_parser = gg.list{
  60    gg.sequence{ _decl_elem_parser, gg.optkeyword ';', builder = |x|x[1] },
  61    terminators = 'end', builder = decl_builder }
  62
  63 decl_elem_parser = gg.multisequence{
  64    { 'module', name, decl_parser, 'end', builder = |x| `Module{x[1], x[2]} },
  65    { 'free', name, builder = |x| `Free{x[1]} },
  66    { 'private', _decl_elem_parser, builder = |x| PARSING_OWN_DECL and x[1] or `Private },
  67    default = gg.sequence{ name, builder = |x| `Atom{x[1]} } }
  68
  69 decl_elem_parser.transformers:add (function(x) x.loader = LOAD_SOURCE end)
  70
  71 function parse_decl_lib (libname)
  72    debug_print ("Loading decl lib "..libname)
  73    local fd, msg = package.findfile (libname, os.getenv 'LUA_DPATH' or "?.dlua")
  74    if not fd then error ("Can't find declaration file for "..libname) end
  75    local src = fd:read '*a'
  76    fd:close()
  77    return parse_decl_expr (src)
  78 end
  79
  80 function parse_decl_expr (src)
  81    local lx = decl_lexer:newstream (src)
  82    local r  = decl_parser (lx)
  83    --$log('result of parse_decl', r)
  84    merge(DECLARATIONS, r)
  85    return r
  86 end
  87
  88 function parse_decl_file (filename)
  89    debug_print ("Loading decl file "..filename)
  90    local src = mlc.luastring_of_luafile (filename)
  91    return parse_decl_expr (src)
  92 end
  93
  94 -- AST checker --
  95 require 'walk.id'
  96
  97 local function index_autolocal (e, loader)
  98    --$log('index_autolocals', loader)
  99    local is_mine = false
 100    local function get_name(x)
 101       match x with
 102       | `Index{ y, `String{key} } -> return get_name(y)..'~'..key
 103       | `Invoke{ y, `String{key}, _ } ->
 104          error('autolocals for invocation not implemented '..table.tostring(x))
 105       | `Id{ name } -> is_mine = MY_GLOBALS[name]; return '~'..name
 106       | _ -> error(table.tostring(x)..'\n')
 107       end
 108    end
 109    local name = get_name(e)
 110    if is_mine then return end -- Don't index my own global vars
 111    local x = AUTOLOCALS[name]
 112    if not x then x={ }; AUTOLOCALS[name] = x end
 113    table.insert(x, { e, loader })
 114 end
 115
 116 local walk_cfg = { id = { }, stat = { }, expr = { } }
 117
 118 function walk_cfg.id.free(x, ...)
 119    --$log('in free id walker', x)
 120    local parents = {...}
 121    local dic = DECLARATIONS
 122    local name = x[1]
 123    for p in ivalues (parents) do
 124       local decl = dic[name]
 125       if not decl then error("Not declared: "..name) end
 126       match p with
 127       | `Index{ _x, `String{n} } | `Invoke{ _x, `String{n}, ...} if _x==x ->
 128          match decl with
 129          | `Free{...} -> break
 130          | `Atom{...} -> error (name.." is not a module")
 131          | `Module{ _, dic2 } -> dic, name, x = dic2, n, p
 132          end
 133       | _ -> -- x == last checked variable
 134          debug_print("Checked "..table.tostring(x, 'nohash')..
 135                   ", found in "..table.tostring(decl.loader, 'nohash'))
 136          index_autolocal (x, decl.loader)
 137          break
 138       end
 139    end
 140 end
 141
 142 local function try_load_decl (kind, mod_name)
 143    local success, r = pcall(_G['parse_decl_'..kind], mod_name)
 144    if not success then
 145       debug_print("Warning, error when trying to load %s:\n%s", mod_name, r)
 146    else
 147       return r
 148    end
 149 end
 150
 151 local function call_walker(x)
 152    --$log('in call walker', x)
 153    match x with
 154    | `Call{ `Id 'require', `String{ mod_name } } ->
 155       if not DECLARATIONS[mod_name] then
 156          LOAD_SOURCE = `Require{x}
 157          try_load_decl('lib', mod_name)
 158       end
 159    | `Module{ `Id 'module', _ } -> -- no package.seeall
 160       DECLARATIONS = { }           -- reset declarations
 161    | _ -> -- pass
 162    end
 163 end
 164
 165 walk_cfg.expr.down = call_walker
 166 walk_cfg.stat.down = call_walker
 167
 168 local CHECKED_AST, CHECKED_NAME
 169
 170 function check_src_file(name)
 171    debug_print ("Checking file "..name)
 172    CHECKED_NAME = name
 173    CHECKED_AST  = mlc.ast_of_luafile (name)
 174    --$log(ast,'nohash')
 175    PARSING_OWN_DECL = true
 176    local x = try_load_decl('lib', name:gsub("%.m?lua$", ""))
 177    for name in keys(x) do MY_GLOBALS[name] = true end
 178    PARSING_OWN_DECL = false
 179    walk_id.block (walk_cfg, CHECKED_AST)
 180    printf("File %s checked successfully", name)
 181 end
 182
 183 local function replace_autolocals ()
 184    local top_defs, req_defs = { }, { }
 185    for k, v in pairs (AUTOLOCALS) do
 186       local original = table.shallow_copy(v[1][1])
 187       local loader   = v[1][2]
 188       match loader with
 189       | `Require{ r } ->
 190          local defs =  req_defs[r]
 191          if not defs then defs={ }; req_defs[r]=defs end
 192          defs[k] = original
 193       | `Base | `Directive ->
 194          top_defs[k] = original
 195       end
 196       for exlo in ivalues (v) do
 197          local expr, this_loader = unpack(exlo)
 198          assert (this_loader[1]==loader[1] and this_loader.tag==loader.tag,
 199                  "Autolocal lost by homonymous declarations")
 200          expr <- `Id{k}
 201       end
 202    end
 203
 204    -- Insert beginning-of-file local declarations
 205    local top_locals = `Local{ { }, { } }
 206    for k, v in pairs(top_defs) do
 207       table.insert(top_locals[1], `Id{k})
 208       table.insert(top_locals[2], v)
 209    end
 210    table.insert (CHECKED_AST, 1, top_locals)
 211
 212    -- Insert declarations after require() statements
 213    for req_stat, renamings in pairs (req_defs) do
 214       local req_locals = `Local{ { }, { } }
 215       local r2 = table.shallow_copy(req_stat)
 216       req_stat <- { r2, req_locals }; req_stat.tag = nil
 217       for k, v in pairs (renamings) do
 218          table.insert(req_locals[1], `Id{k})
 219          table.insert(req_locals[2], v)
 220       end
 221    end
 222
 223    if clopts_cfg.debug then table.print(CHECKED_AST, 'nohash', 60) end
 224    local chunk = mlc.luacstring_of_ast (CHECKED_AST)
 225    local f = io.open (CHECKED_NAME:gsub('%.m?lua', '')..'.luac', 'w')
 226    f:write(chunk)
 227    f:close()
 228 end
 229
 230 -- RAM dumper --
 231
 232 function decl_dump(name, f)
 233    match type(f) with
 234    | 'nil'      -> f=io.stdout
 235    | 'string'   -> f=io.open(f, 'w') or error ("Can't open file "..f)
 236    | 'userdata' -> -- pass
 237    | t          -> error ("Invalid target file type "..t)
 238    end
 239    local indentation, acc, seen = 0, { }, { }
 240    local function esc(n)
 241       if n:gmatch "[%a_][%w_]*" and not decl_lexer.alpha[n] then return n else return '"'..n..'"' end
 242    end
 243    local function add_line(...) table.insert(acc, table.concat{'  ':rep(indentation), ...}) end
 244    local function rec(n, v)
 245       if seen[v] then add_line ('free ', esc(n), ";")
 246       elseif type(v)=='table' then
 247          seen[v] = true
 248          add_line ('module ', esc(n))
 249          indentation += 1
 250          for n2, v2 in pairs(v) do
 251             if type(n2)=='string' then rec (n2, v2) end
 252          end
 253          indentation -= 1
 254          add_line 'end;'
 255       else
 256          add_line (esc(n), ';')
 257       end
 258    end
 259    rec(name, _G[name])
 260    for line in ivalues (acc) do
 261       f:write(line, '\n')
 262    end
 263    if f~=io.stdout then f:close() end
 264 end
 265
 266
 267 -- options handling --
 268 require 'clopts'
 269
 270 local cl_parser = clopts {
 271    check_src_file,
 272
 273    {  short = 'd', long = 'debug', type = 'boolean',
 274       usage = 'print debug traces', action = function(x) VERBOSE=x end },
 275
 276    {  short = 'l', long = 'decl_lib', type = 'string*', usage = 'load decl lib',
 277       action = function (x) LOAD_SOURCE=`Directive; return parse_decl_lib(x) end },
 278
 279    {  short = 'f', long = 'decl_file', type = 'string*', usage = 'load decl file',
 280       action = function (x) LOAD_SOURCE=`Directive; return parse_decl_file(x) end },
 281
 282    {  short = 'x', long = 'decl_expr', type = 'string*',
 283       usage = 'decl expression to eval',
 284       action = function (x) LOAD_SOURCE=`Directive; return parse_decl_expr(x) end },
 285
 286    {  short = 'a', long = 'autolocals', type = 'boolean',
 287       usage = 'compiles the program with autolocals' } }
 288
 289 LOAD_SOURCE = `Base
 290 try_load_decl('lib', 'base')
 291 clopts_cfg = cl_parser (...)
 292 if clopts_cfg.autolocals then
 293    replace_autolocals()
 294 end