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))))

(defn finder
  "Creates a peg that finds all locations of str in the text."
  [str]
  (peg/compile ~(any (choice
                      (sequence (position) ,str)
                      1))))

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

(peg/match where-are-the-dogs? "dog dog cat dog") # => @[0 4 12]

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

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

(peg/match find-cats "cat ct caat caaaaat cat") # => @[0 7 12 20]

(defn replacer-split
  "Creates a peg that replaces instances of patt with subst...sort of"
  [patt subst]
  (peg/compile ~(any
                  (choice (replace (capture ,patt) ,subst)
                          (capture 1)))))

(peg/match (replacer-split "h" "j")
           "hello") # => @["j" "e" "l" "l" "o"]

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

# % is also known as accumulate
(defn replacer
  "Creates a peg that replaces instances of patt with subst."
  [patt subst]
  (peg/compile ~(accumulate
                 (any
                  (choice (replace (capture ,patt) ,subst)
                          (capture 1))))))

(peg/match (replacer "h" "oth")
           "hello") # => @["othello"]

# actually based on leafgarland's work below :)
(def peg-netstring
  ~{:main (replace (sequence :digits 
                             ":"
                             (capture (lenprefix (backref :digits) 1))
                             ",")
                   ,|$1)
    :digits (replace (capture (choice "0"
                                      (sequence (range "19") :d*)))
                     ,scan-number
                     :digits)})

(peg/match peg-netstring "3:djb,") # => @["djb"]

(peg/match peg-netstring "0:,") # => @[""]

# thanks to leafgarland for original
(def peg-bencode
  ~{:main :data
  
    :data (choice :list :table :number :string)
    
    :list (group (sequence "l" (any :data) "e"))
    
    :table {:main (sequence "d" 
                            (replace (any (sequence :key :value)) ,struct) 
                            "e")
            :key (replace :string ,keyword)
            :value :data}
            
    :number (sequence "i" :digits "e")
    
    # you seem awfully familiar...
    :digits (replace (capture (sequence (opt "-") :d+))
                     ,scan-number
                     :digits)

    # are you sure we've never met?
    :string (replace (sequence :digits 
                               ":"
                               (capture (lenprefix (backref :digits) 1)))
                     ,|$1)})

(peg/match peg-bencode
           "li1ei2e5:threed1:ai6e3:beei7eee") # => @[@[1 2 "three" {:bee 7 :a 6}]]

# 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

# https://github.com/janet-lang/spork/blob/master/spork/fmt.janet