path: root/stdlib/source/lux/compiler/default/syntax.lux

## This is LuxC's parser.
## It takes the source code of a Lux file in raw text form and
## extracts the syntactic structure of the code from it.
## It only produces Lux Code nodes, and thus removes any white-space
## and comments while processing its inputs.

## Another important aspect of the parser is that it keeps track of
## its position within the input data.
## That is, the parser takes into account the line and column
## information in the input text (it doesn't really touch the
## file-name aspect of the cursor, leaving it intact in whatever
## base-line cursor it is given).

## This particular piece of functionality is not located in one
## function, but it is instead scattered throughout several parsers,
## since the logic for how to update the cursor varies, depending on
## what is being parsed, and the rules involved.

## You will notice that several parsers have a "where" parameter, that
## tells them the cursor position prior to the parser being run.
## They are supposed to produce some parsed output, alongside an
## updated cursor pointing to the end position, after the parser was run.

## Lux Code nodes/tokens are annotated with cursor meta-data
## (file-name, line, column) to keep track of their provenance and
## location, which is helpful for documentation and debugging.
(.module:
  [lux (#- nat int rev true false)
   [control
    monad
    ["p" parser ("parser/." Monad<Parser>)]
    ["ex" exception (#+ exception:)]]
   [data
    ["." error (#+ Error)]
    ["." number]
    ["." product]
    ["." maybe]
    ["." text
     ["l" lexer (#+ Offset Lexer)]
     format]
    [collection
     ["." list]
     ["." dictionary (#+ Dictionary)]]]
   ["." function]
   ["." io]
   [time
    ["." instant]
    ["." duration]]])

(type: #export Syntax
  (-> Cursor (Lexer [Cursor Code])))

(type: #export Aliases (Dictionary Text Text))
(def: #export no-aliases Aliases (dictionary.new text.Hash<Text>))

(def: #export prelude Text "lux")

(def: digits "0123456789")
(def: digits+ (format "_" ..digits))

(def: white-space " ")
## (def: new-line^ (l.this new-line))

(def: #export text-delimiter text.double-quote)
## (def: text-delimiter^ (l.this text-delimiter))

(def: #export open-form "(")
(def: #export close-form ")")

(def: #export open-tuple "[")
(def: #export close-tuple "]")

(def: #export open-record "{")
(def: #export close-record "}")

(def: escape "\\")

(def: #export sigil "#")

(def: #export digit-separator "_")

## (def: comment-marker (format ..sigil ..sigil))

## ## This is the parser for white-space.
## ## Whenever a new-line is encountered, the column gets reset to 0, and
## ## the line gets incremented.
## ## It operates recursively in order to produce the longest continuous
## ## chunk of white-space.
## (def: (space^ where)
##   (-> Cursor (Lexer Cursor))
##   (p.either (do p.Monad<Parser>
##               [content (l.many! (l.one-of! white-space))]
##               (wrap (update@ #.column (n/+ (get@ #l.distance content)) where)))
##             ## New-lines must be handled as a separate case to ensure line
##             ## information is handled properly.
##             (do p.Monad<Parser>
##               [content (l.many! (l.one-of! new-line))]
##               (wrap (|> where
##                         (update@ #.line (n/+ (get@ #l.distance content)))
##                         (set@ #.column 0))))))

## ## Single-line comments can start anywhere, but only go up to the
## ## next new-line.
## (def: (comment^ where)
##   (-> Cursor (Lexer Cursor))
##   (do p.Monad<Parser>
##     [_ (l.this ..comment-marker)
##      _ (l.some! (l.none-of! new-line))
##      _ ..new-line^]
##     (wrap (|> where
##               (update@ #.line inc)
##               (set@ #.column 0)))))

## ## To simplify parsing, I remove any left-padding that a Code token
## ## may have prior to parsing the token itself.
## ## Left-padding is assumed to be either white-space or a comment.
## ## The cursor gets updated, but the padding gets ignored.
## (def: (left-padding^ where)
##   (-> Cursor (Lexer Cursor))
##   ($_ p.either
##       (do p.Monad<Parser>
##         [where (comment^ where)]
##         (left-padding^ where))
##       (do p.Monad<Parser>
##         [where (space^ where)]
##         (left-padding^ where))
##       (:: p.Monad<Parser> wrap where)))

## Escaped character sequences follow the usual syntax of
## back-slash followed by a letter.
## Escaped characters may show up in Char and Text literals.
(def: escaped-char^
  (Lexer [Nat Text])
  (p.after (l.this ..escape)
           (do p.Monad<Parser>
             [code l.any]
             (case code
               ## Handle special cases.
               (^ (static ..escape)) (wrap [2 ..escape])

               _
               (p.fail (format "Invalid escaping syntax: " (%t code)))))))

## These are very simple parsers that just cut chunks of text in
## specific shapes and then use decoders already present in the
## standard library to actually produce the values from the literals.
(def: rich-digit
  (Lexer Text)
  (p.either l.decimal
            (p.after (l.this "_") (parser/wrap ""))))

(def: rich-digits^
  (Lexer Text)
  (l.and l.decimal
         (l.some rich-digit)))

(def: sign^ (l.one-of "+-"))

(do-template [<name> <tag> <lexer> <codec>]
  [(def: #export (<name> where)
     Syntax
     (do p.Monad<Parser>
       [chunk <lexer>]
       (case (:: <codec> decode chunk)
         (#.Left error)
         (p.fail error)

         (#.Right value)
         (wrap [(update@ #.column (n/+ (text.size chunk)) where)
                [where (<tag> value)]]))))]

  [int #.Int
   (l.and sign^ rich-digits^)
   number.Codec<Text,Int>]
  
  [rev #.Rev
   (l.and (l.one-of ".")
          rich-digits^)
   number.Codec<Text,Rev>]
  )

## (def: #export (nat where)
##   Syntax
##   (do p.Monad<Parser>
##     [chunk rich-digits^]
##     (case (:: number.Codec<Text,Nat> decode chunk)
##       (#.Left error)
##       (p.fail error)

##       (#.Right value)
##       (wrap [(update@ #.column (n/+ (text.size chunk)) where)
##              [where (#.Nat value)]]))))

(def: #export (frac where)
  Syntax
  (do p.Monad<Parser>
    [chunk ($_ l.and
               sign^
               rich-digits^
               (l.one-of ".")
               rich-digits^
               (p.default ""
                          ($_ l.and
                              (l.one-of "eE")
                              sign^
                              rich-digits^)))]
    (case (:: number.Codec<Text,Frac> decode chunk)
      (#.Left error)
      (p.fail error)

      (#.Right value)
      (wrap [(update@ #.column (n/+ (text.size chunk)) where)
             [where (#.Frac value)]]))))

## ## This parser looks so complex because text in Lux can be multi-line
## ## and there are rules regarding how this is handled.
## (def: #export (text where)
##   Syntax
##   (do p.Monad<Parser>
##     [## Lux text "is delimited by double-quotes", as usual in most
##      ## programming languages.
##      _ ..text-delimiter^
##      ## I must know what column the text body starts at (which is
##      ## always 1 column after the left-delimiting quote).
##      ## This is important because, when procesing subsequent lines,
##      ## they must all start at the same column, being left-padded with
##      ## as many spaces as necessary to be column-aligned.
##      ## This helps ensure that the formatting on the text in the
##      ## source-code matches the formatting of the Text value.
##      #let [offset ("lux i64 +" 1 (get@ #.column where))]
##      [where' text-read] (: (Lexer [Cursor Text])
##                            ## I must keep track of how much of the
##                            ## text body has been read, how far the
##                            ## cursor has progressed, and whether I'm
##                            ## processing a subsequent line, or just
##                            ## processing normal text body.
##                            (loop [text-read ""
##                                   where (|> where
##                                             (update@ #.column inc))
##                                   must-have-offset? #0]
##                              (p.either (if must-have-offset?
##                                          ## If I'm at the start of a
##                                          ## new line, I must ensure the
##                                          ## space-offset is at least
##                                          ## as great as the column of
##                                          ## the text's body's column,
##                                          ## to ensure they are aligned.
##                                          (do @
##                                            [_ (p.exactly offset (l.this ..white-space))]
##                                            (recur text-read
##                                                   (update@ #.column (n/+ offset) where)
##                                                   #0))
##                                          ($_ p.either
##                                              ## Normal text characters.
##                                              (do @
##                                                [normal (l.slice (l.many! (l.none-of! (format ..escape ..text-delimiter text.new-line))))]
##                                                (recur (format text-read normal)
##                                                       (update@ #.column (n/+ (text.size normal)) where)
##                                                       #0))
##                                              ## Must handle escaped
##                                              ## chars separately.
##                                              (do @
##                                                [[chars-consumed char] escaped-char^]
##                                                (recur (format text-read char)
##                                                       (update@ #.column (n/+ chars-consumed) where)
##                                                       #0))
##                                              ## The text ends when it
##                                              ## reaches the right-delimiter.
##                                              (do @
##                                                [_ ..text-delimiter^]
##                                                (wrap [(update@ #.column inc where)
##                                                       text-read]))))
##                                        ## If a new-line is
##                                        ## encountered, it gets
##                                        ## appended to the value and
##                                        ## the loop is alerted that the
##                                        ## next line must have an offset.
##                                        (do @
##                                          [_ ..new-line^]
##                                          (recur (format text-read new-line)
##                                                 (|> where
##                                                     (update@ #.line inc)
##                                                     (set@ #.column 0))
##                                                 #1)))))]
##     (wrap [where'
##            [where (#.Text text-read)]])))

(def: (composite open close element)
  (All [a]
    (-> Text Text
        (-> Cursor (Lexer [Cursor a]))
        (-> Cursor (Lexer [Cursor (List a)]))))
  (let [open^ (l.this open)
        close^ (l.this close)]
    (function (_ where)
      (do p.Monad<Parser>
        [_ open^]
        (loop [where (update@ #.column inc where)]
          (p.either (do @
                      [## Must update the cursor as I
                       ## go along, to keep things accurate.
                       [where' head] (element where)]
                      (parser/map (product.both id (|>> (#.Cons head)))
                                  (recur where')))
                    (do @
                      [## Must take into account any
                       ## padding present before the
                       ## end-delimiter.
                       ## where (left-padding^ where)
                       _ close^]
                      (wrap [(update@ #.column inc where)
                             #.Nil]))))))))

## (do-template [<name> <tag> <open> <close>]
##   [(def: (<name> ast where)
##      (-> Syntax Syntax)
##      (<| (parser/map (product.both id (|>> <tag> [where])))
##          (composite <open> <close> ast where)))]

##   [form  #.Form  ..open-form  ..close-form]
##   [tuple #.Tuple ..open-tuple ..close-tuple]
##   )

## Records are almost (syntactically) the same as forms and tuples,
## with the exception that their elements must come in pairs (as in
## key-value pairs).
## Semantically, though, records and tuples are just 2 different
## representations for the same thing (a tuple).
## In normal Lux syntax, the key position in the pair will be a tag
## Code node, however, record Code nodes allow any Code node to occupy
## this position, since it may be useful when processing Code syntax in
## macros.
(def: (record ast where)
  (-> Syntax Syntax)
  (<| (parser/map (product.both id (|>> #.Record [where])))
      (composite ..open-record ..close-record
                 (function (_ where')
                   (do p.Monad<Parser>
                     [[where' key] (ast where')
                      [where' val] (ast where')]
                     (wrap [where' [key val]])))
                 where)))

## The parts of an name are separated by a single mark.
## E.g. module.short.
## Only one such mark may be used in an name, since there
## can only be 2 parts to an name (the module [before the
## mark], and the short [after the mark]).
## There are also some extra rules regarding name syntax,
## encoded on the parser.
(def: name-separator ".")

## ## A Lux name is a pair of chunks of text, where the first-part
## ## refers to the module that gives context to the name, and the
## ## second part corresponds to the short of the name itself.
## ## The module part may be absent (by being the empty text ""), but the
## ## name part must always be present.
## ## The rules for which characters you may use are specified in terms
## ## of which characters you must avoid (to keep things as open-ended as
## ## possible).
## ## In particular, no white-space can be used, and neither can other
## ## characters which are already used by Lux as delimiters for other
## ## Code nodes (thereby reducing ambiguity while parsing).
## ## Additionally, the first character in an name's part cannot be
## ## a digit, to avoid confusion with regards to numbers.
## (def: name-part^
##   (Lexer Text)
##   (let [delimiters (format ..open-form ..close-form
##                            ..open-tuple ..close-tuple
##                            ..open-record ..close-record
##                            ..sigil
##                            ..text-delimiter
##                            ..name-separator)
##         space (format ..white-space text.new-line)
##         head (l.none-of! (format ..digits delimiters space))
##         tail (l.some! (l.none-of! (format delimiters space)))]
##     (l.slice (l.and! head tail))))

## (def: current-module-mark Text (format ..name-separator ..name-separator))

## (def: (name^ current-module aliases)
##   (-> Text Aliases (Lexer [Name Nat]))
##   ($_ p.either
##       ## When an name starts with 2 marks, its module is
##       ## taken to be the current-module being compiled at the moment.
##       ## This can be useful when mentioning names and tags
##       ## inside quoted/templated code in macros.
##       (do p.Monad<Parser>
##         [_ (l.this current-module-mark)
##          def-name name-part^]
##         (wrap [[current-module def-name]
##                ("lux i64 +" 2 (text.size def-name))]))
##       ## If the name is prefixed by the mark, but no module
##       ## part, the module is assumed to be "lux" (otherwise known as
##       ## the 'prelude').
##       ## This makes it easy to refer to definitions in that module,
##       ## since it is the most fundamental module in the entire
##       ## standard library.
##       (do p.Monad<Parser>
##         [_ (l.this name-separator)
##          def-name name-part^]
##         (wrap [["lux" def-name]
##                ("lux i64 +" 1 (text.size def-name))]))
##       ## Not all names must be specified with a module part.
##       ## If that part is not provided, the name will be created
##       ## with the empty "" text as the module.
##       ## During program analysis, such names tend to be treated
##       ## as if their context is the current-module, but this only
##       ## applies to names for tags and module definitions.
##       ## Function arguments and local-variables may not be referred-to
##       ## using names with module parts, so being able to specify
##       ## names with empty modules helps with those use-cases.
##       (do p.Monad<Parser>
##         [first-part name-part^]
##         (p.either (do @
##                     [_ (l.this name-separator)
##                      second-part name-part^]
##                     (wrap [[(|> aliases (dictionary.get first-part) (maybe.default first-part))
##                             second-part]
##                            ($_ "lux i64 +"
##                                (text.size first-part)
##                                1
##                                (text.size second-part))]))
##                   (wrap [["" first-part]
##                          (text.size first-part)])))))

## (do-template [<name> <pre> <tag> <length>]
##   [(def: #export (<name> current-module aliases)
##      (-> Text Aliases Syntax)
##      (function (_ where)
##        (do p.Monad<Parser>
##          [[value length] (<| <pre>
##                              (name^ current-module aliases))]
##          (wrap [(update@ #.column (n/+ <length>) where)
##                 [where (<tag> value)]]))))]

##   [tag        (p.after (l.this ..sigil)) #.Tag        ("lux i64 +" 1 length)]
##   [identifier (|>)                       #.Identifier length]
##   )

## (do-template [<name> <value>]
##   [(def: <name>
##      (Lexer Bit)
##      (parser/map (function.constant <value>) (l.this (%b <value>))))]

##   [false #0]
##   [true  #1]
##   )

## (def: #export (bit where)
##   Syntax
##   (do p.Monad<Parser>
##     [value (p.either ..false ..true)]
##     (wrap [(update@ #.column (n/+ 2) where)
##            [where (#.Bit value)]])))

(exception: #export (end-of-file {module Text})
  (ex.report ["Module" (%t module)]))

(exception: #export (unrecognized-input {[file line column] Cursor})
  (ex.report ["File" (%t file)]
             ["Line" (%n line)]
             ["Column" (%n column)]))

(exception: #export (text-cannot-contain-new-lines {text Text})
  (ex.report ["Text" (%t text)]))

(exception: #export (invalid-escape-syntax)
  "")

(def: (ast current-module aliases)
  (-> Text Aliases Syntax)
  (function (ast' where)
    (do p.Monad<Parser>
      [## where (left-padding^ where)
       ]
      ($_ p.either
          ## (..bit where)
          ## (..nat where)
          (..frac where)
          (..rev where)
          (..int where)
          ## (..text where)
          ## (..identifier current-module aliases where)
          ## (..tag current-module aliases where)
          ## (..form ast' where)
          ## (..tuple ast' where)
          (..record ast' where)
          (do @
            [end? l.end?]
            (if end?
              (p.fail (ex.construct end-of-file current-module))
              (p.fail (ex.construct unrecognized-input where))))
          ))))

(type: Tracker
  {#next-escape Offset})

(def: fresh-tracker
  Tracker
  {#next-escape 0})

(type: (Simple a)
  (-> Tracker Source (Error [Tracker Source a])))

(type: (Reader a)
  (-> Text Aliases (Simple a)))

(do-template [<name> <extension> <diff>]
  [(template: (<name> value)
     (<extension> value <diff>))]

  [!inc   "lux i64 +" 1]
  [!inc/2 "lux i64 +" 2]
  [!dec   "lux i64 -" 1]
  )

(do-template [<name> <close> <tag>]
  [(def: (<name> read-code tracker source)
     (-> (Simple Code) (Simple Code))
     (loop [tracker tracker
            source source
            stack (: (List Code) #.Nil)]
       (case (read-code tracker source)
         (#error.Success [tracker' source' top])
         (recur tracker' source' (#.Cons top stack))
         
         (#error.Error error)
         (let [[where offset source-code] source]
           (case ("lux text char" source-code offset)
             (#.Some char)
             (`` (case char
                   (^ (char (~~ (static <close>))))
                   (#error.Success [tracker
                                    [(update@ #.column inc where)
                                     (!inc offset)
                                     source-code]
                                    [where (<tag> (list.reverse stack))]])

                   _
                   (ex.throw unrecognized-input where)))
             
             _
             (#error.Error error))))))]

  ## Form and tuple syntax is mostly the same, differing only in the
  ## delimiters involved.
  ## They may have an arbitrary number of arbitrary Code nodes as elements.
  [read-form  ..close-form  #.Form]
  [read-tuple ..close-tuple #.Tuple]
  )

(template: (!clip from to text)
  ## TODO: Optimize-away "maybe.assume"
  (maybe.assume ("lux text clip" text from to)))

(template: (!i/< reference subject)
  ("lux int <" subject reference))

(do-template [<name> <extension>]
  [(template: (<name> param subject)
     (<extension> subject param))]

  [!n/+ "lux i64 +"]
  [!n/- "lux i64 -"]
  )

(with-expansions [<finish-text> ($_ "lux text concat" total output (!clip g!post-escape end source-code))]
  (template: (!find-next-escape diff current-escape end source-code total output)
    (let [g!post-escape (!n/+ diff current-escape)]
      (case ("lux text index" source-code (static ..escape) g!post-escape)
        ## More escaping work needs to be done
        (#.Some g!next-escape)
        (if (!i/< (:coerce Int end)
                  (:coerce Int g!next-escape))
          ## For the current text.
          (recur end g!next-escape ($_ "lux text concat" total output (!clip g!post-escape g!next-escape source-code)))
          ## For another text.
          (#error.Success [g!next-escape (!inc end) <finish-text>]))

        ## No more escaping... ever!
        _
        (#error.Success [("lux text size" source-code) (!inc end) <finish-text>])))))

(template: (!guarantee-no-new-lines content body)
  (case ("lux text index" content (static text.new-line) 0)
    (#.Some g!_)
    (ex.throw ..text-cannot-contain-new-lines content)

    g!_
    body))

(def: (read-escaped-text next-escape end offset source-code)
  (-> Offset Offset Offset Text (Error [Offset Offset Text]))
  (with-expansions [<escape-start> (!n/+ 1 next-escape)
                    <escape-end> (!n/+ 5 next-escape)]
    (loop [end end
           next-escape next-escape
           total (!clip offset next-escape source-code)]
      ## TODO: Optimize-away "maybe.assume"
      (`` (case (maybe.assume ("lux text char" source-code <escape-start>))
            (^template [<input> <output>]
              (^ (char <input>))
              (!find-next-escape 2 next-escape end source-code total <output>))
            ([(~~ (static ..escape)) (static ..escape)])

            _
            (ex.throw invalid-escape-syntax []))))))

(def: (read-text next-escape (^@ source [where offset source-code]))
  (Simple Code)
  (if (!i/< (:coerce Int offset)
            (:coerce Int next-escape))
    ## Must update next-escape.
    (case ("lux text index" source-code (static ..escape) offset)
      ## There is a escape further down the road.
      (#.Some next-escape')
      (read-text next-escape' source)

      ## There are no escapes left.
      _
      (read-text ("lux text size" source-code) source))
    (case ("lux text index" source-code (static ..text-delimiter) offset)
      (#.Some end)
      (if (!i/< (:coerce Int end)
                (:coerce Int next-escape))
        ## Must handle escape
        (case (read-escaped-text next-escape end offset source-code)
          (#error.Error error)
          (#error.Error error)

          (#error.Success [next-escape' offset' content])
          (<| (!guarantee-no-new-lines content)
              (#error.Success [next-escape'
                               [(update@ #.column (n/+ (!n/- offset offset')) where)
                                offset'
                                source-code]
                               [where
                                (#.Text content)]])))
        ## No escape to handle at the moment.
        (let [content (!clip offset end source-code)]
          (<| (!guarantee-no-new-lines content)
              (#error.Success [next-escape
                               [(update@ #.column (n/+ (!n/- offset end)) where)
                                (!inc end)
                                source-code]
                               [where
                                (#.Text content)]]))))
      
      _
      (ex.throw unrecognized-input where))))

(def: digit-bottom Nat (!dec (char "0")))
(def: digit-top Nat (!inc (char "9")))

(template: (!digit? char)
  (and (!i/< (:coerce Int char) (:coerce Int (static ..digit-bottom)))
       (!i/< (:coerce Int (static ..digit-top)) (:coerce Int char))))

(`` (template: (!digit?+ char)
      (or (!digit? char)
          ("lux i64 =" (.char (~~ (static ..digit-separator))) char))))

(`` (template: (!strict-name-char? char)
      (not (or ("lux i64 =" (.char (~~ (static ..white-space))) char)
               ("lux i64 =" (.char (~~ (static text.new-line))) char)

               ("lux i64 =" (.char (~~ (static ..name-separator))) char)

               ("lux i64 =" (.char (~~ (static ..open-form))) char)
               ("lux i64 =" (.char (~~ (static ..close-form))) char)

               ("lux i64 =" (.char (~~ (static ..open-tuple))) char)
               ("lux i64 =" (.char (~~ (static ..close-tuple))) char)

               ("lux i64 =" (.char (~~ (static ..open-record))) char)
               ("lux i64 =" (.char (~~ (static ..close-record))) char)

               ("lux i64 =" (.char (~~ (static ..text-delimiter))) char)
               ("lux i64 =" (.char (~~ (static ..sigil))) char)))))

(template: (!name-char?|head char)
  (and (!strict-name-char? char)
       (not (!digit? char))))

(template: (!name-char? char)
  (or (!strict-name-char? char)
      (!digit? char)))

(with-expansions [<output> (case (:: number.Codec<Text,Nat> decode (!clip start end source-code))
                             (#error.Success output)
                             (#error.Success [tracker
                                              [(update@ #.column (n/+ (!n/- start end)) where)
                                               end
                                               source-code]
                                              [where (#.Nat output)]])

                             (#error.Error error)
                             (#error.Error error))]
  (def: (read-nat start tracker [where offset source-code])
    (-> Offset (Simple Code))
    (loop [end offset]
      (case ("lux text char" source-code end)
        (#.Some char)
        (if (!digit?+ char)
          (recur (!inc end))
          <output>)
        
        _
        <output>))))

(with-expansions [<output> (#error.Success [[(update@ #.column (n/+ (!n/- start end)) where)
                                             end
                                             source-code]
                                            (!clip start end source-code)])]
  (def: (read-name-part start [where offset source-code])
    (-> Offset Source (Error [Source Text]))
    (loop [end offset]
      (case ("lux text char" source-code end)
        (#.Some char)
        (cond (!name-char? char)
              (recur (!inc end))

              ## else
              <output>)
        
        _
        <output>))))

(template: (!leap-bit value)
  ("lux i64 +" value 2))

(template: (!new-line where)
  (let [[where::file where::line where::column] where]
    [where::file (!inc where::line) 0]))

(with-expansions [<end> (ex.throw end-of-file current-module)
                  <failure> (ex.throw unrecognized-input where)
                  <consume-1> (as-is [where ("lux i64 +" offset 1) source-code])
                  <consume-2> (as-is [where ("lux i64 +" offset 2) source-code])
                  <consume-3> (as-is [where ("lux i64 +" offset 3) source-code])]

  (template: (!with-char @source-code @offset @char @body)
    (case ("lux text char" @source-code @offset)
      (#.Some @char)
      @body
      
      _
      <end>))

  (template: (!read-half-name @offset//pre @offset//post @char @module)
    (let [@offset//post (!inc @offset//pre)]
      (cond (!name-char?|head @char)
            (case (..read-name-part @offset//post [where @offset//post source-code])
              (#error.Success [source' name])
              (#error.Success [source' [@module name]])
              
              (#error.Error error)
              (#error.Error error))

            ## else
            <failure>)))

  (`` (def: (read-short-name current-module [where offset/0 source-code])
        (-> Text Source (Error [Source Name]))
        (<| (!with-char source-code offset/0 char/0)
            (case char/0
              (^ (char (~~ (static ..name-separator))))
              (let [offset/1 (!inc offset/0)]
                (<| (!with-char source-code offset/1 char/1)
                    (!read-half-name offset/1 offset/2 char/1 current-module)))

              _
              (!read-half-name offset/0 offset/1 char/0 ..prelude)))))

  (template: (!read-short-name @current-module @tracker @source @where @tag)
    (case (..read-short-name @current-module @source)
      (#error.Success [source' name])
      (#error.Success [@tracker source' [@where (@tag name)]])
      
      (#error.Error error)
      (#error.Error error)))

  (with-expansions [<simple> (as-is (#error.Success [source' ["" simple]]))]
    (`` (def: (read-full-name start source)
          (-> Offset Source (Error [Source Name]))
          (case (..read-name-part start source)
            (#error.Success [source' simple])
            (let [[where' offset' source-code'] source']
              (case ("lux text char" source-code' offset')
                (#.Some char/separator)
                (case char/separator
                  (^ (char (~~ (static ..name-separator))))
                  (let [offset'' (!inc offset')]
                    (case (..read-name-part offset'' [where' offset'' source-code'])
                      (#error.Success [source'' complex])
                      (#error.Success [source'' [simple complex]])
                      
                      (#error.Error error)
                      (#error.Error error)))

                  _
                  <simple>)
                
                _
                <simple>))
            
            (#error.Error error)
            (#error.Error error)))))

  (template: (!read-full-name @offset @tracker @source @where @tag)
    (case (..read-full-name @offset @source)
      (#error.Success [source' full-name])
      (#error.Success [@tracker source' [@where (@tag full-name)]])
      
      (#error.Error error)
      (#error.Error error)))
  
  (def: (read-code current-module aliases tracker source)
    (Reader Code)
    (let [read-code' (read-code current-module aliases)]
      (loop [tracker tracker
             [where offset source-code] source]
        (<| (!with-char source-code offset char/0)
            (`` (case char/0
                  ## White-space
                  (^template [<char> <direction>]
                    (^ (char <char>))
                    (recur tracker
                           [(update@ <direction> inc where)
                            (!inc offset)
                            source-code]))
                  ([(~~ (static ..white-space))     #.column]
                   [(~~ (static text.carriage-return)) #.column])

                  (^ (char (~~ (static text.new-line))))
                  (recur tracker [(!new-line where) (!inc offset) source-code])

                  ## Form
                  (^ (char (~~ (static ..open-form))))
                  (read-form read-code' tracker <consume-1>)

                  ## Tuple
                  (^ (char (~~ (static ..open-tuple))))
                  (read-tuple read-code' tracker <consume-1>)

                  ## Text
                  (^ (char (~~ (static ..text-delimiter))))
                  (read-text tracker <consume-1>)

                  ## Special code
                  (^ (char (~~ (static ..sigil))))
                  (let [offset' (!inc offset)]
                    (<| (!with-char source-code offset' char/1)
                        (case char/1
                          (^template [<char> <bit>]
                            (^ (char <char>))
                            (#error.Success [tracker
                                             [(update@ #.column (|>> !leap-bit) where)
                                              (!leap-bit offset)
                                              source-code]
                                             [where (#.Bit <bit>)]]))
                          (["0" #0]
                           ["1" #1])

                          ## Single-line comment
                          (^ (char (~~ (static ..sigil))))
                          (case ("lux text index" source-code (static text.new-line) offset')
                            (#.Some end)
                            (recur tracker [(!new-line where) (!inc end) source-code])
                            
                            _
                            <end>)

                          (^ (char (~~ (static ..name-separator))))
                          (!read-short-name current-module tracker <consume-2> where #.Identifier)

                          _
                          (cond (!name-char?|head char/1) ## Tag
                                (!read-full-name offset tracker <consume-2> where #.Tag)

                                ## else
                                <failure>))))

                  (^ (char (~~ (static ..name-separator))))
                  (!read-short-name current-module tracker <consume-1> where #.Identifier)

                  _
                  (cond (!digit? char/0) ## Natural number
                        (read-nat offset tracker <consume-1>)

                        ## Identifier
                        (!name-char?|head char/0)
                        (!read-full-name offset tracker <consume-1> where #.Identifier)
                        
                        ## else
                        <failure>))))))))

## [where offset source-code]
(def: #export (read current-module aliases source)
  (-> Text Aliases Source (Error [Source Code]))
  (case (read-code current-module aliases fresh-tracker source)
    (#error.Error error)
    (#error.Error error)

    (#error.Success [tracker' source' output])
    (#error.Success [source' output])))

## (def: #export (read current-module aliases source)
##   (-> Text Aliases Source (Error [Source Code]))
##   (case (p.run [offset source-code] (ast current-module aliases where))
##     (#error.Error error)
##     (#error.Error error)

##     (#error.Success [[offset' remaining] [where' output]])
##     (#error.Success [[where' offset' remaining] output])))