parser combinator - hutton

parser.js

let slice = Array.prototype.slice;
let str = s => slice.call(s)
let unstr = cs => cs.reduce((c, cs) => c + cs, "")
let concat = xss => xss.reduce((xs, ys) => xs.concat(ys), [])
let id = x => x
let negate = x => -x
let add = (x,y) => x + y
let sub = (x,y) => x - y

// type Parser a = () -> [Char] -> a

// split_array :: { nil : () -> b, cons : (x:a, xs:[a]) -> b } -> [a] -> b
let split_array = cases => array =>
  array.length ?
  cases.cons(array[0], slice.call(array, 1)) :
  cases.nil()

// result :: a -> Parser a
let result = x => () => inp => [[x, inp]]

// zero :: Parser a
let zero = () => inp => []

// item :: Parser Char
let item  = () => split_array({
    nil:  ()      => [],
    cons: (x, xs) => [[x, xs]]
  })

// bind :: Parser a -> (a -> Parser b) -> Parser b
let bind = p => f => () => inp0 => concat([ for ([v, inp1] of p()(inp0)) f(v)()(inp1)])

// seq :: Parser a -> Parser b -> Parser (a, b)
let seq = p => q => bind(p) (x =>
                    bind(q) (y =>
                            result([x, y])))

// skip :: Parser a -> Parser b -> Parser b
let skip = p => q => bind(p) (_ =>
                     bind(q) (result))

// sat :: (Char -> Bool) -> Parser Char
let sat = p => bind(item)(x => p(x) ? result(x) : zero)

// char :: Char -> Parser Char
let char = c => sat (x => x === c )

// digit :: Char -> Parser Char
let digit = sat (x => x >= '0' && x <= '9')

// lower :: Char -> Parser Char
let lower = sat (x => x >= 'a' && x <= 'z')

// upper :: Char -> Parser Char
let upper = sat (x => x >= 'A' && x <= 'Z')

// plus :: Parser a -> Parser a -> Parser a
let plus = p => q => () => inp => p()(inp).concat(q()(inp))

// letter :: Parser Char
let letter = plus(lower)(upper);

// alphanum :: Parser Char
let alphanum = plus(letter)(digit);

// word :: Parser String
let word = plus(
            bind(letter) (c  => 
            bind(word)   (cs =>
                         result(c + cs) ))
          )(result(''))

// string :: [Char] -> Parser String
let string = split_array({
  nil:  ()      => result(''),
  cons: (x, xs) => bind(char(x))    (c  => 
                   bind(string(xs)) (cs =>
                                    result(c + cs)))
})

// many :: Parser a -> Parser [a]
let many = p => plus(
                  bind(p)       (x  => 
                  bind(many(p)) (xs =>
                                result([x].concat(xs))))
                )(result([]))

// many1 :: Parser a -> Parser [a]
let many1 = p => bind(p)       (x  => 
                 bind(many(p)) (xs =>
                               result([x].concat(xs))))

// sepBy1 :: Parser a -> Parser b -> Parser [a]
let sepBy1 = p => sep => bind(p)                  (x =>
                         bind(many(skip(sep)(p))) (xs => 
                                                  result([x].concat(xs))))

// nat :: Parser Nat
let nat = bind(many1(digit))(x => result(parseInt(unstr(x), 10)))

// op :: Parser (Nat -> Int)
let op = plus(bind(char('-'))(_ => result(negate)))
             (result(id))

// int :: Parser Int
let int = bind(op) (f =>
          bind(nat)(n =>
                    result(f(n))))

// bracket :: Parser a -> Parser b -> Parser c -> Parser b
let bracket = open => p => close => bind(open) (_ =>
                                    bind(p)    (x =>
                                    bind(close)(_ =>
                                                result(x))))

// ints :: Parser [Int]
let ints = bracket (char('['))
                   (sepBy1(int)(char(',')))
                   (char(']') )

// sepBy :: Parser a -> Parser b -> Parser [a]
let sepBy = p => sep => plus (sepBy1(p)(sep))
                             (result([]))

// chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
let chainl1 = p => q => bind(p)               (  x => 
                        bind(many(seq(q)(p))) (fys =>
                                              result( fys.reduce((x, [f, y]) => f(x,y), x) )))

// junk :: Parser [Char]
let junk = many(sat(c => c == ' '))

// parse :: Parser a -> Parser a
let parse = skip(junk)

// parse :: Parser a -> Parser a
let token = p => bind(p)    (x => 
                 bind(junk) (_ => 
                            result(x)))

// addition / substraction
let addop = plus(bind(char('+')) (_ => result(add)))
                (bind(char('-')) (_ => result(sub)))

let expr = () => chainl1(factor)(addop)()

let factor = plus(nat)
                 (bracket (char('('))
                          (expr)
                          (char(')')))


// lambda calculus
let natural = token(nat);
let symbol = s => token(string(s))

let app = (l, t) => { return { type:'app', lam:l, term:t }; }
let lam = expr => { return result({ type: 'lambda', body: expr }); }

let lexpr = () => chainl1 (atom)
                          (result(app)) ()
                      
let atom = () => plus (lambda) (
                 plus (lvar)
                      (paren))()

let lambda = () => bind(symbol('λ')) (_    =>
                   bind(lexpr)       (lam)) ()
                   
let lvar = bind(natural)(x => result({ type: 'var', name: x }))

let paren = () => bracket (symbol('('))
                          (lexpr)
                          (symbol(')')) ()

let test = str('test sentence with words');
let toast = str('1+1-2+1');
let thuna = str('λ(λ(2 (1 1))) λ(2 (1 1))');

console.log(lexpr()(tunna));