Create a gist now

Instantly share code, notes, and snippets.

@Nymphium /eval.moon
Last active Jan 12, 2016

What would you like to do?
import remove, insert from table
type_s = (obj) -> type(obj) == "string"
type_t = (obj) -> type(obj) == "table"
cp_tbl = (t) ->
return t unless type_t t
rough = (t) -> setmetatable {i, (type_t(j) and rough j or j) for i, j in pairs t}, getmetatable t
dc = (t) ->
ret = {}
for i, j in pairs t
unless type_t j
ret[i] = j
else
ok, cont = pcall rough, j
ret[i] = ok and cont or j
setmetatable ret, getmetatable t
dc t
strmguard = (str, t) ->
for i = 1, #t, 2
if not type_s(t[i]) and type(t[i + 1]) != "function"
error "strmguard failed"
if str\match t[i]
return t[i + 1]!
t.default! if t.default
strip_string = (str) ->
dq = str\match "^\"(.*)\""
dq and dq or (load "return #{str\gsub ".-(%[(=*)%[.-%]%2%]).-", "%1"}")!
-- for mutual recursive functions
local *
__ENV = _G
eval_exp = (exp, env) ->
switch type(exp)
when "string"
strmguard exp,
{
"^%d", -> tonumber exp
"^nil$", -> nil
"^true$", -> true
"^false$", -> false
"^[_a-zA-Z]", -> env[exp]
default: -> strip_string exp
}
when "table"
switch exp.label
when "table"
ret = {}
for i in *exp
switch type i
when "string"
insert ret, (eval_exp i, env)
when "table"
ret[i[1]] = eval_exp i, env
ret
when "funcall"
eval_funcall exp[1], exp[2], env
when "annonymousfuncdef"
eval_funcdef exp, env
when nil
if exp[2]
do_l = -> eval_exp exp[1], env
do_r = -> eval_exp exp[2], env
switch exp.op
when "or" do_l! or do_r!
when "and" do_l! and do_r!
when "<=" do_l! <= do_r!
when ">=" do_l! >= do_r!
when "~=" do_l! ~= do_r!
when "==" do_l! == do_r!
when ">" do_l! > do_r!
when "<" do_l! < do_r!
when "|" do_l! | do_r!
when "~" do_l! ~ do_r!
when "&" do_l! & do_r!
when "<<" do_l! << do_r!
when ">>" do_l! >> do_r!
when ".." do_l! .. do_r!
when "+" do_l! + do_r!
when "-" do_l! - do_r!
when "//" do_l! // do_r!
when "*" do_l! * do_r!
when "/" do_l! / do_r!
when "%" do_l! % do_r!
when "^" do_l! ^ do_r!
else
do_e = -> eval_exp exp[1], env
switch exp.op
when "-"
-do_e!
when "~"
~do_e!
when "#"
#do_e!
when "not"
not do_e!
expand_tbl = (tbl, env) ->
if type_s tbl[2]
tbl[2] = (tbl[2]\match "^\"(.*)\"$") or tbl[2]
tbl[2] = (tonumber tbl[2]) or tbl[2]
(env._lexcep_tmp and env._lexcep_tmp[tbl[2]] or env[tbl[1]][tbl[2]]), env
elseif tbl[2].label == "tableaccess"
env._lexcep_tmp = env._lexcep_tmp and env._lexcep_tmp[tbl[2][1]] or env[tbl[1]][tbl[2][1]]
expand_tbl tbl[2], env
else
eval_body tbl, env
funstack = {
pushcresume: (fun) =>
insert @, {coroutine.create fun}
coroutine.resume @[#@][1]
pop: =>
remove @
stopregret: (ret) =>
insert @[#@], ret
coroutine.yield @[#@][1]
}
eval_funcdef = (def, env) ->
nenv = cp_tbl env
(...) ->
-- TODO varlen args, and so on
gargs = {...}
for i = 1, #def[1]
nenv[def[1][i]] = gargs[i]
funstack\pushcresume ->
nenv = eval def[2], nenv
ret = funstack\pop!
if ret[2]
unpack ret[2]
eval_funcall = (fun, args, env) ->
if type_t fun
if fun.label == "tableaccess"
fun = expand_tbl fun, env
elseif fun.label == "table"
fun, env = eval_exp fun, env
if args.label == "colonfunc"
if (type_s fun) and (fun\match"^\"" or fun\match"^%[=*%[")
selfarg = fun
fun = string[args[1]]
args = args[2]
insert args, 1, selfarg
else
fun = env[fun][args[1]]
args = args[2]
fun = env[fun] if type_s fun
fmt_args = {}
for i in *args
a = {eval_exp i, env}
for j in *a
insert fmt_args, j
fun unpack fmt_args
eval_body = (body, _e) ->
env = cp_tbl _e
register_var = (body, regtbl) ->
ex = {}
for var = 1, #body
varname = body[var][1]
if body[var][2]
exps = {eval_exp body[var][2], env}
for e in *exps
insert ex, e
regtbl[varname] = remove ex, 1
switch body.label
when "do"
eval body[1], env
when "return"
funstack\stopregret [eval_exp i, env for i in *body]
when "break"
env._lexcep_costack\popyield!
when "varlist"
register_var body, __ENV
when "localvarlist"
register_var body, env
when "funcall"
remove {eval_funcall body[1], body[2], env}
when "tableaccess"
expand_tbl body, env
when "funcdef"
funcname = table.remove body, 1
__ENV[funcname] = eval_funcdef body, env
when "localfuncdef"
funcname = table.remove body, 1
env[funcname] = eval_funcdef body, env
when "while"
_e._lexcep_costack\pushcresume ->
while true
local cond
if type_t body[1] and body[1].label == "funcall"
rets = {eval_exp body[1], env}
env = remove rets
cond = rets[1]
else
cond = eval_exp body[1], env
-- unless cond
if not (cond or env._lexcep_break)
break
env = eval body[2], env
when "for"
var = body[1]
env[var] = eval_exp body[2], env
cnt = env[var]
forend = eval_exp body[3], env
local step
if #body < 5
step = 1
body = body[4]
else
step = body[4]
body = body[5]
_e._lexcep_costack\pushcresume ->
while true
env = eval body, env
cnt += step
env[var] = cnt
break if (env[var] > forend or env._lexcep_break)
-- when "iter"
-- TODO: implement iterator eval
-- itbody = remove body
-- factory = remove body
-- vars = body
-- body = itbody
when "if"
cond = eval_exp body[1], env
ifbody = body[2]
elsebody = body[3]
if cond
eval ifbody, env
elseif elsebody
eval (elsebody[1].label == "if" and elsebody or elsebody[1]), env
env
eval = (syntaxtree, _e = {}) ->
env = setmetatable (cp_tbl _e), __index: __ENV, __mode: 'kv'
-- coroutine stack: for/while loop control
env._lexcep_costack = setmetatable {
pushcresume: (fun) =>
insert @, coroutine.create fun
coroutine.resume @[#@]
popyield: =>
coroutine.yield remove @
}, __mode: "kv"
for i in *syntaxtree
env = eval_body i, env
env
eval
import P,S, V,
C, Cb, Cc, Cg, Cs, Cmt, Ct, Cf, Cp
locale, match from require 'lulpeg'
import insert, remove from table
locale = locale!
K = (k) -> P(k) * -(locale.alnum + P'_')
CV = (pat) -> C V pat
CK = (pat) -> C K pat
CP = (pat) -> C P pat
CS = (pat) -> C S pat
CtV = (pat) -> Ct V pat
opt = (pat) -> (pat)^-1
ast = (pat) -> (pat)^0
lbl_tbl = (lbl) -> (...) -> {label: lbl, ...}
-- unificate ({else{if}}, {else{if}}, ... ==> {else{if{else{if ...)
nest_tbl = (...) ->
args = {...}
return args[1] if #args < 2
tail = remove args
insert args[#args][1], tail
nest_tbl unpack args
-- "x", "+", "y", "-", "z"... ==> {op:"-", {op:"+", "x", "y"}, "z"}
gen_binoptbl = (a, b, c, ...) ->
unless c
b and {op: a, b} or a
else
gen_binoptbl {op:b, a, c}, ...
-- "not", "not", "not", "true" ==> {op: "not", {op:"not", {op: "not", "true"}}}
gen_unoptbl = (...) ->
args = {...}
val = remove args
t = {op: remove(args), val}
insert args, t
#args < 2 and (t.op and t or val) or gen_unoptbl unpack args
exp_gen = (next, pat) ->
V(next) * ast(V'space' * pat * V'space' * V(next)) / gen_binoptbl
-- {"x", "y", "z", "k"}, {"1", "2", "3"} ==> {"x", "1"}, {"y", "2"}, {"z", "3"}, {"k"}
-- {"x", "y"}, {"1","2", "f(x)"} ==> {"x", "1"}, {"y", "2"}, {"_lexcep_unused#{unused_counter}", parse("f(x)")}
unused_counter = 0
merge_tbl = (t1, t2) ->
if t1
h1 = remove t1, 1
h2 = t2 and (remove t2, 1) or nil
if not h1 and h2
h1 = "_lexcep_unused#{unused_counter}"
unused_counter += 1
if h1 then
{h1, h2}, merge_tbl(t1, t2)
gen_accesstbl = (a, ...) ->
#{...} < 1 and a or {label: "tableaccess", a, gen_accesstbl ...}
normalize_funcbody = (...) ->
body = {...}
args = remove body, 1
cont = remove body
if cont.label == "return"
args, body, cont
else
insert body, cont
args, body
-- {...}
-- (cont.label == "return") and args, cont or {...}
lua = P{
opt(P'#' * ast(1 - P'\n') * P'\n') * V'space' * CtV'chunk' * V'space' * -P(1)
keywords: K'and' + K'break' + K'do' + K'else' + K'elseif' +
K'end' + K'false' + K'for' + K'function' + K'if' +
K'in' + K'local' + K'nil' + K'not' + K'or' + K'repeat' +
K'return' + K'then' + K'true' + K'until' + K'while'
longstring: C P{
V'open' * C(ast(P(1) - V'closeeq')) * V'close' / (_, s) -> s
open: '[' * Cg(ast(P'='), 'init') * P'[' * opt(P'\n')
close: ']' * C(ast(P'=')) * ']'
closeeq: Cmt(V'close' * Cb'init', (_, _, a, b) -> a == b)
}
comment: P'--' * V'longstring' +
P'--' * ast(P(1) - P'\n') * (P'\n' + -P(1))
space: ast(locale.space + V'comment')
Name: (locale.alpha + P'_') * ast(locale.alnum + P'_') - V'keywords'
Number: P'0x' * (locale.xdigit)^1 * -(locale.alnum + P'_') +
locale.digit^1 * opt(P'.' * locale.digit^1) * opt(S'eE' * locale.digit^1) * -(locale.alnum + P'_') +
P'.' * locale.digit^1 * opt(S'eE' * locale.digit^1) * -(locale.alnum + P'_')
String: C((P"\"" * ast(P"\\" * P(1) + (1 - P"\"")) * P"\"") +
(P"'" * ast(P"\\" * P(1) + (1 - P"'")) * P"'")) +
(V"longstring" / (a, b) -> a)
fieldsep: P',' +
P';'
chunk: ast(V'space' * V'stat' * opt(V'space' * P';')) *
opt(V'space' * V'laststat' * opt(V'space' * P';'))
block: V'chunk'
stat: K'do' * V'space' * CtV'block' * V'space' * K'end' / lbl_tbl'do' +
K'while' * V'space' * V'exp' * V'space' * K'do' * V'space' *
CtV'block' / lbl_tbl'while' * V'space' * K'end' +
K'repeat' * V'space' * CtV'block' /lbl_tbl'repeat' * V'space' * K'until' *
V'space' * V'exp' +
K'if' * V'space' * V'exp' * V'space' * K'then' *
V'space' * CtV'block' * V'space' *
(ast(K'elseif' * V'space' * V'exp' * V'space' * K'then' *
V'space' * CtV'block' / lbl_tbl'if' / lbl_tbl'else' * V'space') *
-- what a fuckin bug
opt(K'else' * V'space' * CtV'block' / lbl_tbl'else' * V'space') / nest_tbl / (t) -> type(t) == "table" and t or nil) * K'end' / lbl_tbl'if' +
K'for' * V'space' * CV'Name' * V'space' * P'=' * V'space' *
V'exp' * V'space' * P',' * V'space' * V'exp' *
opt(V'space' * P',' * V'space' * V'exp') * V'space' *
K'do' * V'space' * CtV'block' * V'space' * K'end' / lbl_tbl'for' +
K'for' * V'space' * V'namelist' * V'space' * K'in' * V'space' *
V'explist' * V'space' * K'do' * V'space' * CtV'block' / lbl_tbl'iter' *
V'space' * K'end' +
K'function' * V'space' * V'funcname' * V'space' * V'funcbody' / lbl_tbl'funcdef' +
K'local' * V'space' * K'function' * V'space' * CV'Name' * V'space' * V'funcbody' / lbl_tbl'localfuncdef' +
(K'local' * V'space' * CtV'namelist' * opt(V'space' * P'=' * V'space' * CtV'explist') / merge_tbl) / lbl_tbl'localvarlist' +
((CtV'varlist' * V'space' * P'=' * V'space' * CtV'explist') / merge_tbl) / lbl_tbl'varlist' +
V'funcall'
laststat: (K'return' / -> * opt V'space' * V'explist') / lbl_tbl'return' + K'break' / -> label:'break'
namelist: CV'Name' * ast(V'space' * P',' * V'space' * CV'Name')
varlist: V'var' * ast(V'space' * P',' * V'space' * V'var')
value: CK'nil' +
CK'false' +
CK'true' +
CV'Number' +
V'String' +
CP'...' +
V'funcdef' +
V'tableconstructor' +
V'funcall' +
V'var' +
P'(' * V'space' * V'exp' * V'space' * P')'
exp: V'lor'
lor: exp_gen 'land', CK'or'
land: exp_gen 'cmp', CK'and'
cmp: exp_gen 'or', C(P'<=' + P'>=' + P'~=' + P'==' + S'<>')
or: exp_gen 'xor', CP'|'
xor: exp_gen 'and', CP'~'
and: exp_gen 'shift', CP'&'
shift: exp_gen 'cnct', C(P'<<' + P'>>')
cnct: exp_gen 'term', CP'..'
term: exp_gen 'fact', CS'+-'
fact: exp_gen 'hat', C(P'//' + S'*/%')
hat: exp_gen 'expend', CP'^'
expend: ast(C((K'not') + S'-~#') * V'space') * V'value' / gen_unoptbl + exp_gen 'value', V'exp'
explist: V'exp' * ast(V'space' * P',' * V'space' * V'exp')
index: P'[' * V'space' * V'exp' * V'space' * P']' +
P'.' * V'space' * CV'Name'
colonfunc: P':' * V'space' * CV'Name'
call: V'callargs' + V'colonfunc' * V'space' * V'callargs' / lbl_tbl'colonfunc'
prefix: P'(' * V'space' * V'exp' * V'space' * P')' + CV'Name'
suffix: V'call' + V'index'
var: (V'prefix' * ast(V'space' * V'suffix' * #(V'space' * V'suffix')) * V'space' * V'index' + CV'Name') / gen_accesstbl
funcall: V'prefix' * ast(V'space' * V'suffix' * #(V'space' * V'suffix')) / gen_accesstbl * V'space' * V'call' / lbl_tbl'funcall'
funcname: C(V'Name' * ast(V'space' * P'.' * V'space' * V'Name') *
opt(V'space' * P':' * V'space' * CV'Name'))
callargs: Ct(P'(' * V'space' * opt(V'explist' * V'space') * P')' +
(V'tableconstructor' + V'String'))
funcdef: K'function' * V'space' * (V'funcbody' / lbl_tbl'annonymousfuncdef')
-- LPeg's bug? When (Lu)LPeg matches nothing here, returns a string "()".
-- funcbody: P'(' * V'space' * opt(V'parlist' * V'space') * P')' *
-- V'space' * V'block' * V'space' * K'end'
funcbody: (P'(' * V'space' * opt(V'parlist' * V'space') * P')') / lbl_tbl'args' *
-- V'space' * V'block' / normalize_funcbody * V'space' * K'end'
V'space' * CtV'block' * V'space' * K'end'
parlist: (V'namelist' * opt(V'space' * P',' * V'space' * CP'...') + CP'...')
tableconstructor: CP'{' * V'space' * opt(V'fieldlist' * V'space') * P'}' / (a, ...) -> (lbl_tbl'table') ...
fieldlist: V'field' * ast(V'space' * V'fieldsep' * V'space' * V'field') * opt(V'space' * V'fieldsep')
field: (P'[' * V'space' * V'exp' * V'space' * P']' * V'space' * P'=' * V'space' * V'exp' / (a, b) -> {a, b}) +
(CV'Name' * V'space' * P'=' * V'space' * V'exp' / (a, b) -> {a, b}) +
V'exp'
-- field: V'exp'
}
(msg) ->
t = lua\match msg
unused_counter = 0
t
#!/usr/bin/env moon
-- getopt = require'alt_getopt'
parse = require"parse"
eval = require"eval"
fileread = (filename) ->
fh = assert io.open filename
with fh\read '*a'
fh\close!
if arg[1]
t, err = parse "do #{fileread arg[1]} end"
unless t
error "#{err} #{arg[1]}"
ok, err = pcall eval, t
unless ok
error err
os.exit!
inspect = require'inspect'
iprint = (...) -> print (inspect {...})\match("^{ (.*) }$")
parseval = (line, env) ->
tree = parse line
if not tree
ok, cont = pcall eval, (parse "_llix_tmp = #{line}"), env
if ok
iprint cont._llix_tmp
else print "failed to parse"
elseif #tree > 0
ok, err = pcall eval, tree, env
print err unless ok
-- repl body
env = {}
block = {}
prompt = setmetatable({
p: ">"
deepen: => @p = @p\rep 2
reset: => @p = ">"
}, __call: => io.write "#{@p} ")
local continue_flag
while true
prompt!
ok, line = pcall io.read
return unless ok and line
if line_withn = line\match'(.-)%s*\\%s*$'
prompt\deepen! unless continue_flag
table.insert block, line_withn
continue_flag = true
continue
if continue_flag
table.insert block, line
prompt\reset!
continue_flag = false
if #block > 0
parseval (table.concat block, '\n'), env
block = {}
else parseval line, env
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment