sexp.hs

data Iter = Iter
    { pos, col, line :: Int
    }

data SExp = Block [SExp] | Atom String
    deriving Show

parseSexp text =
    let
        loopOverText (i, stack) =
            let continue stack = loopOverText (next i, stack)
            in
                if ended i
                then stack
                else
                    case here i of
                        '(' ->
                            continue (Block [] : stack)

                        ')' -> case stack of
                            Block top : Block prev : rest ->
                                continue (Block (prev ++ [Block top]) : rest)

                        ' ' ->
                            continue (stack)

                        other ->
                            let
                                scanWord (i, atom) =
                                    let newAtom = atom ++ [here i]
                                    in  if ahead i `elem` "() "
                                        then
                                            (i, newAtom)
                                        else
                                            scanWord (next i, newAtom)

                                (j, atom) = scanWord(i, "")

                                newStack = case stack of
                                    Block top : rest ->
                                        Block (top ++ [Atom atom]) : rest
                                in
                                    loopOverText (next j, newStack)

        here  i = text !!  pos i
        ahead i = text !! (pos i + 1)
        ended i = length text <= pos i

        next i = i
            { pos  = pos i + 1
            , col  = if here i == '\n' then 1          else col i + 1
            , line = if here i == '\n' then line i + 1 else line i
            }

        place    i = drop (pos i) text
        location i = "line " ++ show (line i) ++ ", column " ++ show (col i)

    in loopOverText (Iter 0 1 1, [Block []]) !! 0

sexp.js

let log = (x) => console.log(require('util').inspect(x, {depth: null}))

let parseSexp = (text) => {
    var i = {
        pos:         0,
        line:        1,
        col:         1,
        here:  () => text[i.pos],
        ahead: () => text[i.pos + 1],
        ended: () => i.pos >= text.length,
        next:  () => {
            i.pos++
            i.line = i.here() == '\n'? i.line + 1 : i.line
            i.col  = i.here() == '\n'?          1 : i.col + 1
        },
        place: () => "line " + i.line + ", column " + i.col,
        location: () => text.slice(i.pos)
    }
    
    let stack = [[]]
    
    for (; !i.ended(); i.next()) {
        // log({location: i.location()})
        if (i.here() == '(') {
            stack.push([])
        } else
        if (i.here() == ')') {
            if (stack.length < 2) {
                throw new Error("mismatched bracked at " + i.place())
            }
            top  = stack.pop()
            prev = stack.pop()
            prev.push(top)
            stack.push(prev)
        } else
        if (i.here() != ' ') {
            let atom = ""
            for (; !"() ".includes(i.ahead()); i.next()) {
                // log({scan: i.location()})
                atom += i.here()
            }
            atom += i.here()
            top = stack.pop()
            top.push(atom)
            stack.push(top)
            // log({scanN: i.location()})
        }
    }
    
    return stack[0][0]
}

let match = (obj, pairs, def) => {
    if (!Array.isArray(obj)) {
        return def(obj)
    }
    let head = obj[0]
    let handler = pairs.filter(p => p[0] === head)[0][1]
    return handler ? handler(obj.slice(1)) : def(obj)
}

let sexp = parseSexp("(define (main args) (call println 'hello_world'))")

log(sexp)

log(match(sexp,
    [ [ "call",   ([f, ...xs])              => ({f, xs}) ]
    , [ "define", ([[name, ...args], body]) => ({name, args, body}) ]
    ],
    (x) => ({atom: x})))

sexp.kek

