apparse.js

var ok  = (value,   offset) => ({good: true, value, offset})
var err = (message, offset) => ({message, offset})

var pure     = (value)      => ({type: "pure", value})
var fail     = (message)    => ({type: "fail", message})
var token    = (token)      => ({type: "token", token})
var any      = (...parsers) => ({type: "any", parsers})
var many     = (parser)     => ({type: "many", parser})
var some     = (parser)     => ({type: "some", parser})
var recuring = (thunk)      => ({type: "recuring", thunk})

var layouted = (parser) => decorated("layouted", "fun", [show(parser)],
  object()
    .then(      token("{"))
    .then(maybe(token(";")))
    .then(sepBy(token(";"), parser)).as("result")
    .then(      token("}"))
    .reduce(it => it.result, "result-of")
)

var decorated = (op, t, args, p) => ({type: "decorated", real: p, op, args, t})

var sepBy  = (sep, parser) => decorated("sepBy", "binary", [show(parser), show(sep)], (maybe(sepBy1(sep, parser), [])))
var sepBy1 = (sep, parser) => (
  object()
    .then(parser).as("first")
    .then(
      many(object()
        .then(sep)
        .then(parser).as("item")
        .reduce(it => it.item, "take-item")
      )
    ).as("rest")
    .reduce(it => [it.first].concat(it.rest), "cons")
)

var maybe = (parser, def) => ({type: "maybe", parser, def})

var that = (message, predicate) => ({
  type: "that",
  predicate,
  message
})
var lookahead = (parser) => ({type: "lookahead", parser})

Array.prototype.last = function () {
  return this[this.length - 1]
};

var object = (type) => object_().then(pure(type)).as("type")

var object_ = (fields) => {
  fields = fields || []
  return (
    { type:   "object"
    , then:   (parser) => object_(fields.concat([{name: null, parser}]))
    , as:     (name)   => {
      fields.last().name = name
      return object_(fields)
    }
    , reduce: (fun, desc) => ({type: "reduce", object: object_(fields), fun, desc})
    , fields:  fields
    }
  )
}

var match = (o, def, ...matchers) => {
  for (var i = 0; i < matchers.length; i += 2) {
    if (o.type === matchers[i + 0])
      return matchers[i + 1](o)
  }
  return def
}

var args = (...argz) => {
  var acc = "(".green + argz[0]
  for (var i = 1; i < argz.length; i++) {
    acc += ", ".green + argz[i]
  }
  return acc + ")".green
}

var ors = (...argz) => {
  var acc = argz[0]
  for (var i = 1; i < argz.length; i++) {
    acc += " || ".green + argz[i]
  }
  return acc
}

var obj = (...argz) => {
  var acc = "[".bold + argz[0]
  for (var i = 1; i < argz.length; i++) {
    acc += "; ".bold + argz[i]
  }
  return acc + "]".bold
}

var colors = require('colors')

var show = (parser) => {
  if (!parser)
    return "NULL!"
  if (typeof(parser) === "string")
    return parser.cyan
  return match(parser, parser.type
    , "pure",      (it) => "<- ".green + it.value
    , "fail",      (it) => ("!!! " + args(it.message)).red
    , "decorated", (it) => it.t == "binary" ? it.args[0] + " " + it.op.green + " " + it.args[1] : it.op.green + args(it.args)
    , "token",     (it) => JSON.stringify(it.token).blue.bold
    , "any",       (it) => ors(...it.parsers.map(show))
    , "many",      (it) => "many ".green + show(it.parser)
    , "some",      (it) => "some ".green + show(it.parser)
    , "recuring",  (it) => "recuring".green + args("?")
    , "that",      (it) => "is ".green + JSON.stringify(it.message)
    , "lookahead", (it) => "try ".green + show(it.parser)
    , "object",    (it) => obj(...it.fields.map(field => show(field.parser) + (field.name? " AS ".bold + field.name : "")))
    , "reduce",    (it) => ((it.desc || "reduce") + " ").yellow + show(it.object)
    , "maybe",     (it) => it.def ? JSON.stringify(it.def) + " or " + show(it.parser)
                                  : show(it.parser) + "?"
  )
}

var colorNames = ["red"
,"green"
,"yellow"
,"blue"
,"magenta"
,"cyan"
,"white"
,"gray"
,"grey"]

var indent = (l) => l == 0? "" : indent(l - 1) + colors[colorNames[l % 7]](".")

var run = (s, syntax, parser, level) => {
  level = level || 0
  console.log(" " + s.at() + "\t" + s.current() + "\t" + indent(level) + show(parser));
  if (!parser)
    throw new Error("!parser")
  if (typeof(parser) === "string")
    if (syntax[parser])
      return run(s, syntax, syntax[parser], level)
    else
      throw Error(show(parser))
  switch (parser.type) {
    case "pure": return ok (parser.value,     0);
    case "fail": return err([parser.message], 0);
    case "decorated":
      return run(s, syntax, parser.real, level + 1)
    case "token":
      if (s.current() == parser.token)
        return ok(s.current(), 1)
      else
        return err(parser.token, 0)
    case "any":
      var acc = []
      for (var i = 0; i < parser.parsers.length; i++) {
        var res = run(s, syntax, parser.parsers[i], level + 1)
        if (!res.good && !res.offset)
          acc.push(res.message)
        else
          return res
      }
      return err(acc, 0)
    case "maybe":
      var res = run(s, syntax, parser.parser, level + 1)
      if (res.good)
        return res
      else if (!res.offset)
        return ok(parser.def, 0)
      else
        return res
    case "many":
      var acc = []
      var offset = 0
      while (true) {
        var res = run(s, syntax, parser.parser, level + 1)
        if (res.good && !res.offset)
          throw new Error({
            reason: "argument of many succeed, but didn't consume",
            parser: show(parser.parser),
            stream: s.move(offset),
          })
        else if (!res.good && !res.offset)
          return ok(acc, offset)
        else if (res.good) {
          acc.push(res.value)
          offset += res.offset
          s = s.move(res.offset)
        }
        else
          return res
      }
      return ok(acc, offset)
    case "some":
      var p = parser.parser
      return run(s, syntax,
        object()
          .then(p).as("x")
          .then(many(p)).as("xs")
          .reduce(it => [it.x].concat(it.xs), "cons"),
        level
      )
    case "recuring":
      var p = parser.thunk()
      return run(s, syntax, p, level)
    case "that":
      if (parser.predicate(s.current()))
        return ok(s.current(), 1)
      else
        return err(parser.message, 0)
    case "lookahead":
      var res = run(s, syntax, parser.parser, level + 1)
      if (res.good)
        return res
      else
        return err(res.message, 0)
    case "object":
      var acc = {}
      var offset = 0
      for (var i = 0; i < parser.fields.length; i++) {
        var res = run(s, syntax, parser.fields[i].parser, level + 1)
        if (!res.good) {
          return err(res.message, offset + res.offset)
        }
        if (parser.fields[i].name)
          acc[parser.fields[i].name] = res.value
        offset += res.offset
        s = s.move(res.offset)
      }
      return ok(acc, offset)
    case "reduce":
      var res = run(s, syntax, parser.object, level)
      if (!res.good)
        return res
      return ok(parser.fun(res.value), res.offset)
  }
}

var reservedNames = ["let", "in", ";", "=", "\\", "->", '', '<EOS>',
"{", "}", "where", "(", ")", "match", "with", "module"
, "exports", "imports", "implementation"]

var isReservedName  = (tok) => reservedNames.find(x => x == tok) == tok
var isStringLiteral = (tok) => tok.startsWith('"') || tok.startsWith("'")
var isNumberLiteral = (tok) => "0123456789".includes(tok[0])

var isName = (tok) => (!
  (  isReservedName(tok)
  || isStringLiteral(tok)
  || isNumberLiteral(tok)
  )
)

var reserved = (tok) => {
  if (!isReservedName(tok))
    throw new Error(tok + " is not a reserved name!")
  return token(tok)
}

var layout = (resWord, things) =>
  object()
    .then(reserved(resWord))
    .then(layouted(things)).as("things")
    .reduce(it => it.things)

