(def grammar (peg/compile ~{
  :main (* :tok (any (* :s+ :tok)) -1)
  :tok (+ (<- :word) (number (some (+ (range "09") "."))))
  :word (* :init-char (any :rest-char))
  :init-char (+ (range "AZ") (range "az") (set ":/{}><,.[]+=-_*&^%$#@!;()"))
  :rest-char (+ :init-char (range "09"))
}))

# State @{ :dictionary @{ word { :definition [word] :immediate } } :stack @[] :mode fn }
(defn immediate [state word]
  (cond
    (or (number? word) (array? word) (tuple? word)) (array/push (state :stack) word)
    (let
      (word (or ((state :dictionary) word) (error (string "No such word defined: " word))))
      ((word :definition) state)
)))

(defn deferred [state word] (let
 (definition ((state :dictionary) word)) (if (and definition (definition :immediate))
  (immediate state word)
  (array/push (array/peek (state :stack)) word)
)))

(defmacro fixed-word [args ret] ~{
  :definition (fn [state]
    (do 
      ,;(map (fn [name] ~(def ,name (,array/pop (state :stack)))) (reverse args))
      (array/concat (state :stack) ,ret)
    )
  )
})

(defn run-state [state words]
    (loop [word :in words] (:mode state word))
)

(defn word-as [& words] { :definition (fn [state] (run-state state words)) })

(defn truthy [a] (and a (not (= a 0))))

(def std-dict @{
  "pick" (fixed-word [a b] [a b a])
  "drop" (fixed-word [a] [])
  "swap" (fixed-word [a b] [b a])
  "dup" (fixed-word [a] [a a])
  "-" (fixed-word [a b] (- a b))
  "+" (fixed-word [a b] (+ a b))
  "*" (fixed-word [a b] (* a b))
  "/" (fixed-word [a b] (/ a b))
  "=" (fixed-word [a b] (= a b))
  ">" (fixed-word [a b] (> a b))
  "<" (fixed-word [a b] (< a b))
  "len" (fixed-word [a] (length a))
  "true" (fixed-word [] true)
  "false" (fixed-word [] false)
  "dec" (word-as 1 "-")
  "inc" (word-as 1 "+")
  "negate" (word-as 0 "swap" "-")
  "." (fixed-word [a] (do (print a) []))
  ".s" { :definition (fn [state] (pp (state :stack)))}
  "{" { :definition (fn [state] 
    (array/push (state :stack) @[])
    (set (state :mode) deferred)
  )}
  "}" { :definition (fn [state]
    (def words (array/peek (state :stack)))
    (if (> (count |(= $ "{") words) (count |(= $ "}") words))
      (array/push words "}")
      (do
        (def dictionary (table/clone (state :dictionary)))
        (array/pop (state :stack)) # Remove wordlist that's on stack top
        (array/push (state :stack) (fn [state &opt recur]
          (when recur (set (dictionary "recur") { :definition recur }))
          (def state @{ :dictionary dictionary :stack (state :stack) :mode immediate })
          (run-state state words)
        ))
        (set (state :mode) immediate)
      )
    )
  ) :immediate true }
  "()" { :definition (fn [state] ((array/pop (state :stack)) state)) }
  ":" { :definition (fn [state] 
    (set (state :mode) (fn [state word]
      (def exec (array/pop (state :stack)))
      (set ((state :dictionary) word) { :definition (fn [state] (exec state exec)) })
      (set (state :mode) immediate)
    ))
  )}
  "if" (fixed-word [cond when-true when-false] (do ((if (truthy cond) when-true when-false) state) []))
  "loop" { :definition (fn [state]
    (def body (array/pop (state :stack)))
    (body state)
    (while (truthy (array/pop (state :stack))) (body state))
  )}
  "while" { :definition (fn [state]
    (def body (array/pop (state :stack)))
    (while (truthy (array/pop (state :stack))) (body state))
  )}
  "repeat" (fixed-word [count body] (for x 0 count (body state)))
  "[" { :immediate true :definition (fn [state] 
    (set (state :mode) immediate)
  )}
  "]" { :definition (fn [state]
    (def val (array/pop (state :stack)))
    (array/push (array/peek (state :stack)) val)
    (set (state :mode) deferred)
  )}
})



(defn main [_ arg] (let (
    words (peg/match grammar arg)
    state @{ :dictionary (table/clone std-dict) :stack @[] :mode immediate }
  )
    (run-state state words)
))