--- Parses S-expression:
---    > parse-sexp("(define ((add x) y) (+ x y))")
---    [ 'define', [ [ 'add', 'x' ], 'y' ], [ '+', 'x', 'y' ] ]
---
--- Does so using a stack of layers.
--- when it finds '(', it does       [...stack] ->           [[], ...stack]
--- when ...      ')',         [x, y, ...stack] ->    [[x, ...y], ...stack]
--- when ...      ' ',               [...stack] ->               [...stack]
--- when ...      word end,       [x, ...stack] -> [[word, ...x], ...stack]
---
parse-sexp(text) = {
    --- main loop, detects parens
    ---
    loop-over-text(i, stack)
        when i.ended = stack.head.head

    loop-over-text(i, stack) =
        continue(stack) = loopOverText(i.next, stack)
        switch (i.here)
        | '(' ->
            continue([[], ...stack])
        | ')' ->
            --- pushing top  layer inside previous
            ---
            switch (stack)
            | [top, prev, ...rest] ->
                continue([[...prev, top], ...rest])
            | else ->
                throw Error("mismatched bracket at", i.location)

        | ' ' ->
            continue(stack)

        | else ->
            --- auxillary loop, copies word
            ---
            scan-word(i, atom) =
                new-atom = atom + i.here
                if "() ".includes(i.ahead)
                then
                    (i, new-atom)
                else
                    scan-word(i.next, new-atom)

            (i, atom) = scan-word(i, "")

            new-stack =
                switch (stack)
                | [top, ...rest] ->
                    [[...top, atom], ...rest]

            loop-over-text(i, new-stack)

    ; iter(pos, col, line) = object {
        , pos, col, line
        , here  = text[pos]
        , ahead = text[1 + pos]
        , ended = pos >= text.length
        , next  =
            iter(
                pos + 1,
                if here = '\n' then        1 else col + 1,
                if here = '\n' then line + 1 else line,
            )

        , place = "line " + line + ", column " + col
        , location = text.slice(pos)
    }

    ; loop-over-text(iter(0, 1, 1), [[]])
}

sexp.lang

parse-sexp(text) =
    loop-over-text(i, stack) =
        continue(stack) = loopOverText(i.next, stack)
        if i.ended
        then
            stack[0][0]
        else
            case i.here of
                '(' ->
                    continue([] :> stack)
                ')' ->
                    case stack of
                        top :> prev :> rest ->
                            continue((top :> prev) :> rest)
                        else ->
                            throw Error("mismatched bracket at", i.location)
                ' ' ->
                    continue(stack)

                else ->
                    scan-word(i, atom) =
                        new-atom = atom + i.here
                        if "() ".includes(i.ahead)
                        then
                            (i, new-atom)
                        else
                            scan-word(i.next, new-atom)

                    (i, atom) = scan-word(i, "")

                    new-stack = case stack of
                        top :> rest -> (atom :> top) :> rest

                    loop-over-text(i, new-stack)

    iter(pos, col, line) = object {
        pos, col, line,
        here  = text[pos]
        ahead = text[1 + pos]
        ended = pos >= text.length
        next  =
            iter(
                pos + 1,
                if here = '\n' then        1 else col + 1,
                if here = '\n' then line + 1 else line,
            )

        place = "line " + line + ", column " + col
        location = text.slice(pos)
    }

    loop-over-text(iter(0, 1, 1), [[]]

sexp.sexp

(define (parse-sexp text)
    (let
        (loop-over-text i stack)
            (if (.ended i)
                (. 0 0 stack)
                (case (.here i)
                    '(' (loop-over-text (.next i) (Push Empty stack))
                    ')' (case stack
                            (Push top (Push prev rest))
                                (Push (Push top prev) rest)
                            else
                                (throw (Error "mismatched bracket at" (.location i)))
                        )
                    ' ' (loop-over-text (.next i) stack)
                    else
                        (let
                            (scan-word i atom)
                                (let
                                    new-atom
                                        (+ atom (.here i))
                                    (if (.includes (.ahead i) "() ")
                                        (Pair i new-atom)
                                        (scan-word (.next i) new-atom)))
                            (Pair i atom)
                                (scan-word i "")

                            (loop-over-text i
                                (case stack
                                    (Push top rest)
                                        (Push (Push atom top) rest))))
                )
            )
        (iter pos col line)
            (object
                pos   pos
                col   col
                line  line
                here  (. pos text)
                ahead (. (+1 pos) text)
                ended (>= pos (.length text))
                next  (iter
                    (+1 pos)
                    (if (= '\n' here)
                        1
                        (+1 col))
                    (if (= '\n' here iter)
                        (+1 line)
                        line)
                )
            )
        (loop-over-text (iter 0 1 1) (Push Empty Empty))
    )
)