var syntax = (
  { name:       that("name",   isName)
  , string:     that("string", isStringLiteral)
  , number:     that("number", isNumberLiteral)
  , terminal:   any ( "string"
                    , "number"
                    , "name"
                    , "parented"
                    , "letExpr"
                    , "lambda"
                    , "match"
                    )

  , parented:   object("parens enclosed expression")
                  .then(reserved("("))
                  .then("expr")               .as("expr")
                  .then(reserved(")"))
                  .reduce(it => it.expr, "expr of")

  , expr:       object("expr")
                  .then(some("terminal"))     .as("chain")

  , letExpr:    object("let-expr")
                  .then(layout("let", "binding")).as("bindings")
                  .then(reserved("in"))
                  .then("expr")                  .as("context")

  , whereBlock: object("where-block")
                  .then(layout("where", "binding")).as("bindings")
                  .reduce(it => it.bindings, "bindings")

  , binding:    object("binding")
                  .then("name")               .as("name")
                  .then(many("name"))         .as("args")
                  .then(reserved("="))
                  .then("expr")               .as("body")
                  .then(many("whereBlock"))   .as("bindings")

  , lambda:     object("anonymous function")
                  .then(reserved("\\"))
                  .then("projection")         .as("projection")
                  .reduce(it => it.projection, "lambda")
  
  , projection: object("projection")
                  .then(many("name"))         .as("args")
                  .then(reserved("->"))
                  .then("expr")               .as("body")

  , match:      object("match-block")
                  .then(reserved("match"))
                  .then("expr")                    .as("matched")
                  .then(layout("with", "matchers")).as("matchers")

  , matchers:   object("match-alt")
                  .then("name")               .as("ctor")
                  .then("projection")         .as("resolver")

  , module:     object("module")
                  .then(reserved("module"))
                  .then("name")                              .as("name")
                  .then(layout("exports", "name"))           .as("exports")
                  .then(layout("imports", "name"))           .as("imports")
                  .then(layout("implementation","binding"))  .as("bindings")
  }
)

var util = require("util")

var {tokenize, stdConf} = require('./tokenizer.js')

var tokens = tokenize(require('fs').readFileSync("test.lc").toString(), stdConf)

var fromStringArray = (array, at) => {
  var at = at || 0
  return (
    { at: () => array[at].line + ":" + array[at].col
    , current: () => array[at].text
    , move: (offset) => fromStringArray(array, at + offset)
    }
  )
}

console.log(tokens);
var tokens = fromStringArray(tokens)

console.log(require('util').inspect(run(tokens, syntax, "module"), { depth: null }));

module-runtime.js

var assert = require('assert')
var { inspect } = require('util')

var match = (o, ...matchers) => {
  for (var i = 0; i < matchers.length; i += 2) {
    if (o.ctor === matchers[i + 0])
      return matchers[i + 1](o)
  }
  return assert.fail('ctor `' + o.ctor + '` for type `' + o.type + '` is unhandled')
}

var keysOf = (o) => {
  var keys = []
  for (var name in o)
    keys.push(name)
  return keys
}

var make = (type, schema, ctor) => (args) => {
  ctor = ctor || type
  args = args || {}
  for (var name in args) {
    assert(schema.hasOwnProperty(name),
      ctor + " : {" +
      keysOf(schema) + "} -> " +
      type + " - has no argument `" +
      name + "`")
  }
  for (var name in schema) {
    assert(schema[name] || args[name],
      ctor + " : {" +
      keysOf(schema) + "} -> " +
      type + " - no argument `" +
      name + "` provided")
  }
  return set({type, ctor: ctor}, set(schema, args), {toString: function () {
    return inspect(this)
  }})
}

var set = (o, ...d) => Object.assign({}, o, ...d)
var apply = (o, diff) => {
  var r = set(o)
  for (key in diff) {
    r[key] = diff[key](r[key])
  }
  return r
}

var trace = (label, traced, o) => {
  console.log(label, traced);
  return o
}

var add = (x) => (xs) => set(xs, {[x.name]: x})

var Object_map = (o, f) => {
  var r = {}
  for (var key in o) {
    r = set(r, f(key, o[key]))
  }
  return r
}
//==============================================================================

var Module = make("module", {values: [], types: []})

var FunDecl = make("decl", {name: undefined, type: undefined}, "FunDecl")
var TypeDecl = make("decl", {name: undefined, kind: undefined}, "TypeDecl")

var declare = (mod, decl) => match(decl
  , "FunDecl",  it => apply(mod, {values: add(it)})
  , "TypeDecl", it => apply(mod, {types:  add(it)})
)

var declareAll = (mod, ...list) => {
  for (var i = 0; i < list.length; i++)
    mod = declare(mod, list[i])
  return mod
}

var Interface = make("interface", {values: [], types: []})

var typecast = (mod, face) => {
  var result = Module({})
  result = face.values.map(name => mod.values[name]).reduce(declare, result)
  result = face.types .map(name => mod.types [name]).reduce(declare, result)
  return result
}

var withT = Interface({types: ['t']})

var importModule = (base, imported, name) => {
  var rename = (decls) => !name? decls :
    Object_map(decls, (key, value) => ({
      [name + "." + key]: set(value, {name : name + "." + key})
    }))

  return apply(base, {
    values: (old) => set(old, rename(imported.values)),
    types:  (old) => set(old, rename(imported.types)),
  })
}

console.log(typecast(importModule(
  declareAll(Module({})
    , TypeDecl({name: "t", kind: "* -> *"})
  ),
  declareAll(Module({})
    , TypeDecl({name: "d", kind: "*"})
  ),
  "snd"
), withT).toString());

package.json

{
  "name": "dumb",
  "version": "1.0.0",
  "description": "",
  "main": "apparse.js",
  "dependencies": {
    "colors": "^1.1.2"
  },
  "devDependencies": {},
  "scripts": {
    "test": "echo \"Error: no test specified\" && exit 1"
  },
  "repository": {
    "type": "git",
    "url": "git+https://gist.github.com/91cb2ed7ae3a52d7d685e468324014d9.git"
  },
  "author": "",
  "license": "ISC",
  "bugs": {
    "url": "https://gist.github.com/91cb2ed7ae3a52d7d685e468324014d9"
  },
  "homepage": "https://gist.github.com/91cb2ed7ae3a52d7d685e468324014d9"
}

parser.js

var {tokenize, tokens, stdConf} = require('./tokenizer.js');

var run = (parser, text) => parser(tokenize(text, stdConf))

var ok  = (x, s) => ({stream: s, good: true, value: x})
var err = (x, s) => ({stream: s, message: x})

var pure = (x) => (s) => ok(x, s)
var fail = (x) => (s) => err(x, s)

var apply = (fn, ...parsers) => (s) => {
    var accum = []
    for (var i = 0; i < parsers.length; i++) {
        var res = parsers[i](s)
        if (res.good) {
            s = res.stream
            accum.push(res.value);
        } else {
            return res
        }
    }
    return ok(fn.apply(null, accum), s)
}

var getPosition = s => ok(s, s)

var produce = (...args) => {
    var significant = (f) => (...args) => {
        var argz = []
        for (var i = 0; i < args.length; i++)
            if (args[i])
                argz.push(args[i])
        return f.apply(null, argz)
    }
    var argz = [significant(args[args.length - 1])]
    for (var i = 0; i < args.length - 1; i++)
        argz.push(args[i])
    return apply.apply(null, argz)
}

var any = (msg, ...parsers) => (s) => {
    for (var i = 0; i < parsers.length; i++) {
        var res = parsers[i](s)
        if (res.good || s.char > res.stream.char)
            return res
    }
    return err(msg, s)
}

var lookahead = (parser) => (s) => {
    var res = parser(s)
    if (!res.good)
        res.stream = s
    return res
}

var many = (p) => (s) => {
    var acc = []
    for (;;) {
        var res = p(s)
        if (res.good && res.stream.char == s.char)
            throw new Error({
                message: "many(p): p succeed, nothing consumed",
            })

        if (!res.good)
            return ok(acc, s)

        acc.push(res.value)
        s = res.stream
    }
}

var some = (p) => apply((x, xs) => {xs.unshift(x); return xs}, p, many(p))

var satisfies = (msg, p) => (s) => {
    if (s && p(s.text)) {
        return ok(s.text, s.next)
    }
    return err(msg, s)
}

var silently = (p) => produce(p, x => null)

var onDemand = (lp) => {
    var p = null
    return (s) => {
        p = p || lp()
        return p(s)
    }
}

var fs = require("fs")

var parseFile = (p, file) => {
    var text = fs.readFileSync(file).toString()
    return run(p, text)
}

