aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/parser
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/parser.lux323
-rw-r--r--stdlib/source/lux/control/parser/analysis.lux134
-rw-r--r--stdlib/source/lux/control/parser/binary.lux274
-rw-r--r--stdlib/source/lux/control/parser/cli.lux98
-rw-r--r--stdlib/source/lux/control/parser/code.lux198
-rw-r--r--stdlib/source/lux/control/parser/environment.lux43
-rw-r--r--stdlib/source/lux/control/parser/json.lux206
-rw-r--r--stdlib/source/lux/control/parser/synthesis.lux163
-rw-r--r--stdlib/source/lux/control/parser/text.lux376
-rw-r--r--stdlib/source/lux/control/parser/tree.lux59
-rw-r--r--stdlib/source/lux/control/parser/type.lux348
-rw-r--r--stdlib/source/lux/control/parser/xml.lux141
12 files changed, 0 insertions, 2363 deletions
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux
deleted file mode 100644
index fb8e856ae..000000000
--- a/stdlib/source/lux/control/parser.lux
+++ /dev/null
@@ -1,323 +0,0 @@
-(.module:
- [lux (#- or and not)
- [abstract
- [functor (#+ Functor)]
- [apply (#+ Apply)]
- [monad (#+ Monad do)]
- [codec (#+ Codec)]]
- [control
- ["." try (#+ Try)]]
- [data
- ["." product]
- [collection
- ["." list ("#\." functor monoid)]]]
- [math
- [number
- ["n" nat]]]])
-
-(type: #export (Parser s a)
- {#.doc "A generic parser."}
- (-> s (Try [s a])))
-
-(implementation: #export functor
- (All [s] (Functor (Parser s)))
-
- (def: (map f ma)
- (function (_ input)
- (case (ma input)
- (#try.Failure msg)
- (#try.Failure msg)
-
- (#try.Success [input' a])
- (#try.Success [input' (f a)])))))
-
-(implementation: #export apply
- (All [s] (Apply (Parser s)))
-
- (def: &functor ..functor)
-
- (def: (apply ff fa)
- (function (_ input)
- (case (ff input)
- (#try.Success [input' f])
- (case (fa input')
- (#try.Success [input'' a])
- (#try.Success [input'' (f a)])
-
- (#try.Failure msg)
- (#try.Failure msg))
-
- (#try.Failure msg)
- (#try.Failure msg)))))
-
-(implementation: #export monad
- (All [s] (Monad (Parser s)))
-
- (def: &functor ..functor)
-
- (def: (wrap x)
- (function (_ input)
- (#try.Success [input x])))
-
- (def: (join mma)
- (function (_ input)
- (case (mma input)
- (#try.Failure msg)
- (#try.Failure msg)
-
- (#try.Success [input' ma])
- (ma input')))))
-
-(def: #export (assert message test)
- {#.doc "Fails with the given message if the test is #0."}
- (All [s] (-> Text Bit (Parser s Any)))
- (function (_ input)
- (if test
- (#try.Success [input []])
- (#try.Failure message))))
-
-(def: #export (maybe parser)
- {#.doc "Optionality combinator."}
- (All [s a]
- (-> (Parser s a) (Parser s (Maybe a))))
- (function (_ input)
- (case (parser input)
- (#try.Failure _)
- (#try.Success [input #.None])
-
- (#try.Success [input' x])
- (#try.Success [input' (#.Some x)]))))
-
-(def: #export (run parser input)
- (All [s a]
- (-> (Parser s a) s (Try [s a])))
- (parser input))
-
-(def: #export (and first second)
- {#.doc "Sequencing combinator."}
- (All [s a b]
- (-> (Parser s a) (Parser s b) (Parser s [a b])))
- (do {! ..monad}
- [head first]
- (\ ! map (|>> [head]) second)))
-
-(def: #export (or left right)
- {#.doc "Heterogeneous alternative combinator."}
- (All [s a b]
- (-> (Parser s a) (Parser s b) (Parser s (| a b))))
- (function (_ tokens)
- (case (left tokens)
- (#try.Success [tokens' output])
- (#try.Success [tokens' (0 #0 output)])
-
- (#try.Failure _)
- (case (right tokens)
- (#try.Success [tokens' output])
- (#try.Success [tokens' (0 #1 output)])
-
- (#try.Failure error)
- (#try.Failure error)))))
-
-(def: #export (either this that)
- {#.doc "Homogeneous alternative combinator."}
- (All [s a]
- (-> (Parser s a) (Parser s a) (Parser s a)))
- (function (_ tokens)
- (case (this tokens)
- (#try.Failure _)
- (that tokens)
-
- output
- output)))
-
-(def: #export (some parser)
- {#.doc "0-or-more combinator."}
- (All [s a]
- (-> (Parser s a) (Parser s (List a))))
- (function (_ input)
- (case (parser input)
- (#try.Failure _)
- (#try.Success [input (list)])
-
- (#try.Success [input' head])
- (..run (\ ..monad map (|>> (list& head))
- (some parser))
- input'))))
-
-(def: #export (many parser)
- {#.doc "1-or-more combinator."}
- (All [s a]
- (-> (Parser s a) (Parser s (List a))))
- (|> (..some parser)
- (..and parser)
- (\ ..monad map (|>> #.Cons))))
-
-(def: #export (exactly amount parser)
- {#.doc "Parse exactly N times."}
- (All [s a] (-> Nat (Parser s a) (Parser s (List a))))
- (case amount
- 0 (\ ..monad wrap (list))
- _ (do {! ..monad}
- [x parser]
- (|> parser
- (exactly (dec amount))
- (\ ! map (|>> (#.Cons x)))))))
-
-(def: #export (at_least amount parser)
- {#.doc "Parse at least N times."}
- (All [s a] (-> Nat (Parser s a) (Parser s (List a))))
- (do {! ..monad}
- [minimum (..exactly amount parser)]
- (\ ! map (list\compose minimum) (..some parser))))
-
-(def: #export (at_most amount parser)
- {#.doc "Parse at most N times."}
- (All [s a] (-> Nat (Parser s a) (Parser s (List a))))
- (case amount
- 0 (\ ..monad wrap (list))
- _ (function (_ input)
- (case (parser input)
- (#try.Failure msg)
- (#try.Success [input (list)])
-
- (#try.Success [input' x])
- (..run (\ ..monad map (|>> (#.Cons x))
- (at_most (dec amount) parser))
- input')))))
-
-(def: #export (between from to parser)
- {#.doc "Parse between N and M times."}
- (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a))))
- (do {! ..monad}
- [minimum (..exactly from parser)]
- (if (n.< to from)
- (\ ! map (list\compose minimum)
- (..at_most (n.- from to) parser))
- (wrap minimum))))
-
-(def: #export (separated_by separator parser)
- {#.doc "Parsers instances of 'parser' that are separated by instances of 'separator'."}
- (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a))))
- (do {! ..monad}
- [?x (..maybe parser)]
- (case ?x
- #.None
- (wrap #.Nil)
-
- (#.Some x)
- (|> parser
- (..and separator)
- ..some
- (\ ! map (|>> (list\map product.right) (#.Cons x)))))))
-
-(def: #export (not parser)
- (All [s a] (-> (Parser s a) (Parser s Any)))
- (function (_ input)
- (case (parser input)
- (#try.Failure msg)
- (#try.Success [input []])
-
- _
- (#try.Failure "Expected to fail; yet succeeded."))))
-
-(def: #export (fail message)
- (All [s a] (-> Text (Parser s a)))
- (function (_ input)
- (#try.Failure message)))
-
-(def: #export (lift operation)
- (All [s a] (-> (Try a) (Parser s a)))
- (function (_ input)
- (case operation
- (#try.Success output)
- (#try.Success [input output])
-
- (#try.Failure error)
- (#try.Failure error))))
-
-(def: #export (default value parser)
- {#.doc "If the given parser fails, returns the default value."}
- (All [s a] (-> a (Parser s a) (Parser s a)))
- (function (_ input)
- (case (parser input)
- (#try.Failure error)
- (#try.Success [input value])
-
- (#try.Success [input' output])
- (#try.Success [input' output]))))
-
-(def: #export remaining
- (All [s] (Parser s s))
- (function (_ inputs)
- (#try.Success [inputs inputs])))
-
-(def: #export (rec parser)
- {#.doc "Combinator for recursive parser."}
- (All [s a] (-> (-> (Parser s a) (Parser s a)) (Parser s a)))
- (function (_ inputs)
- (..run (parser (rec parser)) inputs)))
-
-(def: #export (after param subject)
- (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a)))
- (do ..monad
- [_ param]
- subject))
-
-(def: #export (before param subject)
- (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a)))
- (do ..monad
- [output subject
- _ param]
- (wrap output)))
-
-(def: #export (filter test parser)
- (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a)))
- (do ..monad
- [output parser
- _ (..assert "Constraint failed." (test output))]
- (wrap output)))
-
-(def: #export (parses? parser)
- (All [s a] (-> (Parser s a) (Parser s Bit)))
- (function (_ input)
- (case (parser input)
- (#try.Failure error)
- (#try.Success [input false])
-
- (#try.Success [input' _])
- (#try.Success [input' true]))))
-
-(def: #export (parses parser)
- (All [s a] (-> (Parser s a) (Parser s Any)))
- (function (_ input)
- (case (parser input)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [input' _])
- (#try.Success [input' []]))))
-
-(def: #export (speculative parser)
- (All [s a] (-> (Parser s a) (Parser s a)))
- (function (_ input)
- (case (parser input)
- (#try.Success [input' output])
- (#try.Success [input output])
-
- output
- output)))
-
-(def: #export (codec codec parser)
- (All [s a z] (-> (Codec a z) (Parser s a) (Parser s z)))
- (function (_ input)
- (case (parser input)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [input' to_decode])
- (case (\ codec decode to_decode)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success value)
- (#try.Success [input' value])))))
diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux
deleted file mode 100644
index b825354c1..000000000
--- a/stdlib/source/lux/control/parser/analysis.lux
+++ /dev/null
@@ -1,134 +0,0 @@
-(.module:
- [lux (#- nat int rev)
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["." bit]
- ["." name]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." functor)]]]
- [math
- [number
- ["." i64]
- ["." nat]
- ["." int]
- ["." rev]
- ["." frac]]]
- [tool
- [compiler
- [arity (#+ Arity)]
- [reference (#+)
- [variable (#+)]]
- [language
- [lux
- ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]]]
- ["." //])
-
-(def: (remaining_inputs asts)
- (-> (List Analysis) Text)
- (format text.new_line "Remaining input: "
- (|> asts
- (list\map /.%analysis)
- (list.interpose " ")
- (text.join_with ""))))
-
-(exception: #export (cannot_parse {input (List Analysis)})
- (exception.report
- ["Input" (exception.enumerate /.%analysis input)]))
-
-(exception: #export (unconsumed_input {input (List Analysis)})
- (exception.report
- ["Input" (exception.enumerate /.%analysis input)]))
-
-(type: #export Parser
- (//.Parser (List Analysis)))
-
-(def: #export (run parser input)
- (All [a] (-> (Parser a) (List Analysis) (Try a)))
- (case (parser input)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [#.Nil value])
- (#try.Success value)
-
- (#try.Success [unconsumed _])
- (exception.throw ..unconsumed_input unconsumed)))
-
-(def: #export any
- (Parser Analysis)
- (function (_ input)
- (case input
- #.Nil
- (exception.throw ..cannot_parse input)
-
- (#.Cons [head tail])
- (#try.Success [tail head]))))
-
-(def: #export end!
- {#.doc "Ensures there are no more inputs."}
- (Parser Any)
- (function (_ tokens)
- (case tokens
- #.Nil (#try.Success [tokens []])
- _ (#try.Failure (format "Expected list of tokens to be empty!"
- (remaining_inputs tokens))))))
-
-(def: #export end?
- {#.doc "Checks whether there are no more inputs."}
- (Parser Bit)
- (function (_ tokens)
- (#try.Success [tokens (case tokens
- #.Nil true
- _ false)])))
-
-(template [<query> <assertion> <tag> <type> <eq>]
- [(def: #export <query>
- (Parser <type>)
- (function (_ input)
- (case input
- (^ (list& (<tag> x) input'))
- (#try.Success [input' x])
-
- _
- (exception.throw ..cannot_parse input))))
-
- (def: #export (<assertion> expected)
- (-> <type> (Parser Any))
- (function (_ input)
- (case input
- (^ (list& (<tag> actual) input'))
- (if (\ <eq> = expected actual)
- (#try.Success [input' []])
- (exception.throw ..cannot_parse input))
-
- _
- (exception.throw ..cannot_parse input))))]
-
- [bit bit! /.bit Bit bit.equivalence]
- [nat nat! /.nat Nat nat.equivalence]
- [int int! /.int Int int.equivalence]
- [rev rev! /.rev Rev rev.equivalence]
- [frac frac! /.frac Frac frac.equivalence]
- [text text! /.text Text text.equivalence]
- [local local! /.variable/local Nat nat.equivalence]
- [foreign foreign! /.variable/foreign Nat nat.equivalence]
- [constant constant! /.constant Name name.equivalence]
- )
-
-(def: #export (tuple parser)
- (All [a] (-> (Parser a) (Parser a)))
- (function (_ input)
- (case input
- (^ (list& (/.tuple head) tail))
- (do try.monad
- [output (..run parser head)]
- (#try.Success [tail output]))
-
- _
- (exception.throw ..cannot_parse input))))
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
deleted file mode 100644
index 37423b091..000000000
--- a/stdlib/source/lux/control/parser/binary.lux
+++ /dev/null
@@ -1,274 +0,0 @@
-(.module:
- [lux (#- and or nat int rev list type)
- [type (#+ :share)]
- [abstract
- [hash (#+ Hash)]
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["/" binary (#+ Binary)]
- [text
- ["%" format (#+ format)]
- [encoding
- ["." utf8]]]
- [collection
- ["." list]
- ["." row (#+ Row)]
- ["." set (#+ Set)]]]
- [macro
- ["." template]]
- [math
- [number
- ["n" nat]
- ["." frac]]]]
- ["." // ("#\." monad)])
-
-(type: #export Offset Nat)
-
-(type: #export Parser
- (//.Parser [Offset Binary]))
-
-(exception: #export (binary_was_not_fully_read {binary_length Nat} {bytes_read Nat})
- (exception.report
- ["Binary length" (%.nat binary_length)]
- ["Bytes read" (%.nat bytes_read)]))
-
-(def: #export (run parser input)
- (All [a] (-> (Parser a) Binary (Try a)))
- (case (parser [0 input])
- (#try.Failure msg)
- (#try.Failure msg)
-
- (#try.Success [[end _] output])
- (let [length (/.size input)]
- (if (n.= end length)
- (#try.Success output)
- (exception.throw ..binary_was_not_fully_read [length end])))))
-
-(def: #export end?
- (Parser Bit)
- (function (_ (^@ input [offset data]))
- (#try.Success [input (n.= offset (/.size data))])))
-
-(def: #export offset
- (Parser Offset)
- (function (_ (^@ input [offset data]))
- (#try.Success [input offset])))
-
-(def: #export remaining
- (Parser Nat)
- (function (_ (^@ input [offset data]))
- (#try.Success [input (n.- offset (/.size data))])))
-
-(type: #export Size Nat)
-
-(def: #export size/8 Size 1)
-(def: #export size/16 Size (n.* 2 size/8))
-(def: #export size/32 Size (n.* 2 size/16))
-(def: #export size/64 Size (n.* 2 size/32))
-
-(template [<name> <size> <read>]
- [(def: #export <name>
- (Parser I64)
- (function (_ [offset binary])
- (case (<read> offset binary)
- (#try.Success data)
- (#try.Success [(n.+ <size> offset) binary] data)
-
- (#try.Failure error)
- (#try.Failure error))))]
-
- [bits/8 ..size/8 /.read/8]
- [bits/16 ..size/16 /.read/16]
- [bits/32 ..size/32 /.read/32]
- [bits/64 ..size/64 /.read/64]
- )
-
-(template [<name> <type>]
- [(def: #export <name> (Parser <type>) ..bits/64)]
-
- [nat Nat]
- [int Int]
- [rev Rev]
- )
-
-(def: #export frac
- (Parser Frac)
- (//\map frac.from_bits ..bits/64))
-
-(exception: #export (invalid_tag {range Nat} {byte Nat})
- (exception.report
- ["Tag range" (%.nat range)]
- ["Tag value" (%.nat byte)]))
-
-(template: (!variant <case>+)
- (do {! //.monad}
- [flag (: (Parser Nat)
- ..bits/8)]
- (`` (case flag
- (^template [<number> <tag> <parser>]
- [<number> (\ ! map (|>> <tag>) <parser>)])
- ((~~ (template.splice <case>+)))
- _ (//.lift (exception.throw ..invalid_tag [(~~ (template.count <case>+)) flag]))))))
-
-(def: #export (or left right)
- (All [l r] (-> (Parser l) (Parser r) (Parser (| l r))))
- (!variant [[0 #.Left left]
- [1 #.Right right]]))
-
-(def: #export (rec body)
- (All [a] (-> (-> (Parser a) (Parser a)) (Parser a)))
- (function (_ input)
- (let [parser (body (rec body))]
- (parser input))))
-
-(def: #export any
- (Parser Any)
- (//\wrap []))
-
-(exception: #export (not_a_bit {value Nat})
- (exception.report
- ["Expected values" "either 0 or 1"]
- ["Actual value" (%.nat value)]))
-
-(def: #export bit
- (Parser Bit)
- (do //.monad
- [value (: (Parser Nat)
- ..bits/8)]
- (case value
- 0 (wrap #0)
- 1 (wrap #1)
- _ (//.lift (exception.throw ..not_a_bit [value])))))
-
-(def: #export (segment size)
- (-> Nat (Parser Binary))
- (function (_ [offset binary])
- (case size
- 0 (#try.Success [[offset binary] (/.create 0)])
- _ (|> binary
- (/.slice offset size)
- (\ try.monad map (|>> [[(n.+ size offset) binary]]))))))
-
-(template [<name> <bits>]
- [(def: #export <name>
- (Parser Binary)
- (do //.monad
- [size (//\map .nat <bits>)]
- (..segment size)))]
-
- [binary/8 ..bits/8]
- [binary/16 ..bits/16]
- [binary/32 ..bits/32]
- [binary/64 ..bits/64]
- )
-
-(template [<name> <binary>]
- [(def: #export <name>
- (Parser Text)
- (do //.monad
- [utf8 <binary>]
- (//.lift (\ utf8.codec decode utf8))))]
-
- [utf8/8 ..binary/8]
- [utf8/16 ..binary/16]
- [utf8/32 ..binary/32]
- [utf8/64 ..binary/64]
- )
-
-(def: #export text ..utf8/64)
-
-(template [<name> <bits>]
- [(def: #export (<name> valueP)
- (All [v] (-> (Parser v) (Parser (Row v))))
- (do //.monad
- [count (: (Parser Nat)
- <bits>)]
- (loop [index 0
- output (:share [v]
- (Parser v)
- valueP
-
- (Row v)
- row.empty)]
- (if (n.< count index)
- (do //.monad
- [value valueP]
- (recur (.inc index)
- (row.add value output)))
- (//\wrap output)))))]
-
- [row/8 ..bits/8]
- [row/16 ..bits/16]
- [row/32 ..bits/32]
- [row/64 ..bits/64]
- )
-
-(def: #export maybe
- (All [a] (-> (Parser a) (Parser (Maybe a))))
- (..or ..any))
-
-(def: #export (list value)
- (All [a] (-> (Parser a) (Parser (List a))))
- (..rec
- (|>> (//.and value)
- (..or ..any))))
-
-(exception: #export set_elements_are_not_unique)
-
-(def: #export (set hash value)
- (All [a] (-> (Hash a) (Parser a) (Parser (Set a))))
- (do //.monad
- [raw (..list value)
- #let [output (set.from_list hash raw)]
- _ (//.assert (exception.construct ..set_elements_are_not_unique [])
- (n.= (list.size raw)
- (set.size output)))]
- (wrap output)))
-
-(def: #export name
- (Parser Name)
- (//.and ..text ..text))
-
-(def: #export type
- (Parser Type)
- (..rec
- (function (_ type)
- (let [pair (//.and type type)
- indexed ..nat
- quantified (//.and (..list type) type)]
- (!variant [[0 #.Primitive (//.and ..text (..list type))]
- [1 #.Sum pair]
- [2 #.Product pair]
- [3 #.Function pair]
- [4 #.Parameter indexed]
- [5 #.Var indexed]
- [6 #.Ex indexed]
- [7 #.UnivQ quantified]
- [8 #.ExQ quantified]
- [9 #.Apply pair]
- [10 #.Named (//.and ..name type)]])))))
-
-(def: #export location
- (Parser Location)
- ($_ //.and ..text ..nat ..nat))
-
-(def: #export code
- (Parser Code)
- (..rec
- (function (_ recur)
- (let [sequence (..list recur)]
- (//.and ..location
- (!variant [[0 #.Bit ..bit]
- [1 #.Nat ..nat]
- [2 #.Int ..int]
- [3 #.Rev ..rev]
- [4 #.Frac ..frac]
- [5 #.Text ..text]
- [6 #.Identifier ..name]
- [7 #.Tag ..name]
- [8 #.Form sequence]
- [9 #.Tuple sequence]
- [10 #.Record (..list (//.and recur recur))]]))))))
diff --git a/stdlib/source/lux/control/parser/cli.lux b/stdlib/source/lux/control/parser/cli.lux
deleted file mode 100644
index b39b4234c..000000000
--- a/stdlib/source/lux/control/parser/cli.lux
+++ /dev/null
@@ -1,98 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]]
- [data
- ["." text ("#\." equivalence)
- ["%" format (#+ format)]]]]
- ["." //])
-
-(type: #export (Parser a)
- {#.doc "A command-line interface parser."}
- (//.Parser (List Text) a))
-
-(def: #export (run parser inputs)
- (All [a] (-> (Parser a) (List Text) (Try a)))
- (case (//.run parser inputs)
- (#try.Success [remaining output])
- (case remaining
- #.Nil
- (#try.Success output)
-
- _
- (#try.Failure (format "Remaining CLI inputs: " (text.join_with " " remaining))))
-
- (#try.Failure try)
- (#try.Failure try)))
-
-(def: #export any
- {#.doc "Just returns the next input without applying any logic."}
- (Parser Text)
- (function (_ inputs)
- (case inputs
- (#.Cons arg inputs')
- (#try.Success [inputs' arg])
-
- _
- (#try.Failure "Cannot parse empty arguments."))))
-
-(def: #export (parse parser)
- {#.doc "Parses the next input with a parsing function."}
- (All [a] (-> (-> Text (Try a)) (Parser a)))
- (function (_ inputs)
- (do try.monad
- [[remaining raw] (any inputs)
- output (parser raw)]
- (wrap [remaining output]))))
-
-(def: #export (this reference)
- {#.doc "Checks that a token is in the inputs."}
- (-> Text (Parser Any))
- (function (_ inputs)
- (do try.monad
- [[remaining raw] (any inputs)]
- (if (text\= reference raw)
- (wrap [remaining []])
- (try.fail (format "Missing token: '" reference "'"))))))
-
-(def: #export (somewhere cli)
- {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."}
- (All [a] (-> (Parser a) (Parser a)))
- (function (_ inputs)
- (loop [immediate inputs]
- (case (//.run cli immediate)
- (#try.Success [remaining output])
- (#try.Success [remaining output])
-
- (#try.Failure try)
- (case immediate
- #.Nil
- (#try.Failure try)
-
- (#.Cons to_omit immediate')
- (do try.monad
- [[remaining output] (recur immediate')]
- (wrap [(#.Cons to_omit remaining)
- output])))))))
-
-(def: #export end
- {#.doc "Ensures there are no more inputs."}
- (Parser Any)
- (function (_ inputs)
- (case inputs
- #.Nil (#try.Success [inputs []])
- _ (#try.Failure (format "Unknown parameters: " (text.join_with " " inputs))))))
-
-(def: #export (named name value)
- (All [a] (-> Text (Parser a) (Parser a)))
- (|> value
- (//.after (..this name))
- ..somewhere))
-
-(def: #export (parameter [short long] value)
- (All [a] (-> [Text Text] (Parser a) (Parser a)))
- (|> value
- (//.after (//.either (..this short) (..this long)))
- ..somewhere))
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
deleted file mode 100644
index 86ee0a1d8..000000000
--- a/stdlib/source/lux/control/parser/code.lux
+++ /dev/null
@@ -1,198 +0,0 @@
-(.module:
- [lux (#- nat int rev)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try (#+ Try)]]
- [data
- ["." bit]
- ["." text ("#\." monoid)]
- ["." name]
- [collection
- ["." list ("#\." functor)]]]
- [macro
- ["." code ("#\." equivalence)]]
- [math
- [number
- ["." nat]
- ["." int]
- ["." rev]
- ["." frac]]]]
- ["." //])
-
-(def: (join_pairs pairs)
- (All [a] (-> (List [a a]) (List a)))
- (case pairs
- #.Nil #.Nil
- (#.Cons [[x y] pairs']) (list& x y (join_pairs pairs'))))
-
-(type: #export Parser
- {#.doc "A Lux syntax parser."}
- (//.Parser (List Code)))
-
-(def: (remaining_inputs asts)
- (-> (List Code) Text)
- ($_ text\compose text.new_line "Remaining input: "
- (|> asts (list\map code.format) (list.interpose " ") (text.join_with ""))))
-
-(def: #export any
- {#.doc "Just returns the next input without applying any logic."}
- (Parser Code)
- (function (_ tokens)
- (case tokens
- #.Nil
- (#try.Failure "There are no tokens to parse!")
-
- (#.Cons [t tokens'])
- (#try.Success [tokens' t]))))
-
-(template [<query> <check> <type> <tag> <eq> <desc>]
- [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))]
- (def: #export <query>
- {#.doc (code.text ($_ text\compose "Parses the next " <desc> " input."))}
- (Parser <type>)
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> x)] tokens'])
- (#try.Success [tokens' x])
-
- _
- <failure>)))
-
- (def: #export (<check> expected)
- (-> <type> (Parser Any))
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> actual)] tokens'])
- (if (\ <eq> = expected actual)
- (#try.Success [tokens' []])
- <failure>)
-
- _
- <failure>))))]
-
- [bit bit! Bit #.Bit bit.equivalence "bit"]
- [nat nat! Nat #.Nat nat.equivalence "nat"]
- [int int! Int #.Int int.equivalence "int"]
- [rev rev! Rev #.Rev rev.equivalence "rev"]
- [frac frac! Frac #.Frac frac.equivalence "frac"]
- [text text! Text #.Text text.equivalence "text"]
- [identifier identifier! Name #.Identifier name.equivalence "identifier"]
- [tag tag! Name #.Tag name.equivalence "tag"]
- )
-
-(def: #export (this! ast)
- {#.doc "Ensures the given Code is the next input."}
- (-> Code (Parser Any))
- (function (_ tokens)
- (case tokens
- (#.Cons [token tokens'])
- (if (code\= ast token)
- (#try.Success [tokens' []])
- (#try.Failure ($_ text\compose "Expected a " (code.format ast) " but instead got " (code.format token)
- (remaining_inputs tokens))))
-
- _
- (#try.Failure "There are no tokens to parse!"))))
-
-(template [<query> <check> <tag> <eq> <desc>]
- [(with_expansions [<failure> (as_is (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))]
- (def: #export <query>
- {#.doc (code.text ($_ text\compose "Parse a local " <desc> " (a " <desc> " that has no module prefix)."))}
- (Parser Text)
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> ["" x])] tokens'])
- (#try.Success [tokens' x])
-
- _
- <failure>)))
-
- (def: #export (<check> expected)
- (-> Text (Parser Any))
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> ["" actual])] tokens'])
- (if (\ <eq> = expected actual)
- (#try.Success [tokens' []])
- <failure>)
-
- _
- <failure>))))]
-
- [local_identifier local_identifier! #.Identifier text.equivalence "local identifier"]
- [ local_tag local_tag! #.Tag text.equivalence "local tag"]
- )
-
-(template [<name> <tag> <desc>]
- [(def: #export (<name> p)
- {#.doc (code.text ($_ text\compose "Parse inside the contents of a " <desc> " as if they were the input Codes."))}
- (All [a]
- (-> (Parser a) (Parser a)))
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (<tag> members)] tokens'])
- (case (p members)
- (#try.Success [#.Nil x]) (#try.Success [tokens' x])
- _ (#try.Failure ($_ text\compose "Parser was expected to fully consume " <desc> (remaining_inputs tokens))))
-
- _
- (#try.Failure ($_ text\compose "Cannot parse " <desc> (remaining_inputs tokens))))))]
-
- [ form #.Form "form"]
- [tuple #.Tuple "tuple"]
- )
-
-(def: #export (record p)
- {#.doc (code.text ($_ text\compose "Parse inside the contents of a record as if they were the input Codes."))}
- (All [a]
- (-> (Parser a) (Parser a)))
- (function (_ tokens)
- (case tokens
- (#.Cons [[_ (#.Record pairs)] tokens'])
- (case (p (join_pairs pairs))
- (#try.Success [#.Nil x]) (#try.Success [tokens' x])
- _ (#try.Failure ($_ text\compose "Parser was expected to fully consume record" (remaining_inputs tokens))))
-
- _
- (#try.Failure ($_ text\compose "Cannot parse record" (remaining_inputs tokens))))))
-
-(def: #export end!
- {#.doc "Ensures there are no more inputs."}
- (Parser Any)
- (function (_ tokens)
- (case tokens
- #.Nil (#try.Success [tokens []])
- _ (#try.Failure ($_ text\compose "Expected list of tokens to be empty!" (remaining_inputs tokens))))))
-
-(def: #export end?
- {#.doc "Checks whether there are no more inputs."}
- (Parser Bit)
- (function (_ tokens)
- (#try.Success [tokens (case tokens
- #.Nil true
- _ false)])))
-
-(def: #export (run syntax inputs)
- (All [a] (-> (Parser a) (List Code) (Try a)))
- (case (syntax inputs)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [unconsumed value])
- (case unconsumed
- #.Nil
- (#try.Success value)
-
- _
- (#try.Failure (text\compose "Unconsumed inputs: "
- (|> (list\map code.format unconsumed)
- (text.join_with ", ")))))))
-
-(def: #export (local inputs syntax)
- {#.doc "Run a syntax parser with the given list of inputs, instead of the real ones."}
- (All [a] (-> (List Code) (Parser a) (Parser a)))
- (function (_ real)
- (do try.monad
- [value (..run syntax inputs)]
- (wrap [real value]))))
diff --git a/stdlib/source/lux/control/parser/environment.lux b/stdlib/source/lux/control/parser/environment.lux
deleted file mode 100644
index 509369d68..000000000
--- a/stdlib/source/lux/control/parser/environment.lux
+++ /dev/null
@@ -1,43 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["." product]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." dictionary (#+ Dictionary)]]]]
- ["." //])
-
-(type: #export Property
- Text)
-
-(type: #export Environment
- (Dictionary Property Text))
-
-(exception: #export (unknown {property Property})
- (exception.report
- ["Property" (%.text property)]))
-
-(type: #export (Parser a)
- (//.Parser Environment a))
-
-(def: #export empty
- Environment
- (dictionary.new text.hash))
-
-(def: #export (property name)
- (-> Text (Parser Text))
- (function (_ environment)
- (case (dictionary.get name environment)
- (#.Some value)
- (exception.return [environment value])
-
- #.None
- (exception.throw ..unknown name))))
-
-(def: #export (run parser environment)
- (All [a] (-> (Parser a) Environment (Try a)))
- (\ try.monad map product.right (parser environment)))
diff --git a/stdlib/source/lux/control/parser/json.lux b/stdlib/source/lux/control/parser/json.lux
deleted file mode 100644
index abc3ded7c..000000000
--- a/stdlib/source/lux/control/parser/json.lux
+++ /dev/null
@@ -1,206 +0,0 @@
-(.module:
- [lux #*
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["." bit]
- ["." text ("#\." equivalence monoid)]
- [collection
- ["." list ("#\." functor)]
- ["." row]
- ["." dictionary (#+ Dictionary)]]
- [format
- ["/" json (#+ JSON)]]]
- [macro
- ["." code]]
- [math
- [number
- ["." frac]]]]
- ["." // ("#\." functor)])
-
-(type: #export (Parser a)
- {#.doc "JSON parser."}
- (//.Parser (List JSON) a))
-
-(exception: #export (unconsumed_input {input (List JSON)})
- (exception.report
- ["Input" (exception.enumerate /.format input)]))
-
-(exception: #export empty_input)
-
-(def: #export (run parser json)
- (All [a] (-> (Parser a) JSON (Try a)))
- (case (//.run parser (list json))
- (#try.Success [remainder output])
- (case remainder
- #.Nil
- (#try.Success output)
-
- _
- (exception.throw ..unconsumed_input remainder))
-
- (#try.Failure error)
- (#try.Failure error)))
-
-(def: #export any
- {#.doc "Just returns the JSON input without applying any logic."}
- (Parser JSON)
- (<| (function (_ inputs))
- (case inputs
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons head tail)
- (#try.Success [tail head]))))
-
-(exception: #export (unexpected_value {value JSON})
- (exception.report
- ["Value" (/.format value)]))
-
-(template [<name> <type> <tag> <desc>]
- [(def: #export <name>
- {#.doc (code.text ($_ text\compose "Reads a JSON value as " <desc> "."))}
- (Parser <type>)
- (do //.monad
- [head ..any]
- (case head
- (<tag> value)
- (wrap value)
-
- _
- (//.fail (exception.construct ..unexpected_value [head])))))]
-
- [null /.Null #/.Null "null"]
- [boolean /.Boolean #/.Boolean "boolean"]
- [number /.Number #/.Number "number"]
- [string /.String #/.String "string"]
- )
-
-(exception: #export [a] (value_mismatch {reference JSON} {sample JSON})
- (exception.report
- ["Reference" (/.format reference)]
- ["Sample" (/.format sample)]))
-
-(template [<test> <check> <type> <equivalence> <tag> <desc>]
- [(def: #export (<test> test)
- {#.doc (code.text ($_ text\compose "Asks whether a JSON value is a " <desc> "."))}
- (-> <type> (Parser Bit))
- (do //.monad
- [head ..any]
- (case head
- (<tag> value)
- (wrap (\ <equivalence> = test value))
-
- _
- (//.fail (exception.construct ..unexpected_value [head])))))
-
- (def: #export (<check> test)
- {#.doc (code.text ($_ text\compose "Ensures a JSON value is a " <desc> "."))}
- (-> <type> (Parser Any))
- (do //.monad
- [head ..any]
- (case head
- (<tag> value)
- (if (\ <equivalence> = test value)
- (wrap [])
- (//.fail (exception.construct ..value_mismatch [(<tag> test) (<tag> value)])))
-
- _
- (//.fail (exception.construct ..unexpected_value [head])))))]
-
- [boolean? boolean! /.Boolean bit.equivalence #/.Boolean "boolean"]
- [number? number! /.Number frac.equivalence #/.Number "number"]
- [string? string! /.String text.equivalence #/.String "string"]
- )
-
-(def: #export (nullable parser)
- (All [a] (-> (Parser a) (Parser (Maybe a))))
- (//.or ..null
- parser))
-
-(def: #export (array parser)
- {#.doc "Parses a JSON array."}
- (All [a] (-> (Parser a) (Parser a)))
- (do //.monad
- [head ..any]
- (case head
- (#/.Array values)
- (case (//.run parser (row.to_list values))
- (#try.Failure error)
- (//.fail error)
-
- (#try.Success [remainder output])
- (case remainder
- #.Nil
- (wrap output)
-
- _
- (//.fail (exception.construct ..unconsumed_input remainder))))
-
- _
- (//.fail (exception.construct ..unexpected_value [head])))))
-
-(def: #export (object parser)
- {#.doc "Parses a JSON object. Use this with the 'field' combinator."}
- (All [a] (-> (Parser a) (Parser a)))
- (do //.monad
- [head ..any]
- (case head
- (#/.Object kvs)
- (case (|> kvs
- dictionary.entries
- (list\map (function (_ [key value])
- (list (#/.String key) value)))
- list.concat
- (//.run parser))
- (#try.Failure error)
- (//.fail error)
-
- (#try.Success [remainder output])
- (case remainder
- #.Nil
- (wrap output)
-
- _
- (//.fail (exception.construct ..unconsumed_input remainder))))
-
- _
- (//.fail (exception.construct ..unexpected_value [head])))))
-
-(def: #export (field field_name parser)
- {#.doc "Parses a field inside a JSON object. Use this inside the 'object' combinator."}
- (All [a] (-> Text (Parser a) (Parser a)))
- (function (recur inputs)
- (case inputs
- (^ (list& (#/.String key) value inputs'))
- (if (text\= key field_name)
- (case (//.run parser (list value))
- (#try.Success [#.Nil output])
- (#try.Success [inputs' output])
-
- (#try.Success [inputs'' _])
- (exception.throw ..unconsumed_input inputs'')
-
- (#try.Failure error)
- (#try.Failure error))
- (do try.monad
- [[inputs'' output] (recur inputs')]
- (wrap [(list& (#/.String key) value inputs'')
- output])))
-
- #.Nil
- (exception.throw ..empty_input [])
-
- _
- (exception.throw ..unconsumed_input inputs))))
-
-(def: #export dictionary
- {#.doc "Parses a dictionary-like JSON object."}
- (All [a] (-> (Parser a) (Parser (Dictionary Text a))))
- (|>> (//.and ..string)
- //.some
- ..object
- (//\map (dictionary.from_list text.hash))))
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
deleted file mode 100644
index f6ae1c1ae..000000000
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ /dev/null
@@ -1,163 +0,0 @@
-(.module:
- [lux (#- function loop i64)
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["." bit]
- ["." name]
- ["." text
- ["%" format (#+ format)]]]
- [math
- [number
- ["n" nat]
- ["." i64]
- ["." frac]]]
- [tool
- [compiler
- [reference (#+)
- [variable (#+ Register)]]
- [arity (#+ Arity)]
- [language
- [lux
- [analysis (#+ Variant Tuple Environment)]
- ["/" synthesis (#+ Synthesis Abstraction)]]]]]]
- ["." //])
-
-## TODO: Use "type:" ASAP.
-(def: Input
- Type
- (type (List Synthesis)))
-
-(exception: #export (cannot_parse {input ..Input})
- (exception.report
- ["Input" (exception.enumerate /.%synthesis input)]))
-
-(exception: #export (unconsumed_input {input ..Input})
- (exception.report
- ["Input" (exception.enumerate /.%synthesis input)]))
-
-(exception: #export (expected_empty_input {input ..Input})
- (exception.report
- ["Input" (exception.enumerate /.%synthesis input)]))
-
-(exception: #export (wrong_arity {expected Arity} {actual Arity})
- (exception.report
- ["Expected" (%.nat expected)]
- ["Actual" (%.nat actual)]))
-
-(exception: #export empty_input)
-
-(type: #export Parser
- (//.Parser ..Input))
-
-(def: #export (run parser input)
- (All [a] (-> (Parser a) ..Input (Try a)))
- (case (parser input)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [#.Nil value])
- (#try.Success value)
-
- (#try.Success [unconsumed _])
- (exception.throw ..unconsumed_input unconsumed)))
-
-(def: #export any
- (Parser Synthesis)
- (.function (_ input)
- (case input
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons [head tail])
- (#try.Success [tail head]))))
-
-(def: #export end!
- {#.doc "Ensures there are no more inputs."}
- (Parser Any)
- (.function (_ tokens)
- (case tokens
- #.Nil (#try.Success [tokens []])
- _ (exception.throw ..expected_empty_input [tokens]))))
-
-(def: #export end?
- {#.doc "Checks whether there are no more inputs."}
- (Parser Bit)
- (.function (_ tokens)
- (#try.Success [tokens (case tokens
- #.Nil true
- _ false)])))
-
-(template [<query> <assertion> <tag> <type> <eq>]
- [(def: #export <query>
- (Parser <type>)
- (.function (_ input)
- (case input
- (^ (list& (<tag> x) input'))
- (#try.Success [input' x])
-
- _
- (exception.throw ..cannot_parse input))))
-
- (def: #export (<assertion> expected)
- (-> <type> (Parser Any))
- (.function (_ input)
- (case input
- (^ (list& (<tag> actual) input'))
- (if (\ <eq> = expected actual)
- (#try.Success [input' []])
- (exception.throw ..cannot_parse input))
-
- _
- (exception.throw ..cannot_parse input))))]
-
- [bit bit! /.bit Bit bit.equivalence]
- [i64 i64! /.i64 (I64 Any) i64.equivalence]
- [f64 f64! /.f64 Frac frac.equivalence]
- [text text! /.text Text text.equivalence]
- [local local! /.variable/local Nat n.equivalence]
- [foreign foreign! /.variable/foreign Nat n.equivalence]
- [constant constant! /.constant Name name.equivalence]
- )
-
-(def: #export (tuple parser)
- (All [a] (-> (Parser a) (Parser a)))
- (.function (_ input)
- (case input
- (^ (list& (/.tuple head) tail))
- (do try.monad
- [output (..run parser head)]
- (#try.Success [tail output]))
-
- _
- (exception.throw ..cannot_parse input))))
-
-(def: #export (function expected parser)
- (All [a] (-> Arity (Parser a) (Parser [(Environment Synthesis) a])))
- (.function (_ input)
- (case input
- (^ (list& (/.function/abstraction [environment actual body]) tail))
- (if (n.= expected actual)
- (do try.monad
- [output (..run parser (list body))]
- (#try.Success [tail [environment output]]))
- (exception.throw ..wrong_arity [expected actual]))
-
- _
- (exception.throw ..cannot_parse input))))
-
-(def: #export (loop init_parsers iteration_parser)
- (All [a b] (-> (Parser a) (Parser b) (Parser [Register a b])))
- (.function (_ input)
- (case input
- (^ (list& (/.loop/scope [start inits iteration]) tail))
- (do try.monad
- [inits (..run init_parsers inits)
- iteration (..run iteration_parser (list iteration))]
- (#try.Success [tail [start inits iteration]]))
-
- _
- (exception.throw ..cannot_parse input))))
diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux
deleted file mode 100644
index 7dc6001b5..000000000
--- a/stdlib/source/lux/control/parser/text.lux
+++ /dev/null
@@ -1,376 +0,0 @@
-(.module:
- [lux (#- or and not)
- [abstract
- [monad (#+ Monad do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- ["/" text (#+ Char) ("#\." monoid)]
- ["." product]
- ["." maybe]
- [collection
- ["." list ("#\." fold)]]]
- [macro
- ["." code]]
- [math
- [number
- ["n" nat ("#\." decimal)]]]]
- ["." //])
-
-(type: #export Offset Nat)
-
-(def: start_offset Offset 0)
-
-(type: #export Parser
- (//.Parser [Offset Text]))
-
-(type: #export Slice
- {#basis Offset
- #distance Offset})
-
-(def: (remaining offset tape)
- (-> Offset Text Text)
- (|> tape (/.split offset) maybe.assume product.right))
-
-(exception: #export (unconsumed_input {offset Offset} {tape Text})
- (exception.report
- ["Offset" (n\encode offset)]
- ["Input size" (n\encode (/.size tape))]
- ["Remaining input" (remaining offset tape)]))
-
-(exception: #export (expected_to_fail {offset Offset} {tape Text})
- (exception.report
- ["Offset" (n\encode offset)]
- ["Input" (remaining offset tape)]))
-
-(exception: #export cannot_parse)
-(exception: #export cannot_slice)
-
-(def: #export (run parser input)
- (All [a] (-> (Parser a) Text (Try a)))
- (case (parser [start_offset input])
- (#try.Failure msg)
- (#try.Failure msg)
-
- (#try.Success [[end_offset _] output])
- (if (n.= end_offset (/.size input))
- (#try.Success output)
- (exception.throw ..unconsumed_input [end_offset input]))))
-
-(def: #export offset
- (Parser Offset)
- (function (_ (^@ input [offset tape]))
- (#try.Success [input offset])))
-
-(def: (with_slices parser)
- (-> (Parser (List Slice)) (Parser Slice))
- (do //.monad
- [offset ..offset
- slices parser]
- (wrap (list\fold (function (_ [slice::basis slice::distance]
- [total::basis total::distance])
- [total::basis ("lux i64 +" slice::distance total::distance)])
- {#basis offset
- #distance 0}
- slices))))
-
-(def: #export any
- {#.doc "Just returns the next character without applying any logic."}
- (Parser Text)
- (function (_ [offset tape])
- (case (/.nth offset tape)
- (#.Some output)
- (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)])
-
- _
- (exception.throw ..cannot_parse []))))
-
-(def: #export any!
- {#.doc "Just returns the next character without applying any logic."}
- (Parser Slice)
- (function (_ [offset tape])
- (case (/.nth offset tape)
- (#.Some _)
- (#try.Success [[("lux i64 +" 1 offset) tape]
- {#basis offset
- #distance 1}])
-
- _
- (exception.throw ..cannot_slice []))))
-
-(template [<name> <type> <any>]
- [(def: #export (<name> p)
- {#.doc "Produce a character if the parser fails."}
- (All [a] (-> (Parser a) (Parser <type>)))
- (function (_ input)
- (case (p input)
- (#try.Failure msg)
- (<any> input)
-
- _
- (exception.throw ..expected_to_fail input))))]
-
- [not Text ..any]
- [not! Slice ..any!]
- )
-
-(exception: #export (cannot_match {reference Text})
- (exception.report
- ["Reference" (/.format reference)]))
-
-(def: #export (this reference)
- {#.doc "Lex a text if it matches the given sample."}
- (-> Text (Parser Any))
- (function (_ [offset tape])
- (case (/.index_of' reference offset tape)
- (#.Some where)
- (if (n.= offset where)
- (#try.Success [[("lux i64 +" (/.size reference) offset) tape]
- []])
- (exception.throw ..cannot_match [reference]))
-
- _
- (exception.throw ..cannot_match [reference]))))
-
-(def: #export end!
- {#.doc "Ensure the parser's input is empty."}
- (Parser Any)
- (function (_ (^@ input [offset tape]))
- (if (n.= offset (/.size tape))
- (#try.Success [input []])
- (exception.throw ..unconsumed_input input))))
-
-(def: #export peek
- {#.doc "Lex the next character (without consuming it from the input)."}
- (Parser Text)
- (function (_ (^@ input [offset tape]))
- (case (/.nth offset tape)
- (#.Some output)
- (#try.Success [input (/.from_code output)])
-
- _
- (exception.throw ..cannot_parse []))))
-
-(def: #export get_input
- {#.doc "Get all of the remaining input (without consuming it)."}
- (Parser Text)
- (function (_ (^@ input [offset tape]))
- (#try.Success [input (remaining offset tape)])))
-
-(def: #export (range bottom top)
- {#.doc "Only lex characters within a range."}
- (-> Nat Nat (Parser Text))
- (do //.monad
- [char any
- #let [char' (maybe.assume (/.nth 0 char))]
- _ (//.assert ($_ /\compose "Character is not within range: " (/.from_code bottom) "-" (/.from_code top))
- (.and (n.>= bottom char')
- (n.<= top char')))]
- (wrap char)))
-
-(template [<name> <bottom> <top> <desc>]
- [(def: #export <name>
- {#.doc (code.text ($_ /\compose "Only lex " <desc> " characters."))}
- (Parser Text)
- (..range (char <bottom>) (char <top>)))]
-
- [upper "A" "Z" "uppercase"]
- [lower "a" "z" "lowercase"]
- [decimal "0" "9" "decimal"]
- [octal "0" "7" "octal"]
- )
-
-(def: #export alpha
- {#.doc "Only lex alphabetic characters."}
- (Parser Text)
- (//.either lower upper))
-
-(def: #export alpha_num
- {#.doc "Only lex alphanumeric characters."}
- (Parser Text)
- (//.either alpha decimal))
-
-(def: #export hexadecimal
- {#.doc "Only lex hexadecimal digits."}
- (Parser Text)
- ($_ //.either
- decimal
- (range (char "a") (char "f"))
- (range (char "A") (char "F"))))
-
-(template [<name>]
- [(exception: #export (<name> {options Text} {character Char})
- (exception.report
- ["Options" (/.format options)]
- ["Character" (/.format (/.from_code character))]))]
-
- [character_should_be]
- [character_should_not_be]
- )
-
-(template [<name> <modifier> <exception> <description_modifier>]
- [(def: #export (<name> options)
- {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))}
- (-> Text (Parser Text))
- (function (_ [offset tape])
- (case (/.nth offset tape)
- (#.Some output)
- (let [output' (/.from_code output)]
- (if (<modifier> (/.contains? output' options))
- (#try.Success [[("lux i64 +" 1 offset) tape] output'])
- (exception.throw <exception> [options output])))
-
- _
- (exception.throw ..cannot_parse []))))]
-
- [one_of |> ..character_should_be ""]
- [none_of .not ..character_should_not_be " not"]
- )
-
-(template [<name> <modifier> <exception> <description_modifier>]
- [(def: #export (<name> options)
- {#.doc (code.text ($_ /\compose "Only lex characters that are" <description_modifier> " part of a piece of text."))}
- (-> Text (Parser Slice))
- (function (_ [offset tape])
- (case (/.nth offset tape)
- (#.Some output)
- (let [output' (/.from_code output)]
- (if (<modifier> (/.contains? output' options))
- (#try.Success [[("lux i64 +" 1 offset) tape]
- {#basis offset
- #distance 1}])
- (exception.throw <exception> [options output])))
-
- _
- (exception.throw ..cannot_slice []))))]
-
- [one_of! |> ..character_should_be ""]
- [none_of! .not ..character_should_not_be " not"]
- )
-
-(exception: #export (character_does_not_satisfy_predicate {character Char})
- (exception.report
- ["Character" (/.format (/.from_code character))]))
-
-(def: #export (satisfies p)
- {#.doc "Only lex characters that satisfy a predicate."}
- (-> (-> Char Bit) (Parser Text))
- (function (_ [offset tape])
- (case (/.nth offset tape)
- (#.Some output)
- (if (p output)
- (#try.Success [[("lux i64 +" 1 offset) tape] (/.from_code output)])
- (exception.throw ..character_does_not_satisfy_predicate [output]))
-
- _
- (exception.throw ..cannot_parse []))))
-
-(def: #export space
- {#.doc "Only lex white-space."}
- (Parser Text)
- (..satisfies /.space?))
-
-(def: #export (and left right)
- (-> (Parser Text) (Parser Text) (Parser Text))
- (do //.monad
- [=left left
- =right right]
- (wrap ($_ /\compose =left =right))))
-
-(def: #export (and! left right)
- (-> (Parser Slice) (Parser Slice) (Parser Slice))
- (do //.monad
- [[left::basis left::distance] left
- [right::basis right::distance] right]
- (wrap [left::basis ("lux i64 +" left::distance right::distance)])))
-
-(template [<name> <base> <doc_modifier>]
- [(def: #export (<name> parser)
- {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))}
- (-> (Parser Text) (Parser Text))
- (|> parser <base> (\ //.monad map /.concat)))]
-
- [some //.some "some"]
- [many //.many "many"]
- )
-
-(template [<name> <base> <doc_modifier>]
- [(def: #export (<name> parser)
- {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " characters as a single continuous text."))}
- (-> (Parser Slice) (Parser Slice))
- (with_slices (<base> parser)))]
-
- [some! //.some "some"]
- [many! //.many "many"]
- )
-
-(template [<name> <base> <doc_modifier>]
- [(def: #export (<name> amount parser)
- {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))}
- (-> Nat (Parser Text) (Parser Text))
- (|> parser (<base> amount) (\ //.monad map /.concat)))]
-
- [exactly //.exactly "exactly"]
- [at_most //.at_most "at most"]
- [at_least //.at_least "at least"]
- )
-
-(template [<name> <base> <doc_modifier>]
- [(def: #export (<name> amount parser)
- {#.doc (code.text ($_ /\compose "Lex " <doc_modifier> " N characters."))}
- (-> Nat (Parser Slice) (Parser Slice))
- (with_slices (<base> amount parser)))]
-
- [exactly! //.exactly "exactly"]
- [at_most! //.at_most "at most"]
- [at_least! //.at_least "at least"]
- )
-
-(def: #export (between from to parser)
- {#.doc "Lex between N and M characters."}
- (-> Nat Nat (Parser Text) (Parser Text))
- (|> parser (//.between from to) (\ //.monad map /.concat)))
-
-(def: #export (between! from to parser)
- {#.doc "Lex between N and M characters."}
- (-> Nat Nat (Parser Slice) (Parser Slice))
- (with_slices (//.between from to parser)))
-
-(def: #export (enclosed [start end] parser)
- (All [a] (-> [Text Text] (Parser a) (Parser a)))
- (|> parser
- (//.before (this end))
- (//.after (this start))))
-
-(def: #export (local local_input parser)
- {#.doc "Run a parser with the given input, instead of the real one."}
- (All [a] (-> Text (Parser a) (Parser a)))
- (function (_ real_input)
- (case (..run parser local_input)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success value)
- (#try.Success [real_input value]))))
-
-(def: #export (slice parser)
- (-> (Parser Slice) (Parser Text))
- (do //.monad
- [[basis distance] parser]
- (function (_ (^@ input [offset tape]))
- (case (/.clip basis distance tape)
- (#.Some output)
- (#try.Success [input output])
-
- #.None
- (exception.throw ..cannot_slice [])))))
-
-(def: #export (embed structured text)
- (All [s a]
- (-> (Parser a)
- (//.Parser s Text)
- (//.Parser s a)))
- (do //.monad
- [raw text]
- (//.lift (..run structured raw))))
diff --git a/stdlib/source/lux/control/parser/tree.lux b/stdlib/source/lux/control/parser/tree.lux
deleted file mode 100644
index ac824638a..000000000
--- a/stdlib/source/lux/control/parser/tree.lux
+++ /dev/null
@@ -1,59 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]]
- [data
- [collection
- [tree (#+ Tree)
- ["." zipper (#+ Zipper)]]]]]
- ["." //])
-
-(type: #export (Parser t a)
- (//.Parser (Zipper t) a))
-
-(def: #export (run' parser zipper)
- (All [t a] (-> (Parser t a) (Zipper t) (Try a)))
- (do try.monad
- [[zipper output] (//.run parser zipper)]
- (wrap output)))
-
-(def: #export (run parser tree)
- (All [t a] (-> (Parser t a) (Tree t) (Try a)))
- (run' parser (zipper.zip tree)))
-
-(def: #export value
- (All [t] (Parser t t))
- (function (_ zipper)
- (#try.Success [zipper (zipper.value zipper)])))
-
-(exception: #export cannot-move-further)
-
-(template [<name> <direction>]
- [(def: #export <name>
- (All [t] (Parser t []))
- (function (_ zipper)
- (case (<direction> zipper)
- #.None
- (exception.throw ..cannot-move-further [])
-
- (#.Some next)
- (#try.Success [next []]))))]
-
- [down zipper.down]
- [up zipper.up]
-
- [right zipper.right]
- [rightmost zipper.rightmost]
-
- [left zipper.left]
- [leftmost zipper.leftmost]
-
- [next zipper.next]
- [end zipper.end]
-
- [previous zipper.previous]
- [start zipper.start]
- )
diff --git a/stdlib/source/lux/control/parser/type.lux b/stdlib/source/lux/control/parser/type.lux
deleted file mode 100644
index ce58c5ce3..000000000
--- a/stdlib/source/lux/control/parser/type.lux
+++ /dev/null
@@ -1,348 +0,0 @@
-(.module:
- [lux (#- function)
- [abstract
- ["." monad (#+ do)]]
- [control
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- ["." function]]
- [data
- ["." text ("#\." monoid)
- ["%" format (#+ format)]]
- [collection
- ["." list ("#\." functor)]
- ["." dictionary (#+ Dictionary)]]]
- [macro
- ["." code]]
- [math
- [number
- ["n" nat ("#\." decimal)]]]
- ["." type ("#\." equivalence)
- ["." check]]]
- ["." //])
-
-(template [<name>]
- [(exception: #export (<name> {type Type})
- (exception.report
- ["Type" (%.type type)]))]
-
- [not_existential]
- [not_recursive]
- [not_named]
- [not_parameter]
- [unknown_parameter]
- [not_function]
- [not_application]
- [not_polymorphic]
- [not_variant]
- [not_tuple]
- )
-
-(template [<name>]
- [(exception: #export (<name> {expected Type} {actual Type})
- (exception.report
- ["Expected" (%.type expected)]
- ["Actual" (%.type actual)]))]
-
- [types_do_not_match]
- [wrong_parameter]
- )
-
-(exception: #export empty_input)
-
-(exception: #export (unconsumed_input {remaining (List Type)})
- (exception.report
- ["Types" (|> remaining
- (list\map (|>> %.type (format text.new_line "* ")))
- (text.join_with ""))]))
-
-(type: #export Env
- (Dictionary Nat [Type Code]))
-
-(type: #export (Parser a)
- (//.Parser [Env (List Type)] a))
-
-(def: #export fresh
- Env
- (dictionary.new n.hash))
-
-(def: (run' env poly types)
- (All [a] (-> Env (Parser a) (List Type) (Try a)))
- (case (//.run poly [env types])
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [[env' remaining] output])
- (case remaining
- #.Nil
- (#try.Success output)
-
- _
- (exception.throw ..unconsumed_input remaining))))
-
-(def: #export (run poly type)
- (All [a] (-> (Parser a) Type (Try a)))
- (run' ..fresh poly (list type)))
-
-(def: #export env
- (Parser Env)
- (.function (_ [env inputs])
- (#try.Success [[env inputs] env])))
-
-(def: (with_env temp poly)
- (All [a] (-> Env (Parser a) (Parser a)))
- (.function (_ [env inputs])
- (case (//.run poly [temp inputs])
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [[_ remaining] output])
- (#try.Success [[env remaining] output]))))
-
-(def: #export peek
- (Parser Type)
- (.function (_ [env inputs])
- (case inputs
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons headT tail)
- (#try.Success [[env inputs] headT]))))
-
-(def: #export any
- (Parser Type)
- (.function (_ [env inputs])
- (case inputs
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons headT tail)
- (#try.Success [[env tail] headT]))))
-
-(def: #export (local types poly)
- (All [a] (-> (List Type) (Parser a) (Parser a)))
- (.function (_ [env pass_through])
- (case (run' env poly types)
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success output)
- (#try.Success [[env pass_through] output]))))
-
-(def: (label idx)
- (-> Nat Code)
- (code.local_identifier ($_ text\compose "label" text.tab (n\encode idx))))
-
-(def: #export (with_extension type poly)
- (All [a] (-> Type (Parser a) (Parser [Code a])))
- (.function (_ [env inputs])
- (let [current_id (dictionary.size env)
- g!var (label current_id)]
- (case (//.run poly
- [(dictionary.put current_id [type g!var] env)
- inputs])
- (#try.Failure error)
- (#try.Failure error)
-
- (#try.Success [[_ inputs'] output])
- (#try.Success [[env inputs'] [g!var output]])))))
-
-(template [<name> <flattener> <tag> <exception>]
- [(def: #export (<name> poly)
- (All [a] (-> (Parser a) (Parser a)))
- (do //.monad
- [headT ..any]
- (let [members (<flattener> (type.un_name headT))]
- (if (n.> 1 (list.size members))
- (local members poly)
- (//.fail (exception.construct <exception> headT))))))]
-
- [variant type.flatten_variant #.Sum ..not_variant]
- [tuple type.flatten_tuple #.Product ..not_tuple]
- )
-
-(def: polymorphic'
- (Parser [Nat Type])
- (do //.monad
- [headT any
- #let [[num_arg bodyT] (type.flatten_univ_q (type.un_name headT))]]
- (if (n.= 0 num_arg)
- (//.fail (exception.construct ..not_polymorphic headT))
- (wrap [num_arg bodyT]))))
-
-(def: #export (polymorphic poly)
- (All [a] (-> (Parser a) (Parser [Code (List Code) a])))
- (do {! //.monad}
- [headT any
- funcI (\ ! map dictionary.size ..env)
- [num_args non_poly] (local (list headT) ..polymorphic')
- env ..env
- #let [funcL (label funcI)
- [all_varsL env'] (loop [current_arg 0
- env' env
- all_varsL (: (List Code) (list))]
- (if (n.< num_args current_arg)
- (if (n.= 0 current_arg)
- (let [varL (label (inc funcI))]
- (recur (inc current_arg)
- (|> env'
- (dictionary.put funcI [headT funcL])
- (dictionary.put (inc funcI) [(#.Parameter (inc funcI)) varL]))
- (#.Cons varL all_varsL)))
- (let [partialI (|> current_arg (n.* 2) (n.+ funcI))
- partial_varI (inc partialI)
- partial_varL (label partial_varI)
- partialC (` ((~ funcL) (~+ (|> (list.indices num_args)
- (list\map (|>> (n.* 2) inc (n.+ funcI) label))
- list.reverse))))]
- (recur (inc current_arg)
- (|> env'
- (dictionary.put partialI [.Nothing partialC])
- (dictionary.put partial_varI [(#.Parameter partial_varI) partial_varL]))
- (#.Cons partial_varL all_varsL))))
- [all_varsL env']))]]
- (<| (with_env env')
- (local (list non_poly))
- (do !
- [output poly]
- (wrap [funcL all_varsL output])))))
-
-(def: #export (function in_poly out_poly)
- (All [i o] (-> (Parser i) (Parser o) (Parser [i o])))
- (do //.monad
- [headT any
- #let [[inputsT outputT] (type.flatten_function (type.un_name headT))]]
- (if (n.> 0 (list.size inputsT))
- (//.and (local inputsT in_poly)
- (local (list outputT) out_poly))
- (//.fail (exception.construct ..not_function headT)))))
-
-(def: #export (apply poly)
- (All [a] (-> (Parser a) (Parser a)))
- (do //.monad
- [headT any
- #let [[funcT paramsT] (type.flatten_application (type.un_name headT))]]
- (if (n.= 0 (list.size paramsT))
- (//.fail (exception.construct ..not_application headT))
- (..local (#.Cons funcT paramsT) poly))))
-
-(template [<name> <test>]
- [(def: #export (<name> expected)
- (-> Type (Parser Any))
- (do //.monad
- [actual any]
- (if (<test> expected actual)
- (wrap [])
- (//.fail (exception.construct ..types_do_not_match [expected actual])))))]
-
- [exactly type\=]
- [sub check.checks?]
- [super (function.flip check.checks?)]
- )
-
-(def: #export (adjusted_idx env idx)
- (-> Env Nat Nat)
- (let [env_level (n./ 2 (dictionary.size env))
- parameter_level (n./ 2 idx)
- parameter_idx (n.% 2 idx)]
- (|> env_level dec (n.- parameter_level) (n.* 2) (n.+ parameter_idx))))
-
-(def: #export parameter
- (Parser Code)
- (do //.monad
- [env ..env
- headT any]
- (case headT
- (#.Parameter idx)
- (case (dictionary.get (adjusted_idx env idx) env)
- (#.Some [poly_type poly_code])
- (wrap poly_code)
-
- #.None
- (//.fail (exception.construct ..unknown_parameter headT)))
-
- _
- (//.fail (exception.construct ..not_parameter headT)))))
-
-(def: #export (parameter! id)
- (-> Nat (Parser Any))
- (do //.monad
- [env ..env
- headT any]
- (case headT
- (#.Parameter idx)
- (if (n.= id (adjusted_idx env idx))
- (wrap [])
- (//.fail (exception.construct ..wrong_parameter [(#.Parameter id) headT])))
-
- _
- (//.fail (exception.construct ..not_parameter headT)))))
-
-(def: #export existential
- (Parser Nat)
- (do //.monad
- [headT any]
- (case headT
- (#.Ex ex_id)
- (wrap ex_id)
-
- _
- (//.fail (exception.construct ..not_existential headT)))))
-
-(def: #export named
- (Parser [Name Type])
- (do //.monad
- [inputT any]
- (case inputT
- (#.Named name anonymousT)
- (wrap [name anonymousT])
-
- _
- (//.fail (exception.construct ..not_named inputT)))))
-
-(template: (|nothing|)
- (#.Named ["lux" "Nothing"]
- (#.UnivQ #.Nil
- (#.Parameter 1))))
-
-(def: #export (recursive poly)
- (All [a] (-> (Parser a) (Parser [Code a])))
- (do {! //.monad}
- [headT any]
- (case (type.un_name headT)
- (^ (#.Apply (|nothing|) (#.UnivQ _ headT')))
- (do !
- [[recT _ output] (|> poly
- (with_extension .Nothing)
- (with_extension headT)
- (local (list headT')))]
- (wrap [recT output]))
-
- _
- (//.fail (exception.construct ..not_recursive headT)))))
-
-(def: #export recursive_self
- (Parser Code)
- (do //.monad
- [env ..env
- headT any]
- (case (type.un_name headT)
- (^multi (^ (#.Apply (|nothing|) (#.Parameter funcT_idx)))
- (n.= 0 (adjusted_idx env funcT_idx))
- [(dictionary.get 0 env) (#.Some [self_type self_call])])
- (wrap self_call)
-
- _
- (//.fail (exception.construct ..not_recursive headT)))))
-
-(def: #export recursive_call
- (Parser Code)
- (do {! //.monad}
- [env ..env
- [funcT argsT] (..apply (//.and any (//.many any)))
- _ (local (list funcT) (..parameter! 0))
- allC (let [allT (list& funcT argsT)]
- (|> allT
- (monad.map ! (function.constant ..parameter))
- (local allT)))]
- (wrap (` ((~+ allC))))))
diff --git a/stdlib/source/lux/control/parser/xml.lux b/stdlib/source/lux/control/parser/xml.lux
deleted file mode 100644
index 9eb794c2d..000000000
--- a/stdlib/source/lux/control/parser/xml.lux
+++ /dev/null
@@ -1,141 +0,0 @@
-(.module:
- [lux #*
- [abstract
- [monad (#+ do)]]
- [control
- ["." try (#+ Try) ("#\." functor)]
- ["." exception (#+ exception:)]]
- [data
- ["." name ("#\." equivalence codec)]
- ["." text
- ["%" format (#+ format)]]
- [collection
- ["." list]
- ["." dictionary]]
- [format
- ["/" xml (#+ Attribute Attrs Tag XML)]]]]
- ["." //])
-
-(type: #export (Parser a)
- (//.Parser [Attrs (List XML)] a))
-
-(exception: #export empty_input)
-(exception: #export unexpected_input)
-
-(exception: #export (wrong_tag {expected Tag} {actual Tag})
- (exception.report
- ["Expected" (%.text (/.tag expected))]
- ["Actual" (%.text (/.tag actual))]))
-
-(exception: #export (unknown_attribute {expected Attribute} {available (List Attribute)})
- (exception.report
- ["Expected" (%.text (/.attribute expected))]
- ["Available" (exception.enumerate (|>> /.attribute %.text) available)]))
-
-(exception: #export (unconsumed_inputs {inputs (List XML)})
- (exception.report
- ["Inputs" (exception.enumerate (\ /.codec encode) inputs)]))
-
-(def: (run' parser attrs documents)
- (All [a] (-> (Parser a) Attrs (List XML) (Try a)))
- (case (//.run parser [attrs documents])
- (#try.Success [[attrs' remaining] output])
- (if (list.empty? remaining)
- (#try.Success output)
- (exception.throw ..unconsumed_inputs remaining))
-
- (#try.Failure error)
- (#try.Failure error)))
-
-(def: #export (run parser documents)
- (All [a] (-> (Parser a) (List XML) (Try a)))
- (..run' parser /.attributes documents))
-
-(def: #export text
- (Parser Text)
- (function (_ [attrs documents])
- (case documents
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons head tail)
- (case head
- (#/.Text value)
- (#try.Success [[attrs tail] value])
-
- (#/.Node _)
- (exception.throw ..unexpected_input [])))))
-
-(def: #export tag
- (Parser Tag)
- (function (_ [attrs documents])
- (case documents
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons head _)
- (case head
- (#/.Text _)
- (exception.throw ..unexpected_input [])
-
- (#/.Node tag _ _)
- (#try.Success [[attrs documents] tag])))))
-
-(def: #export (attribute name)
- (-> Attribute (Parser Text))
- (function (_ [attrs documents])
- (case (dictionary.get name attrs)
- #.None
- (exception.throw ..unknown_attribute [name (dictionary.keys attrs)])
-
- (#.Some value)
- (#try.Success [[attrs documents] value]))))
-
-(def: #export (node expected parser)
- (All [a] (-> Tag (Parser a) (Parser a)))
- (function (_ [attrs documents])
- (case documents
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons head tail)
- (case head
- (#/.Text _)
- (exception.throw ..unexpected_input [])
-
- (#/.Node actual attrs' children)
- (if (name\= expected actual)
- (|> children
- (..run' parser attrs')
- (try\map (|>> [[attrs tail]])))
- (exception.throw ..wrong_tag [expected actual]))))))
-
-(def: #export ignore
- (Parser Any)
- (function (_ [attrs documents])
- (case documents
- #.Nil
- (exception.throw ..empty_input [])
-
- (#.Cons head tail)
- (#try.Success [[attrs tail] []]))))
-
-(exception: #export nowhere)
-
-(def: #export (somewhere parser)
- (All [a] (-> (Parser a) (Parser a)))
- (function (recur [attrs input])
- (case (//.run parser [attrs input])
- (#try.Success [[attrs remaining] output])
- (#try.Success [[attrs remaining] output])
-
- (#try.Failure error)
- (case input
- #.Nil
- (exception.throw ..nowhere [])
-
- (#.Cons head tail)
- (do try.monad
- [[[attrs tail'] output] (recur [attrs tail])]
- (wrap [[attrs (#.Cons head tail')]
- output]))))))
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-03 17:24:10 +0000