janet peg exercises

peg-exercises.janet

# find * and + to be confusing, trying to use sequence and choice instead

(def peg-simple
  ~{:main (capture (some :S))})

(peg/match peg-simple "hello") # @["hello"]

# from:
#   https://janet-lang.org/docs/peg.html
(defn finder
 "Creates a peg that finds all locations of str in the text."
 [str]
 (peg/compile ~(any (+ (* ($) ,str)
                       1))))

(def where-are-the-dogs?
  (finder "dog"))

(peg/match where-are-the-dogs? "dog dog cat dog")

(def find-cats
  (finder '(* "c" (some "a") "t")))

(peg/match find-cats "cat ct caat caaaaat cat")

(defn replacer
 "Creates a peg that replaces instances of patt with subst."
 [patt subst]
 (peg/compile ~(% (any (+ (/ (<- ,patt) ,subst)
                          (<- 1))))))

# thanks to leafgarland for original
(def peg-bencode
  ~{:main :data
    :data (choice :list :table :number :string)
    :list (group (sequence "l" (any :data) "e"))
    :table (sequence "d" (replace (any (sequence :string :data))
                                  ,struct)
                     "e")
    :number (sequence "i" :digits "e")
    :digits (replace (capture :d+)
                     ,scan-number
                     :digits)
    :string (replace (sequence :digits ":"
                               (capture (lenprefix (backref :digits) 1)))
                     ,|$1)})

(peg/match peg-bencode
           "li1ei2e5:threed1:ai6e3:beei7eee")

# from:
#   https://janet-lang.org/docs/peg.html
(def ip-address
 '{:dig (range "09")
   :0-4 (range "04")
   :0-5 (range "05")
   :byte (choice
           (sequence "25" :0-5)
           (sequence "2" :0-4 :dig)
           (sequence "1" :dig :dig)
           (between 1 2 :dig))
   :main (sequence :byte "." :byte "." :byte "." :byte)})

(peg/match ip-address "127.0.0.1")
(peg/match ip-address "127.0.00.1") # shouldn't work(?), but parses
(peg/match ip-address "127.0.000.1") # shouldn't work(?), and doesn't parse

# a refinement
(def ip-address-2
 '{:main (sequence :byte "." :byte "." :byte "." :byte)
   # byte doesn't start with a zero if there is more than one digit
   :byte (choice
           (sequence "25" :0-5)
           (sequence "2" :0-4 :dig)
           (sequence "1" :dig :dig)
           (sequence :pos :dig)
           :dig)
   # pieces to accomodate :byte
   :0-5 (range "05")
   :0-4 (range "04")
   :dig (range "09")
   :pos (range "19")})

(peg/match ip-address-2 "127.0.0.1")
(peg/match ip-address-2 "127.0.00.1") # shouldn't work(?), but parses
(peg/match ip-address-2 "127.0.000.1") # shouldn't work(?), and doesn't parse

# adapted from:
#   https://janet-lang.org/docs/syntax.html
(def grammar
  ~{:main :root

    :root (any :value)

    :value (* (any (+ :ws :readermac))
              :raw-value
              (any :ws))

    :ws (set " \t\r\f\n\0\v")

    :readermac (set "';~,|")

    :raw-value (+ :comment :constant :number :keyword
                  :string :buffer :long-string :long-buffer
                  :parray :barray :ptuple :btuple :struct :dict :symbol)

    :comment (* "#"
                (any (if-not (+ "\n" -1) 1)))

    :constant (+ "true" "false" "nil")

    :number (cmt (<- :token) ,scan-number)

    :token (some :symchars)

    :symchars (+ (range "09" "AZ" "az" "\x80\xFF")
                 (set "!$%&*+-./:<?=>@^_"))

    :keyword (* ":"
                (any :symchars))

    :string :bytes

    :bytes (* "\""
              (any (+ :escape (if-not "\"" 1)))
              "\"")

    :escape (* "\\"
               (+ (set "ntrzfev0\"\\")
                  (* "x" :hex :hex)
                  (error (constant "bad hex escape"))))

    :hex (range "09" "af" "AF")

    :buffer (* "@" :bytes)

    :long-string :long-bytes

    :long-bytes {:delim (some "`")
                 :open (capture :delim :n)
                 :close (cmt (* (not (> -1 "`"))
                                (-> :n)
                                ':delim)
                             ,=)
                 :main (drop (* :open
                                (any (if-not :close 1))
                                :close))}

    :long-buffer (* "@" :long-bytes)

    :parray (* "@" :ptuple)

    :ptuple (* "("
               :root
               (+ ")" (error "")))

    :barray (* "@" :btuple)

    :btuple (* "["
               :root
               (+ "]" (error "")))

    :struct (* "{"
               :root2
               (+ "}" (error "")))

    :root2 (any (* :value :value))

    :dict (* "@" :struct)

    :symbol :token
    })

(peg/match grammar ":a")
(peg/match grammar "(def c 3)") # why does this return @[3] ?
(peg/match grammar "(var x 0)") # why does this return @[0] ?

# ...and now for some hermes-related experiments...
(def peg-defsrc
  ~{:main (sequence "(" :s* "defsrc" :s+
                    (capture (some :S)) :s+
                    (any ,grammar)
                    ")")})

(peg/match peg-defsrc
           "(defsrc my-src 1)")

(peg/match peg-defsrc
           "(defsrc my-src (+ 1 1))")

(peg/match peg-defsrc
           "(defsrc my-src (+ 1 1) :a)")

(peg/match peg-defsrc ``
(defsrc bash-src
  :url "https://ftp.gnu.org/gnu/bash/bash-5.0.tar.gz"
  :hash "sha256:b4a80f2ac66170b2913efbfb9f2594f1f76c7b1afd11f799e22035d63077fb4d")
``)

# https://github.com/andrewchambers/janet-uri/blob/master/uri.janet