module.exports = (
    { run
    , parseFile
    , silently
    , onDemand
    , pure
    , fail
    , apply
    , produce
    , many
    , some
    , any
    , lookahead
    , satisfies
    , getPosition
    }
)

syntax.js

"use strict";

var { run
    , parseFile
    , silently
    , onDemand
    , pure
    , fail
    , apply
    , produce
    , many
    , some
    , any
    , lookahead
    , satisfies
    , getPosition
    } = require('./parser.js')

var tell = (at, x) => {
    // console.log({at, produced: x});
    return x
}

var reservedNames = ["let", "in", ";", "=", "\\", "->", '', '<EOS>', "{", "}", "where"]

var isReservedName  = (tok) => reservedNames.find(x => x == tok) == tok
var isStringLiteral = (tok) => tok.startsWith('"') || tok.startsWith("'")
var isNumberLiteral = (tok) => "0123456789".includes(tok[0])

var isName = (tok) => (!
  (  isReservedName(tok)
  || isStringLiteral(tok)
  || isNumberLiteral(tok)
  )
)

var layouted = (p) => (
    produce
      ( token("{")
      , optional(token(";"))
      , sepBy(token(";"), p)
      , token("}")
      , xs => xs
      )
)

var sepBy = (sep, p) => (
    produce
      ( p
      , many(produce(sep, p, x => x))
      , (x, xs) => [x].concat(xs)
      )
)

var optional = (p) => (
    any ( "optional"
        , p
        , pure({})
        )
)

var name = satisfies("name", isName)

var orElse = (p, def) => any("", p, pure(def))

var token = (tok) => silently(satisfies("== " + tok, (curr) => curr == tok))

var string = satisfies("string literal", isStringLiteral)
var number = satisfies("number literal", isNumberLiteral)

var expr = onDemand(() => (produce
    ( some(terminal)
    , orElse(whereBlock, [])
    , (values, bindings) => tell("app", {type: "app", values, bindings})
    )
))

var commented = (p) => any("comment or doc"
    , produce
        ( token("comment")
        , string
        , p
        , (comment, value) => Object.assign({}, value, {comment})
        )
    , produce
        ( token("doc")
        , string
        , p
        , (comment, value) => Object.assign({}, value, {doc})
        )
    , p
)

var binding = commented(produce
    ( name
    , many(name)
    , token('=')
    , expr
    , (name, args, body) => tell("binding", {type: "binding", name, args, body})
    )
)

var whereBlock = (produce
  ( token("where")
  , layouted(binding)
  )
)

var letExpr = (produce
    ( token("let")
    , layouted(binding)
    , token("in")
    , expr
    , (bindings, expr) => tell("letExpr", {type: "let", bindings, expr})
    )
)

var lambda = (produce
    ( token("\\")
    , some(name)
    , token("->")
    , expr
    , (args, body) => tell("lambda", {type: "lambda", args, body})
))

var terminal = commented(any("terminal"
    , string
    , number
    , produce(token("("), expr, token(")"), (e) => tell("braced terminal", e))
    , letExpr
    , lambda
    , name
))

var prettifyParseResult = (res) => {
    if (res.value)
        return res.value
    return "Expected "
         + res.message
         + ", but found "
         + res.stream.text
         + " at "
         + JSON.stringify({col: res.stream.col, line: res.stream.line})
}

try {
    console.log(JSON.stringify(prettifyParseResult(parseFile(expr, "test.lc"))))
} catch (e) {
    console.log(e.stack);
} finally {

}

test.lc

module List

exports
  fold-list
  map-list

imports
  none

implementation

  fold-list add zero list = match list with
      Cons x xs ->
          fold-list add (add zero x) xs
      Nil ->
          zero
    where
      f = \g -> h

  map-list f list = match list with
      Cons x xs -> Cons (f x) (map-list f xs)
      Nil       -> Nil

tokenizer.js

"use strict";

module.exports.tokenize = (text, conf) =>
    conf ? applyLayout(module.exports.tokens(text), conf)
         : module.exports.tokens(text)

