#lang racket/base

(require megaparsack
         megaparsack/text
         data/monad
         data/applicative
         syntax/strip-context
         racket/port
         syntax/parse/define
         (for-syntax racket/base))

(provide read-syntax
         (rename-out [bf-module-begin #%module-begin]))

(define op/p
  (syntax/p
   (do [op <- (char-in/p "+-<>.,")]
       (pure `(bf-op ,(string op))))))

(define loop/p
  (syntax/p
   (do (char/p #\[)
       [instrs <- instrs/p]
       (char/p #\])
       (pure `(bf-loop ,@instrs)))))

(define ignore/p
  (hidden/p
   (many/p
    (char-not-in/p "+-<>.,[]"))))

(define instr/p
  (syntax/p
   (do ignore/p
       [instr <- (or/p op/p loop/p)]
       ignore/p
       (pure instr))))

(define instrs/p
   (syntax/p (many/p instr/p)))

(define program/p
  (syntax/p
   (do [instrs <- instrs/p]
       (pure `(bf-program ,@instrs)))))

(define (read-syntax path port)
  (define parse-tree
    (parse-result!
     (parse-string program/p (port->string port) path)))
  (define module-datum `(module bf-module "bf.rkt"
                          ,parse-tree))
  (strip-context module-datum))

(define-syntax-parse-rule (bf-module-begin parse-tree)
  (#%module-begin
   'parse-tree))

standard-module-name-resolver: collection not found
  for module path: megaparsack
  collection: "megaparsack"
  in collection directories:
   /home/pasterack/.local/share/racket/8.8/collects
   /home/pasterack/racket88/collects/
   ... [179 additional linked and package directories]
  context...:
   /home/pasterack/racket88/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:648:16
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:646:2: filter-by-mode
   /home/pasterack/racket88/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:287:21: try-next
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:401:21: try-next
   /home/pasterack/racket88/collects/racket/private/reqprov.rkt:258:2
   /home/pasterack/racket88/collects/syntax/wrap-modbeg.rkt:46:4
   /home/pasterack/racket88/share/pkgs/scribble-lib/scribble/run.rkt:175:26: go
   .../private/map.rkt:40:19: loop
   .../racket/cmdline.rkt:191:51
   body of "/home/pasterack/racket88/share/pkgs/scribble-lib/scribble/run.rkt"