functional programming langageか?

README.md

untyped

$ rlwrap ./repl.moon
> p = \x \y \z + <x, +<y, z>>
> print (p 3 4 5)
12
> -- comment
>

builtin function

• print any_type -> nil print arg to terminal
• + pair -> number
• - pair -> number
• * pair -> number
• / pair -> number
• left pair -> any_type
• right pair -> any_type
• u pair -> [right pair]th number of [left pair] ex:

u <<0, <1, <2, <3, 4>>>>, 3> -- return 3 u <<<0, 1>, <2, 3>>, 0> -- return 0 u <<<0, 1>, <2, 3>>, 1> -- return 2 u <<<0, 1>, <2, 3>>, 2> -- return 3 ```

lambda

only arg, only return

• \x x => function(x) return x end

type

• number 1, -5, 0.8,...
• pair < any_type, _any_type >
• lambda

eval.lua

local remove
remove = table.remove
local insert
insert = function(t, i, o)
  if not (o) then
    o, i = i, #t + 1
  end
  table.insert(t, i, o)
  return t
end
local inspect = require("inspect")
local t_str
t_str = function(obj)
  return type(obj) == "string"
end
local t_tbl
t_tbl = function(obj)
  return type(obj) == "table"
end
local noop
noop = function(x)
  return x
end
local cp_tbl
cp_tbl = function(t)
  local ret = { }
  for i, j in pairs(t) do
    if t_tbl(j) then
      ret[i] = cp_tbl(j)
    else
      ret[i] = j
    end
  end
  do
    local _M = getmetatable(t)
    if _M then
      setmetatable(ret, _M)
    end
  end
  return ret
end
local strmguard
strmguard = function(str, t)
  for i = 1, #t, 2 do
    if not (t_str(t[i]) or type(t[i + 1]) == "function") then
      error("strmguard failed")
    end
    if str:match(t[i]) then
      return t[i + 1]()
    end
  end
  if t.default then
    return t.default()
  end
end
local funstack, builtin, eval_exp, eval_lambda, eval_apply, eval_block, eval
funstack = {
  pushcresume = function(self, fun)
    return coroutine.resume((insert(self, {
      coroutine.create(fun)
    }))[#self][1])
  end,
  stopregret = function(self, ret)
    return coroutine.yield((insert(self[#self], ret))[#self][1])
  end,
  pop = function(self)
    return remove(self)
  end
}
builtin = {
  ["+"] = function(pair)
    return pair[1] + pair[2]
  end,
  ["-"] = function(pair)
    return pair[1] - pair[2]
  end,
  ["*"] = function(pair)
    return pair[1] * pair[2]
  end,
  ["/"] = function(pair)
    return pair[1] / pair[2]
  end,
  left = function(pair)
    return pair[1]
  end,
  right = function(pair)
    return pair[2]
  end,
  print = function(a)
    return (function(x)
      return print(x)
    end)((inspect(a)):gsub("{(.*)}", "<%1>"):gsub("function", "lambda"):gsub("nil", "undefined"))
  end
}
eval_exp = function(exp, env, k)
  local _exp_0 = type(exp)
  if "string" == _exp_0 then
    return k(strmguard(exp, {
      "^%d",
      function()
        return tonumber(exp)
      end,
      "^%.%d",
      function()
        return tonumber(exp)
      end,
      "^[_a-zA-Z]",
      function()
        return env[exp]
      end
    }))
  elseif "table" == _exp_0 then
    local _exp_1 = exp.label
    if "pair" == _exp_1 then
      return eval_exp(exp[1], env, function(left)
        return eval_exp(exp[2], env, function(right)
          return k({
            left,
            right
          })
        end)
      end)
    elseif "apply" == _exp_1 then
      return eval_apply(exp, env, function(exp)
        return k(exp)
      end)
    elseif "lambda" == _exp_1 then
      return eval_lambda(exp, env, k)
    end
  else
    return exp
  end
end
eval_lambda = function(lambda, env, k)
  local nenv = cp_tbl(env)
  return k(function(arg)
    nenv[lambda[1]] = arg
    funstack:pushcresume((function()
      return eval(lambda[2], nenv)
    end))
    return funstack:pop()[2]
  end)
end
eval_apply = function(line, env, k)
  local fun = remove(line, 1)
  if t_str(fun) then
    fun = env[fun]
  end
  return eval_exp((remove(line, 1)), env, function(exp)
    local _exp_0 = type(fun)
    if "function" == _exp_0 then
      return line[1] and (eval_apply((insert(line, 1, fun(exp))), env, k)) or (k(fun(exp)))
    elseif "table" == _exp_0 then
      local _exp_1 = fun.label
      if "apply" == _exp_1 then
        return eval_apply(fun, env, function(f)
          return line[1] and (eval_apply((insert(line, 1, f)), env, k)) or (k(f(exp)))
        end)
      elseif "lambda" == _exp_1 then
        return eval_lambda(fun, env, function(f)
          return line[1] and (eval_apply((insert(line, 1, f)), env, k)) or (k(f(exp)))
        end)
      end
    end
  end)
end
eval_block = function(stat, env, k)
  local _exp_0 = stat.label
  if "var" == _exp_0 then
    return k(eval_exp(stat[2], env, function(exp)
      env[stat[1]] = exp
    end))
  elseif "apply" == _exp_0 then
    return eval_apply(stat, env, k)
  elseif "return" == _exp_0 then
    return eval_exp(stat[1], env, function(exp)
      return funstack:stopregret(exp)
    end)
  end
end
eval = function(syntaxtree, env, k)
  if k == nil then
    k = noop
  end
  syntaxtree = cp_tbl(syntaxtree)
  if not (syntaxtree[1]) then
    return k(env or { })
  else
    env = setmetatable((env or { }), {
      __index = builtin
    })
    return eval_block((remove(syntaxtree, 1)), env, function()
      return eval(syntaxtree, env, k)
    end)
  end
end
return eval

eval.moon

import remove from table

insert = (t, i, o) ->
	unless o
		o, i = i, #t + 1

	table.insert t, i, o

	t

inspect = require"inspect"

typeS = (obj) -> type(obj) == "string"
typeT = (obj) -> type(obj) == "table"
noop = (x) -> x

cp_tbl = (t) ->
	ret = {}

	for i, j in pairs t
		if typeT j
			ret[i] = cp_tbl j
		else
			ret[i] = j
	
	if _M = getmetatable t
		setmetatable ret, _M
	
	ret

strmguard = (str, t) ->
	for i = 1, #t, 2
		unless typeS(t[i]) or type(t[i + 1]) == "function"
			error "strmguard failed"

		if str\match t[i]
			return t[i + 1]!

	t.default! if t.default

local *

funstack =
	pushcresume: (fun) => coroutine.resume (insert @, {coroutine.create fun})[#@][1]
	stopregret: (ret) => coroutine.yield (insert @[#@], ret)[#@][1]
	pop: => remove @

builtin = {
	["+"]: (pair) -> pair[1] + pair[2]
	["-"]: (pair) -> pair[1] - pair[2]
	["*"]: (pair) -> pair[1] * pair[2]
	["/"]: (pair) -> pair[1] / pair[2]
	left: (pair) -> pair[1]
	right: (pair) -> pair[2]
	u: (pair) ->
		import left, right, u from builtin
		t, cnt = left(pair), right(pair)

		if cnt == 0
			left t
			typeT(left t) and (u {(left t), 0}) or left t
		elseif cnt == 1
			typeT(right t) and (u {(right t), 0}) or right t
		else
			u {right(t), cnt - 1}
	print: (a) -> ((x) -> print x) (inspect a)\gsub("{", "<")\gsub("}", ">")\gsub("function", "lambda")\gsub("nil", "undefined")
}

eval_exp = (exp, env, k) -> switch type(exp)
	when "string" k strmguard exp, {
		"^%d", -> tonumber exp
		"^%.%d", -> tonumber exp
		"^[_a-zA-Z]", -> env[exp]
	}

	when "table" switch exp.label
		when "pair"
			eval_exp exp[1], env, (left) -> eval_exp exp[2], env, (right) -> k {left, right}
		when "apply"
			eval_apply exp, env, (exp) -> k exp

		when "lambda"
			eval_lambda exp, env, k
	else
		exp

eval_lambda = (lambda, env, k) ->
	nenv = cp_tbl env

	k (arg) ->
		nenv[lambda[1]] = arg

		funstack\pushcresume (-> eval lambda[2], nenv)
		funstack\pop![2]

eval_apply = (line, env, k) ->
	fun = remove line, 1
	fun = env[fun] if typeS fun

	eval_exp (remove line, 1), env, (exp) -> switch type fun
		when "function" line[1] and (eval_apply (insert line, 1, fun exp), env, k) or (k fun exp)
		when "table" switch fun.label
			when "apply" eval_apply fun, env, (f) -> line[1] and (eval_apply (insert line,1, f), env, k) or (k f exp)
			when "lambda" eval_lambda fun, env, (f) -> line[1] and (eval_apply (insert line, 1, f), env, k) or (k f exp)

eval_block = (stat, env, k) -> switch stat.label
	when "var" k eval_exp stat[2], env, (exp) -> env[stat[1]] = exp
	when "apply" eval_apply stat, env, k
	when "return" eval_exp stat[1], env, (exp) -> funstack\stopregret exp

eval = (syntaxtree, env, k = noop) ->
	syntaxtree = cp_tbl syntaxtree

	unless syntaxtree[1]
		k env or {}
	else
		env = setmetatable (env or {}), __index: builtin
		eval_block (remove syntaxtree, 1), env, -> eval syntaxtree, env, k

eval

parse.lua

local P, S, V, C, Ct, locale, match
do
	local _obj_0 = require('lpeg')
	P, S, V, C, Ct, locale, match = _obj_0.P, _obj_0.S, _obj_0.V, _obj_0.C, _obj_0.Ct, _obj_0.locale, _obj_0.match
end
local insert, remove
do
	local _obj_0 = table
	insert, remove = _obj_0.insert, _obj_0.remove
end
local inspect = require("inspect")
local iprint
iprint = function(...)
	return print((inspect({
					   ...
				   })):match("^{ (.*) }$"))
end
locale = locale()
local CS
CS = function(pat)
	return C(S(pat))
end
local CtV
CtV = function(pat)
	return Ct(V(pat))
end
local opt
opt = function(pat)
	return (pat) ^ -1
end
local ast
ast = function(pat)
	return (pat) ^ 0
end
local Name = (locale.alpha + P('_')) * ast(locale.alnum + P('_'))
local Number = opt(P('-')) * locale.digit ^ 1
local Space = ast(locale.space)
local Brac
Brac = function(cont)
	return P('(') * Space * cont * Space * P(')')
end
local lbl_tbl
lbl_tbl = function(lbl)
	return function(...)
		local args = {
			...
		}
		if type(args[1]) == "string" and #args[1] < 1 then
			return {
				label = lbl
			}
		else
			return {
				label = lbl,
				...
			}
		end
	end
end
local left_join
left_join = function(...)
	local t = {
		...
	}
	local h = remove(t)
	if #t > 0 then
		insert(h, 1, left_join(unpack(t)))
	end
	return h
end
local untyped = P({
				  CtV('Block') * Space * -P(1),
				  Block = ast(Space * V('Stat')),
				  Stat = P('--') * ast(P(1) - P('\n')) * (P('\n') + -P(1)) + C(Name) * Space * P('=') * Space * (V('Apply') + V('Exp')) / lbl_tbl('var') + V('Apply'),
				  Pair = P('<') * Space * (V('Exp') + V('Apply')) * Space * (V('Apply') + V('Exp')) * Space * P('>') / lbl_tbl('pair'),
				  Lambda = P([[\]]) * Space * C(Name) * Space * Ct((V('Apply') + V('Exp')) / lbl_tbl('return')) / lbl_tbl('lambda'),
				  Apply = V('Fun') * (Space * (V('Fun') + V('Exp'))) ^ 1 / lbl_tbl('apply'),
				  Exp = C(Number) + P('<') * Space * (V('Apply') + V('Exp')) * Space * P(',') * Space * (V('Apply') + V('Exp')) * Space * P('>') / lbl_tbl('pair') + V('Lambda') + C(Name),
				  Fun = Brac(V('Lambda')) + C(Name) + CS('+*-/') + (Brac(V('Apply')))
			  })
return function(msg)
	return untyped:match(msg)
end

parse.moon

import P, S, V, C, Ct, locale, match from require 'lpeg'
import insert, remove from table

inspect = require"inspect"
iprint = (...) -> print (inspect {...})\match("^{ (.*) }$")

locale = locale!
CS = (pat) -> C S pat
CtV = (pat) -> Ct V pat
opt = (pat) -> (pat)^-1
ast = (pat) -> (pat)^0
Name = (locale.alpha + P'_') * ast(locale.alnum + P'_')
Number = opt(P'-') * locale.digit^1
Space = ast(locale.space)
Brac = (cont) -> P'(' * Space * cont * Space *  P')'
lbl_tbl = (lbl) -> (...) ->
	args = {...}

	if type(args[1]) == "string" and #args[1] < 1
		label: lbl
	else
		{label: lbl, ...}

-- {f, g}, {h}, {i} ==> {{{f, g}, h}, i}
left_join = (...) ->
	t = {...}
	h = remove t

	if #t > 0
		insert h, 1, left_join unpack t

	h

untyped = P {
	CtV'Block' * Space * -P(1)
	Block:  ast(Space * V'Stat')
	Stat:
		V'Comment' +
		V'Var' +
		V'Apply'

	Comment: P'--' * ast(P(1) - P'\n') * (P'\n' + -P(1))
	Var: C(Name) * Space * P'=' * Space * (V'Apply' + V'Exp') / lbl_tbl'var'
	Apply: V'Fun' * (Space * (V'Fun' + V'Exp'))^1 / lbl_tbl'apply'
	Pair: P'<' * Space * (V'Exp' + V'Apply') * Space * P',' * Space * (V'Apply' + V'Exp') * Space * P'>' / lbl_tbl'pair'
	Lambda: P[[\]] * Space * C(Name) * Space * Ct((V'Apply' + V'Exp') / lbl_tbl'return') / lbl_tbl'lambda'
	Exp:
		C(Number) +
		V'Pair' +
		-- P'<' * Space * (V'Apply' + V'Exp') * Space * P',' * Space * (V'Apply' + V'Exp') * Space * P'>' / lbl_tbl'pair' +
		V'Lambda' +
		C(Name)
	Fun: Brac(V'Lambda') + C(Name) + CS'+*-/' + (Brac(V'Apply'))
}

(msg) -> untyped\match msg

repl.lua

local parse = require("parse")
local eval = require("eval")
local inspect = require('inspect')
local iprint
iprint = function(...)
  return print((inspect({
    ...
  })):match("^{ (.*) }$"))
end
local parseval
parseval = function(line, env)
  local tree = parse(line)
  if not tree then
    local ok = pcall(eval, (parse("print " .. tostring(line))), env)
    if not (ok) then
      return print("failed to parse")
    end
  elseif #tree > 0 then
    local ok, err = pcall(eval, tree, env)
    if not (ok) then
      return print(err)
    end
  end
end
local env = { }
local block = { }
local prompt = ">"
local continue_flag
while true do
  local _continue_0 = false
  repeat
    io.write(tostring(prompt) .. " ")
    local ok, line = pcall(io.read)
    if not (ok and line) then
      return 
    end
    do
      local line_withn = line:match('(.-)%s*\\%s*$')
      if line_withn then
        prompt = ">>"
        table.insert(block, line_withn)
        continue_flag = true
        _continue_0 = true
        break
      elseif continue_flag then
        table.insert(block, line)
        prompt = ">"
      end
    end
    continue_flag = false
    if #block > 0 then
      parseval((table.concat(block, '\n')), env)
      block = { }
    else
      parseval(line, env)
    end
    _continue_0 = true
  until true
  if not _continue_0 then
    break
  end
end

repl.moon

#!/usr/bin/env moon

parse = require"parse"
eval = require"eval"
inspect = require'inspect'
iprint = (...) -> print (inspect {...})\match("^{ (.*) }$")

parseval = (line, env) ->
	tree = parse line

	if not tree
		ok = pcall eval, (parse "print #{line}"), env
		print "failed to parse" unless ok
	elseif #tree > 0
		ok, err = pcall eval, tree, env

		print err unless ok

-- repl body
env = {}
block = {}
prompt = ">"
local continue_flag

while true
	io.write"#{prompt} "
	ok, line = pcall io.read

	return unless ok and line

	if line_withn = line\match'(.-)%s*\\%s*$'
		prompt = ">>"
		table.insert block, line_withn
		continue_flag = true
		continue
	elseif continue_flag
		table.insert block, line
		prompt = ">"

	continue_flag = false

	if #block > 0
		parseval (table.concat block, '\n'), env

		block = {}
	else
		parseval line, env