module.exports.tokens = (stream) => {
    var accum = []
    var pos = {line: 1, col: 1, char: 0}
    var isSingle = (c) =>
        (  c == "="
        || c == "("
        || c == ")"
        || c == "{"
        || c == "}"
        || c == ";"
        || c == "\\"
        )
    var isSpace  = (c) => c == " " || c == "\n"

    var end =           () => pos.char >= stream.length
    var spaceHere =     () => isSpace(stream[pos.char])
    var singleHere =    () => isSingle(stream[pos.char])
    var seekWordStart = () => !end(pos) && spaceHere(pos)
    var count =         () => { countChar(pos, stream[pos.char]) }
    var seekWordEnd =   () => !end(pos) && !spaceHere(pos) && !singleHere(pos)
    var token = (begin, end) => stream.slice(begin.char, end.char)

    var fromTo = (open, close) => {
        if (stream.slice(pos.char, pos.char + open.length) == open) {
            var begin = copy(pos)

            for (var i = 0; i < open.length; i++)
                count()

            while (!end()
                && stream.slice(pos.char, pos.char + close.length) != close
            ) {
                count()
            }

            for (var i = 0; i < close.length; i++)
                count()

            var finish = copy(pos)

            var text = token(begin, finish)
            accum.push(copy(begin, {text}))
            return true
        }
    }

    while (!end()) {
        while (seekWordStart())
            count();

        var begin = copy(pos);

        if (fromTo('"""', '"""')) continue;
        if (fromTo('"', '"')) continue;
        if (fromTo("'", "'")) continue;

        if (singleHere())
            count()
        else do {
            count()
        } while (seekWordEnd())

        var finish = copy(pos)
        var text = token(begin, finish)
        if (text)
          accum.push(copy(begin, {text}))
    }

    accum.push(copy(pos, {text: "<EOS>", col: -1}))

    return accum
}

Array.prototype.flatMap = function (f) {
    var acc = []
    this.map(x => acc.push(f(x)))
    return acc
}

Array.prototype.last = function () {
    return this[this.length - 1]
}

var set = (o, things) => Object.assign({}, o, things)
var backOneChar = (tok) => set(tok, {col: tok.col - 1, char: tok.char - 1})

var applyLayout = (tokenArray, conf) => {
    var acc = []
    var starters = []
    var nextStarts = false
    tokenArray.forEach(token => {
        if (token.text == conf.closeBracet) {
            starters.pop()
        }

        while (starters.last() && token.col < starters.last().col && token.text != conf.closeBracet) {
            acc.push(backOneChar(set(token, {text: conf.closeBracet})))
            starters.pop()
        }

        if (starters.last() && token.col == starters.last().col && token.text != conf.semicolon)
            acc.push(backOneChar(set(token, {text: conf.semicolon})))

        if (nextStarts && token.text != conf.openBracet) {
            starters.push({col: token.col})
            acc.push(backOneChar(set(token, {text: conf.openBracet})))
            nextStarts = false
        }

        acc.push(token)

        if (conf.isStarter(token))
            nextStarts = true;

        if (token.text == conf.openBracet) {
            nextStarts = false
        }
    })
    console.log(restoreText(acc));
    return acc
}

var asList = (accum) => accum.reduceRight((list, elem) => {
    elem.next = list;
    return elem
})

var copy = (...obj) => Object.assign({}, ...obj)

var before = (a, b) => a.line < b.line || a.col < b.col
var stepFor = (t, d) => {
    while (t.line < d.line) {
      t.text += "\n"
      countChar(t, "\n")
    }
    while (t.col < d.col) {
      t.text += " "
      countChar(t, " ")
    }
}

var countChar = (pos, char) => {
  if (char == "\n") {
    pos.line = pos.line + 1
    pos.col  =  1
  } else {
    pos.col += 1
  }
  pos.char += 1
}

var restoreText = (tokens) => {
    var text = {line: 1, col: 1, char: 0, text: ""}
    
    tokens.forEach(token => {
      while (before(text, token)) {
        stepFor(text, token)
      }
      text.text += token.text
      for (var i = 0; i < token.text.length; i++)
        countChar(text, token.text[i])
    })
    return text;
}

module.exports.stdConf = {
    semicolon: ";",
    openBracet: "{",
    closeBracet: "}",
    isStarter: x => x.text == "let"
                 || x.text == "with"
                 || x.text == "where"
                 || x.text == "imports"
                 || x.text == "exports"
                 || x.text == "implementation"
}