Last active
November 11, 2022 00:27
-
-
Save sogaiu/59fecacaf16190d8298a5fd158e6353a to your computer and use it in GitHub Desktop.
janet peg exercises
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment