From 9c21fd1f33eb52fb971d493ad21a67036d68b841 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 12 Jun 2022 02:29:28 -0400
Subject: Re-named the "poly" hierarchy to "polytypic".

---
 stdlib/source/parser/lux/data/text.lux             | 406 +++++++++++++++++++++
 .../lux/tool/compiler/language/lux/analysis.lux    | 133 +++++++
 2 files changed, 539 insertions(+)
 create mode 100644 stdlib/source/parser/lux/data/text.lux
 create mode 100644 stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux

(limited to 'stdlib/source/parser')

diff --git a/stdlib/source/parser/lux/data/text.lux b/stdlib/source/parser/lux/data/text.lux
new file mode 100644
index 000000000..e02733f77
--- /dev/null
+++ b/stdlib/source/parser/lux/data/text.lux
@@ -0,0 +1,406 @@
+(.using
+ [library
+  [lux (.except and not local)
+   [abstract
+    [monad (.only Monad do)]]
+   [control
+    ["//" parser]
+    ["[0]" maybe]
+    ["[0]" try (.only Try)]
+    ["[0]" exception (.only exception:)]]
+   [data
+    ["/" text (.only Char) (.open: "[1]#[0]" monoid)]
+    ["[0]" product]
+    [collection
+     ["[0]" list (.open: "[1]#[0]" mix)]]]
+   [macro
+    ["^" pattern]
+    ["[0]" code]
+    ["[0]" template]]
+   [math
+    [number
+     ["n" nat (.open: "[1]#[0]" decimal)]]]]])
+
+(type: .public Offset
+  Nat)
+
+(def: beginning
+  Offset
+  0)
+
+(exception: .public cannot_parse)
+(exception: .public cannot_slice)
+
+(type: .public Parser
+  (//.Parser [Offset Text]))
+
+(type: .public Slice
+  (Record
+   [#basis Offset
+    #distance Offset]))
+
+(def: .public (slice parser)
+  (-> (Parser Slice) (Parser Text))
+  (do //.monad
+    [[basis distance] parser]
+    (function (_ (^.let input [offset tape]))
+      (case (/.clip basis distance tape)
+        {.#Some output}
+        {try.#Success [input output]}
+
+        {.#None}
+        (exception.except ..cannot_slice [])))))
+
+(def: (left_over offset tape)
+  (-> Offset Text Text)
+  (|> tape (/.clip_since offset) maybe.trusted))
+
+(exception: .public (unconsumed_input [offset Offset
+                                       tape Text])
+  (exception.report
+   "Offset" (n#encoded offset)
+   "Input size" (n#encoded (/.size tape))
+   "Remaining input" (..left_over offset tape)))
+
+(exception: .public (expected_to_fail [offset Offset
+                                       tape Text])
+  (exception.report
+   "Offset" (n#encoded offset)
+   "Input" (..left_over offset tape)))
+
+(def: .public (result parser input)
+  (All (_ a) (-> (Parser a) Text (Try a)))
+  (case (parser [..beginning input])
+    {try.#Failure msg}
+    {try.#Failure msg}
+    
+    {try.#Success [[end_offset _] output]}
+    (if (n.= end_offset (/.size input))
+      {try.#Success output}
+      (exception.except ..unconsumed_input [end_offset input]))))
+
+(def: .public offset
+  (Parser Offset)
+  (function (_ (^.let input [offset tape]))
+    {try.#Success [input offset]}))
+
+(def: (with_slices parser)
+  (-> (Parser (List Slice)) (Parser Slice))
+  (do //.monad
+    [offset ..offset
+     slices parser]
+    (in (list#mix (function (_ [slice::basis slice::distance]
+                               [total::basis total::distance])
+                    [total::basis ("lux i64 +" slice::distance total::distance)])
+                  [#basis offset
+                   #distance 0]
+                  slices))))
+
+(def: .public any
+  (Parser Text)
+  (function (_ [offset tape])
+    (case (/.char offset tape)
+      {.#Some output}
+      {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]}
+
+      _
+      (exception.except ..cannot_parse []))))
+
+(def: .public any!
+  (Parser Slice)
+  (function (_ [offset tape])
+    (case (/.char offset tape)
+      {.#Some _}
+      {try.#Success [[("lux i64 +" 1 offset) tape]
+                     [#basis offset
+                      #distance 1]]}
+
+      _
+      (exception.except ..cannot_slice []))))
+
+(with_template [<name> <type> <any>]
+  [(`` (def: .public (<name> parser)
+         (All (_ a) (-> (Parser a) (Parser <type>)))
+         (function (_ input)
+           (case (parser input)
+             {try.#Failure msg}
+             (<any> input)
+             
+             _
+             (exception.except ..expected_to_fail input)))))]
+
+  [not  Text  ..any]
+  [not! Slice ..any!]
+  )
+
+(exception: .public (cannot_match [reference Text])
+  (exception.report
+   "Reference" (/.format reference)))
+
+(def: .public (this reference)
+  (-> Text (Parser Any))
+  (function (_ [offset tape])
+    (case (/.index_since offset reference tape)
+      {.#Some where}
+      (if (n.= offset where)
+        {try.#Success [[("lux i64 +" (/.size reference) offset) tape]
+                       []]}
+        (exception.except ..cannot_match [reference]))
+
+      _
+      (exception.except ..cannot_match [reference]))))
+
+(def: .public end
+  (Parser Any)
+  (function (_ (^.let input [offset tape]))
+    (if (n.= offset (/.size tape))
+      {try.#Success [input []]}
+      (exception.except ..unconsumed_input input))))
+
+(def: .public next
+  (Parser Text)
+  (function (_ (^.let input [offset tape]))
+    (case (/.char offset tape)
+      {.#Some output}
+      {try.#Success [input (/.of_char output)]}
+
+      _
+      (exception.except ..cannot_parse []))))
+
+(def: .public remaining
+  (Parser Text)
+  (function (_ (^.let input [offset tape]))
+    {try.#Success [input (..left_over offset tape)]}))
+
+(def: .public (range bottom top)
+  (-> Nat Nat (Parser Text))
+  (do //.monad
+    [char any
+     .let [char' (maybe.trusted (/.char 0 char))]
+     _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top))
+                     (.and (n.>= bottom char')
+                           (n.<= top char')))]
+    (in char)))
+
+(def: .public (range! bottom top)
+  (-> Nat Nat (Parser Slice))
+  (do //.monad
+    [it ..any!
+     char (..slice (in it))
+     .let [char' (maybe.trusted (/.char 0 char))]
+     _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top))
+                     (.and (n.>= bottom char')
+                           (n.<= top char')))]
+    (in it)))
+
+(with_template [<bottom> <top> <text> <slice>]
+  [(def: .public <text>
+     (Parser Text)
+     (..range (char <bottom>) (char <top>)))
+   
+   (def: .public <slice>
+     (Parser Slice)
+     (..range! (char <bottom>) (char <top>)))]
+
+  ["A" "Z" upper upper!]
+  ["a" "z" lower lower!]
+  ["0" "9" decimal decimal!]
+  ["0" "7" octal octal!]
+  )
+
+(def: .public alpha (Parser Text) (//.either ..lower ..upper))
+(def: .public alpha! (Parser Slice) (//.either ..lower! ..upper!))
+
+(def: .public alpha_num (Parser Text) (//.either ..alpha ..decimal))
+(def: .public alpha_num! (Parser Slice) (//.either ..alpha! ..decimal!))
+
+(def: .public hexadecimal
+  (Parser Text)
+  (all //.either
+       ..decimal
+       (..range (char "a") (char "f"))
+       (..range (char "A") (char "F"))))
+
+(def: .public hexadecimal!
+  (Parser Slice)
+  (all //.either
+       ..decimal!
+       (..range! (char "a") (char "f"))
+       (..range! (char "A") (char "F"))))
+
+(with_template [<name>]
+  [(exception: .public (<name> [options Text
+                                character Char])
+     (exception.report
+      "Options" (/.format options)
+      "Character" (/.format (/.of_char character))))]
+
+  [character_should_be]
+  [character_should_not_be]
+  )
+
+(with_template [<name> <modifier> <exception>]
+  [(def: .public (<name> options)
+     (-> Text (Parser Text))
+     (function (_ [offset tape])
+       (case (/.char offset tape)
+         {.#Some output}
+         (let [output' (/.of_char output)]
+           (if (<modifier> (/.contains? output' options))
+             {try.#Success [[("lux i64 +" 1 offset) tape] output']}
+             (exception.except <exception> [options output])))
+
+         _
+         (exception.except ..cannot_parse []))))]
+
+  [one_of  |>   ..character_should_be]
+  [none_of .not ..character_should_not_be]
+  )
+
+(with_template [<name> <modifier> <exception>]
+  [(def: .public (<name> options)
+     (-> Text (Parser Slice))
+     (function (_ [offset tape])
+       (case (/.char offset tape)
+         {.#Some output}
+         (let [output' (/.of_char output)]
+           (if (<modifier> (/.contains? output' options))
+             {try.#Success [[("lux i64 +" 1 offset) tape]
+                            [#basis offset
+                             #distance 1]]}
+             (exception.except <exception> [options output])))
+
+         _
+         (exception.except ..cannot_slice []))))]
+
+  [one_of!  |>   ..character_should_be]
+  [none_of! .not ..character_should_not_be]
+  )
+
+(exception: .public (character_does_not_satisfy_predicate [character Char])
+  (exception.report
+   "Character" (/.format (/.of_char character))))
+
+(def: .public (satisfies parser)
+  (-> (-> Char Bit) (Parser Text))
+  (function (_ [offset tape])
+    (case (/.char offset tape)
+      {.#Some output}
+      (if (parser output)
+        {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]}
+        (exception.except ..character_does_not_satisfy_predicate [output]))
+
+      _
+      (exception.except ..cannot_parse []))))
+
+(def: .public (satisfies! parser)
+  (-> (-> Char Bit) (Parser Slice))
+  (function (_ [offset tape])
+    (case (/.char offset tape)
+      {.#Some output}
+      (if (parser output)
+        {try.#Success [[("lux i64 +" 1 offset) tape]
+                       [#basis offset #distance 1]]}
+        (exception.except ..character_does_not_satisfy_predicate [output]))
+
+      _
+      (exception.except ..cannot_parse []))))
+
+(def: .public space
+  (Parser Text)
+  (..satisfies /.space?))
+
+(def: .public space!
+  (Parser Slice)
+  (..satisfies! /.space?))
+
+(def: .public (and left right)
+  (-> (Parser Text) (Parser Text) (Parser Text))
+  (do //.monad
+    [=left left
+     =right right]
+    (in (all /#composite =left =right))))
+
+(def: .public (and! left right)
+  (-> (Parser Slice) (Parser Slice) (Parser Slice))
+  (do //.monad
+    [(open "left[0]") left
+     (open "right[0]") right]
+    (in [left#basis ("lux i64 +" left#distance right#distance)])))
+
+(with_template [<name> <base> <doc_modifier>]
+  [(def: .public (<name> parser)
+     (-> (Parser Text) (Parser Text))
+     (|> parser <base> (at //.monad each /.together)))]
+
+  [some //.some "some"]
+  [many //.many "many"]
+  )
+
+(with_template [<name> <base> <doc_modifier>]
+  [(def: .public (<name> parser)
+     (-> (Parser Slice) (Parser Slice))
+     (with_slices (<base> parser)))]
+
+  [some! //.some "some"]
+  [many! //.many "many"]
+  )
+
+(with_template [<name> <base> <doc_modifier>]
+  [(def: .public (<name> amount parser)
+     (-> Nat (Parser Text) (Parser Text))
+     (|> parser
+         (<base> amount)
+         (at //.monad each /.together)))]
+
+  [exactly  //.exactly  "exactly"]
+  [at_most  //.at_most  "at most"]
+  [at_least //.at_least "at least"]
+  )
+
+(with_template [<name> <base> <doc_modifier>]
+  [(def: .public (<name> amount parser)
+     (-> 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: .public (between minimum additional parser)
+  (-> Nat Nat (Parser Text) (Parser Text))
+  (|> parser
+      (//.between minimum additional)
+      (at //.monad each /.together)))
+
+(def: .public (between! minimum additional parser)
+  (-> Nat Nat (Parser Slice) (Parser Slice))
+  (with_slices
+    (//.between minimum additional parser)))
+
+(def: .public (enclosed [start end] parser)
+  (All (_ a) (-> [Text Text] (Parser a) (Parser a)))
+  (|> parser
+      (//.before (this end))
+      (//.after (this start))))
+
+(def: .public (local local_input parser)
+  (All (_ a) (-> Text (Parser a) (Parser a)))
+  (function (_ real_input)
+    (case (..result parser local_input)
+      {try.#Failure error}
+      {try.#Failure error}
+
+      {try.#Success value}
+      {try.#Success [real_input value]})))
+
+(def: .public (then structured text)
+  (All (_ s a)
+    (-> (Parser a)
+        (//.Parser s Text)
+        (//.Parser s a)))
+  (do //.monad
+    [raw text]
+    (//.lifted (..result structured raw))))
diff --git a/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux
new file mode 100644
index 000000000..159c1c62e
--- /dev/null
+++ b/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux
@@ -0,0 +1,133 @@
+(.using
+ [library
+  [lux (.except nat int rev local)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["//" parser]
+    ["[0]" try (.only Try)]
+    ["[0]" exception (.only exception:)]]
+   [data
+    ["[0]" bit]
+    ["[0]" text (.only)
+     ["%" format (.only format)]]
+    [collection
+     ["[0]" list (.open: "[1]#[0]" functor)]]]
+   [macro
+    ["[0]" template]]
+   [math
+    [number
+     ["[0]" i64]
+     ["[0]" nat]
+     ["[0]" int]
+     ["[0]" rev]
+     ["[0]" frac]]]
+   [meta
+    ["[0]" symbol]]
+   [tool
+    [compiler
+     [arity (.only Arity)]
+     [reference (.only)
+      [variable (.only)]]]]]]
+ ["/" \\library (.only Environment Analysis)])
+
+(def: (remaining_inputs asts)
+  (-> (List Analysis) Text)
+  (format text.new_line "Remaining input: "
+          (|> asts
+              (list#each /.format)
+              (text.interposed " "))))
+
+(exception: .public (cannot_parse [input (List Analysis)])
+  (exception.report
+   "Input" (exception.listing /.format input)))
+
+(exception: .public (unconsumed_input [input (List Analysis)])
+  (exception.report
+   "Input" (exception.listing /.format input)))
+
+(type: .public Parser
+  (//.Parser (List Analysis)))
+
+(def: .public (result parser input)
+  (All (_ a) (-> (Parser a) (List Analysis) (Try a)))
+  (case (parser input)
+    {try.#Failure error}
+    {try.#Failure error}
+
+    {try.#Success [{.#End} value]}
+    {try.#Success value}
+    
+    {try.#Success [unconsumed _]}
+    (exception.except ..unconsumed_input unconsumed)))
+
+(def: .public any
+  (Parser Analysis)
+  (function (_ input)
+    (case input
+      {.#End}
+      (exception.except ..cannot_parse input)
+      
+      {.#Item [head tail]}
+      {try.#Success [tail head]})))
+
+(def: .public end
+  (Parser Any)
+  (function (_ tokens)
+    (case tokens
+      {.#End} {try.#Success [tokens []]}
+      _       {try.#Failure (format "Expected list of tokens to be empty!"
+                                    (remaining_inputs tokens))})))
+
+(def: .public end?
+  (Parser Bit)
+  (function (_ tokens)
+    {try.#Success [tokens (case tokens
+                            {.#End} true
+                            _       false)]}))
+
+(with_template [<query> <assertion> <tag> <type> <eq>]
+  [(`` (these (def: .public <query>
+                (Parser <type>)
+                (function (_ input)
+                  (case input
+                    (pattern (partial_list (<tag> x) input'))
+                    {try.#Success [input' x]}
+
+                    _
+                    (exception.except ..cannot_parse input))))
+
+              (def: .public (<assertion> expected)
+                (-> <type> (Parser Any))
+                (function (_ input)
+                  (case input
+                    (pattern (partial_list (<tag> actual) input'))
+                    (if (at <eq> = expected actual)
+                      {try.#Success [input' []]}
+                      (exception.except ..cannot_parse input))
+
+                    _
+                    (exception.except ..cannot_parse input))))))]
+
+  [bit this_bit /.bit Bit bit.equivalence]
+  [nat this_nat /.nat Nat nat.equivalence]
+  [int this_int /.int Int int.equivalence]
+  [rev this_rev /.rev Rev rev.equivalence]
+  [frac this_frac /.frac Frac frac.equivalence]
+  [text this_text /.text Text text.equivalence]
+  [local this_local /.local Nat nat.equivalence]
+  [foreign this_foreign /.foreign Nat nat.equivalence]
+  [constant this_constant /.constant Symbol symbol.equivalence]
+  )
+
+(def: .public (tuple parser)
+  (All (_ a) (-> (Parser a) (Parser a)))
+  (function (_ input)
+    (case input
+      (pattern (partial_list (/.tuple head) tail))
+      (do try.monad
+        [output (..result parser head)]
+        {try.#Success [tail output]})
+
+      _
+      (exception.except ..cannot_parse input))))
-- 
cgit v1.2.3