non-CPS llix https://github.com/nymphium/llix

eval.moon

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

parse.moon

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

repl.moon

#!/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