type ParsePartial (PME( AST , List<Token> )); # term, remainder
type SfxList SfxEOF | (SfxSeq( SfxList[] , String , Type )); zero SfxList SfxEOF;

parse-suffixes := (: SfxEOF SfxList);

parse-lambda := λ(: tokens List<Token>). (: (
   (let tt-ext TAny)
   (match tokens (
      ()
      ( (LCons( ':_t (LCons( tt-lit_t rr )) )) (
         (set tt-ext (parse-type tt-lit))
         (set tokens rr)
      ))
      ( _ () )
   ))
   (let expr ASTEOF)
   (let remainder (: LEOF List<Token>))
   (match (parse-one-expression tokens) (
      ()
      ( (PME( (Lit( '._s _ )) pr )) (match (parse-many-expressions pr) (
         ()
         ( (PME( le lr )) (
            (set expr (Abs( (close ASTNil) (close le) tt-ext )))
            (set tokens (: LEOF List<Token>))
            (set remainder lr)
         ))
      )))
      ( (PME( pe pr )) (
         (set expr pe)
         (set tokens pr)
      ))
   ))
   (while (non-zero tokens) (
      (match (parse-one-expression tokens) (
         ()
         ( (PME( (Lit( '._s _ )) r )) (
            (match (parse-many-expressions r) (
               ()
               ( (PME( le lr )) (
                  (set expr (Abs( (close expr) (close le) tt-ext )))
                  (set remainder lr)
                  (set tokens (: LEOF List<Token>))
               ))
            ))
         ))
         ( (PME( le LEOF )) (
            (parse-expect( 'Expected\sDot\sFor\sLambda\sBody\n_s tokens ))
         ))
         ( (PME( le lr )) (
            (set expr (App( (close expr) (close le) )))
            (set tokens lr)
         ))
      ))
   ))
   (let pp ( (PME( expr remainder )) ))
   pp
) ParsePartial);

parse-type-comma-sep := λ(: tt String). (: (
   (let buff SNil)
   (let depth 0_u64)
   (let base (: LEOF List<Type>))
   (while (head-string tt) (
      (match (head-string tt) (
         ()
         ( 60_u8 (set depth (+( depth 1_u64 )) ))
         ( 62_u8 (set depth (-( depth 1_u64 )) ))
         ( 91_u8 (set depth (+( depth 1_u64 )) ))
         ( 93_u8 (set depth (-( depth 1_u64 )) ))
         ( _ () )
      ))
      (if (==( depth 0_u64 )) (
         (if (==( (head-string tt) 44_u8 )) (
            (set base (cons(
               (parse-type(clone-rope buff))
               base
            )))
            (set buff SNil)
         ) (
            (set buff (SCons(
               (close buff)
               (close (SAtom (clone-rope (head-string tt))))
            )))
         ))
      ) (
         (set buff (SCons(
            (close buff)
            (close (SAtom (clone-rope (head-string tt))))
         )))
      ))
      (set tt (tail-string tt))
   ))
   (set base (cons(
      (parse-type(clone-rope buff))
      base
   )))
   base
) List<Type>);

parse-type := λ(: tt String). (: (
   (let is-vararg False_u8)
   (if (has-suffix( tt '..._s )) (
      (set tt (remove-suffix( tt '..._s )))
      (set is-vararg True_u8)
   ) ())
   (let depth 0_u64)
   (let buff SNil)
   (let base-type (t1 'Nil_s))
   (while (head-string tt) (
      (match (head-string tt) (
         ()
         ( 60_u8 (set depth (+( depth 1_u64 )) ))
         ( 62_u8 (set depth (-( depth 1_u64 )) ))
         ( 91_u8 (set depth (+( depth 1_u64 )) ))
         ( 93_u8 (set depth (-( depth 1_u64 )) ))
         ( _ () )
      ))
      (if (==( depth 0_u64 )) (
         (if (==( (head-string tt) 43_u8 )) (
            (match base-type (
               ()
               ( (TGround( 'Nil_s LEOF )) (
                  (let bt (parse-type-single (clone-rope buff)))
                  (set base-type bt)
               ))
               ( _ (
                  (set base-type (TAnd(
                     (close base-type)
                     (close(parse-type-single (clone-rope buff)))
                  )))
               ))
            ))
            (set buff SNil)
         ) (
            (set buff (SCons(
               (close buff)
               (close (SAtom (clone-rope (head-string tt))))
            )))
         ))
      ) (
         (set buff (SCons(
            (close buff)
            (close (SAtom (clone-rope (head-string tt))))
         )))
      ))
      (set tt (tail-string tt))
   ))
   (if (non-zero buff) (
      (match base-type (
         ()
         ( (TGround( 'Nil_s LEOF )) (
            (let bt (parse-type-single (clone-rope buff)))
            (set base-type bt)
         ))
         ( _ (
            (set base-type (TAnd(
               (close base-type)
               (close(parse-type-single (clone-rope buff)))
            )))
         ))
      ))
   ) ())
   (if (==( is-vararg True_u8 )) (
      (set base-type (TGround( '..._s (close(cons(
         base-type (: LEOF List<Type>)
      ))))))
   ) ())
   base-type
) Type);

parse-many-expressions := λ(: tokens List<Token>). (: (
   (let expr ASTEOF)
   (let remainder (: LEOF List<Token>))
   (while (non-zero tokens) (
      (match tokens (
         ()
         ( (LCons( '\:_t tl )) (
            (set remainder tokens)
            (set tokens (: LEOF List<Token>))
         ))
         ( (LCons( '\]_t tl )) (
            (if (non-zero expr) () (set expr ASTNil))
            (set remainder tl)
            (set tokens (: LEOF List<Token>))
         ))
         ( _ (
            (match (parse-one-expression tokens) (
               ()
               ( (PME( pe pr )) (
                  (if (non-zero expr) (
                     (set expr (App(
                        (close expr)
                        (close pe)
                     )))
                  ) (
                     (set expr pe)
                  ))
                  (set tokens pr)
               ))
            ))
         ))
      ))
   ))
   (let pp ( (PME( expr remainder )) ))
   pp
) ParsePartial);

parse-one-expression := λ(: tokens List<Token>). (: (
   (let expr ASTEOF)
   (let remainder (: LEOF List<Token>))
   (match tokens (
      ()
      ( LEOF (
         (set expr ASTNil)
         (set remainder (: LEOF List<Token>))
      ))
      ( (LCons( '\l_t r )) (
         (match (parse-lambda r) (
            ()
            ( (PME( le lr )) (
               (set expr le)
               (set remainder lr)
            ))
         ))
      ))
      ( (LCons( '\]_t r )) (
         (parse-unexpect( 'Unexpected\sClosing\sParentheses_s tokens ))
      ))
      ( (LCons( '\[_t r )) (
         (match (parse-many-expressions r) (
            ()
            ( (PME( me mr )) (
               (set expr me)
               (set remainder mr)
            ))
         ))
      ))
      ( (LCons( '\`_t
                (LCons( i r ))
        )) (
         (set expr (Lit( (key-of i) i )))
         (set remainder r)
      ))
      ( (LCons( a r )) (
         (if (is-variable (key-of a)) (
            (set expr (Var( (key-of a) a )))
         ) (
            (set expr (Lit( (key-of a) a )))
         ))
         (set remainder r)
      ))
   ))
   (let pp ( (PME( expr remainder )) ))
   pp
) ParsePartial);

parse-unexpect := λ(: msg String)(: tokens List<Token>). (: (
   (fail msg)
) Nil);
parse-expect := λ(: msg String)(: tokens List<Token>). (: (
   (eprint msg)
   (print '\n_s)
   (print tokens)
   (exit 1_u64)
) Nil);

parse-type-single := λ(: tt String). (: (
   (let depth 0_u64)
   (let mode 0_u8)
   (let buff SNil)
   (let base-type (t1 'Nil_s))
   (while (head-string tt) (
      (if (==( depth 0_u64 )) (
         (match (head-string tt) (
            ()
            ( 91_u8 (
               (set mode 91_u8)
               (set depth 1_u64)
               (if (non-zero buff) (
                  (let vn (clone-rope buff))
                  (if (==( vn '?_s )) (
                     (set base-type TAny)
                  ) (
                     (if (is-variable vn) (
                        (set base-type (TVar vn))
                     ) (
                        (set base-type (TGround(
                           (clone-rope buff)
                           (close(: LEOF List<Type>))
                        )))
                     ))
                  ))
               ) ())
               (set buff SNil)
            ))
            ( 60_u8 (
               (set mode 60_u8)
               (set depth 1_u64)
               (if (non-zero buff) (
                  (let vn (clone-rope buff))
                  (if (==( vn '?_s )) (
                     (set base-type TAny)
                  ) (
                     (if (is-variable vn) (
                        (set base-type (TVar vn))
                     ) (
                        (set base-type (TGround(
                           (clone-rope buff)
                           (close(: LEOF List<Type>))
                        )))
                     ))
                  ))
               ) ())
               (set buff SNil)
            ))
            ( c (
               (set buff (SCons(
                  (close buff)
                  (close (SAtom (clone-rope c)))
               )))
            ))
         ))
      ) (
         (match (head-string tt) (
            ()
            ( 60_u8 (set depth (+( depth 1_u64 )) ))
            ( 62_u8 (set depth (-( depth 1_u64 )) ))
            ( 91_u8 (set depth (+( depth 1_u64 )) ))
            ( 93_u8 (set depth (-( depth 1_u64 )) ))
            ( _ () )
         ))
         (if (==( depth 0_u64 )) (
            (match mode (
               ()
               ( 91_u8 (
                  (if (non-zero buff) (
                     (set base-type (t3(
                        'Array_s
                        base-type
                        (parse-type(clone-rope buff))
                     )))
                     (set buff SNil)
                  ) (
                     (set base-type (t3(
                        'Array_s
                        base-type
                        TAny
                     )))
                  ))
               ))
               ( 60_u8 (match base-type (
                  ()
                  ( (TGround( tag LEOF )) (
                     (set base-type (TGround(
                        tag
                        (close(parse-type-comma-sep(clone-rope buff)))
                     )))
                     (set buff SNil)
                  ))
                  ( (TVar( tag )) (
                     (set base-type (TGround(
                        tag
                        (close(parse-type-comma-sep(clone-rope buff)))
                     )))
                     (set buff SNil)
                  ))
                  ( _ (
                     (eprint 'Unexpected\sParameterized\sType:\s_s)
                     (print base-type)
                     (exit 1_u64)
                  ))
               )))
            ))
         ) (
            (set buff (SCons(
               (close buff)
               (close (SAtom (clone-rope (head-string tt))))
            )))
         ))
      ))
      (set tt (tail-string tt))
   ))
   (if (non-zero buff) (
      (let vn (clone-rope buff))
      (if (==( vn '?_s )) (
         (set base-type TAny)
      ) (
         (if (is-variable vn) (
            (set base-type (TVar vn))
         ) (
            (set base-type (TGround(
               (clone-rope buff)
               (close(: LEOF List<Type>))
            )))
         ))
      ))
   ) ())
   base-type
) Type);

take-one-expr := λ(: tokens List<Token>). (: (
   (let taken (: LEOF List<Token>))
   (let remainder (: LEOF List<Token>))
   (let depth 0_i64)
   (while (non-zero tokens) (match tokens (
      ()
      ( (LCons( '\:_t rem )) (
         (if (==( depth 0_i64 )) (
            (set remainder tokens)
            (set tokens (: LEOF List<Token>))
         ) (
            (set taken (cons( (head tokens) taken )))
            (set remainder rem)
            (set tokens rem)
         ))
      ))
      ( (LCons( hd rem )) (
         (match hd (
            ()
            ( '\[_t (set depth (+( depth 1_i64 ))) )
            ( '\]_t (set depth (-( depth 1_i64 ))) )
            ( _ () )
         ))
         (set taken (cons( hd taken )))
         (set remainder rem)
         (set tokens rem)
      ))
   )))
   (Tuple( (remove-parens(reverse taken)) remainder ))
) Tuple<List<Token>,List<Token>>);

remove-parens := λ(: tokens List<Token>). (: (
   (match tokens (
      ()
      ( (LCons( '\[_t rst )) (
         (let r (: LEOF List<Token>))
         (while (non-zero rst) (match rst (
            ()
            ( (LCons( '\]_t LEOF )) (
               (set rst (: LEOF List<Token>))
            ))
            ( (LCons( tk trst )) (
               (set r (cons( tk r )))
               (set rst trst)
            ))
         )))
         (set tokens (reverse r))
      ))
   ))
   tokens
) List<Token>);

parse-toplevel := λ(: tokens List<Token>). (: (
   (let program ASTEOF)
   (while (non-zero tokens) (
      (match tokens (
         ()
         ( (LCons( '\:_t remainder )) (
            (set tokens remainder)
         ))
         ( (LCons( 'macro_t remainder )) (
            (match (parse-one-expression remainder) (
               ()
               ( (PME( mlhs mremainder1 )) (
                  (match (take-one-expr mremainder1) (
                     ()
                     ( (Tuple( mrhs-tokens mremainder2 )) (
                        (let mrhs (parse-toplevel mrhs-tokens))
                        (match mrhs (
                           ()
                           ( (Seq( ASTEOF m-expr )) (
                              (set mrhs m-expr)
                           ))
                           ( _ () )
                        ))
                        (set preprocess-macros (MSeq(
                           (close preprocess-macros)
                           (Macro( (without-location mlhs) (without-location mrhs) ))
                        )))
                        (set tokens mremainder2)
                     ))
                  ))
               ))
            ))
         ))
         ( (LCons( 'meta_t remainder )) (
            (match (parse-many-expressions remainder) (
               ()
               ( (PME( m r1 )) (
                  (set program (Seq(
                     (close program)
                     (close (Meta( (close m) )))
                  )))
                  (set tokens r1)
               ))
            ))
         ))
         ( (LCons( 'fragment_t (LCons( 'type_t remainder )) )) (
            (match (parse-one-expression remainder) (
               ()
               ( (PME( e1 r1 )) (match (parse-many-expressions r1) (
                  ()
                  ( (PME( e2 r2 )) (
                     (set program (Seq(
                        (close program)
                        (close (Typedef(
                           (close e1)
                           (close e2)
                        )))
                     )))
                     (let base-type (type-of-s e1))
                     (index-tag-is-fragment(tag-of base-type))
                     (set tokens r2)
                  ))
               )))
            ))
         ))
         ( (LCons( 'fragment_t remainder-ext )) (
            (match remainder-ext (
               ()
               ( (LCons( key (LCons( ':=_t remainder )) )) (
                  (match (parse-many-expressions remainder) (
                     ()
                     ( (PME( re rr )) (
                        (set program (Seq(
                           (close program)
                           (close(Frg( key (close re) )))
                        )))
                        (set tokens rr)
                     ))
                  ))
               ))
            ))
         ))
         ( (LCons( 'type_t remainder )) (
            (match (parse-one-expression remainder) (
               ()
               ( (PME( e1 r1 )) (match (parse-many-expressions r1) (
                  ()
                  ( (PME( e2 r2 )) (
                     (set program (Seq(
                        (close program)
                        (close (Typedef(
                           (close e1)
                           (close e2)
                        )))
                     )))
                     (set tokens r2)
                  ))
               )))
            ))
         ))
         ( (LCons( 'atom_t (LCons( 'suffix_t
                   (LCons( atype_t (LCons( suffix_t remainder )) ))
           )) )) (
            (set parse-suffixes (SfxSeq(
               (close parse-suffixes)
               suffix
               (TAnd(
                  (close(TAnd(
                     (close(TGround( 'Constant_s (close(: LEOF List<Type>)) )))
                     (close(TGround( 'Literal_s (close(: LEOF List<Type>)) )))
                  )))
                  (close(parse-type atype))
               ))
            )))
            ()
            (set tokens remainder)
         ))
         ( (LCons( 'size_t (LCons( class_t (LCons( sz_t remainder )) )) )) (
            (index-size-of-class( class (to-u64 sz) ))
            (set tokens remainder)
         ))
         ( (LCons( 'import_t (LCons( relative-path_t remainder )) )) (
            (tokenize relative-path)
            (parse ())
            (set tokens remainder)
         ))
         ( (LCons( 'zero_t (LCons( base-type (LCons( tag-type_t remainder )) )) )) (
            (set program (Seq(
               (close program)
               (close (Glb( (with-key( base-type 'non-zero_s )) (close(Abs(
                  (close(App(
                     (close(Lit( ':_s (with-key( base-type ':_s )) )))
                     (close(App( (close(Var( 't_s (with-key( base-type 't_s )) ))) (close(AType(parse-type(key-of base-type)))) )))
                  )))
                  (close(App(
                     (close(Lit( ':_s (with-key( base-type ':_s )) )))
                     (close(App(
                        (close(App(
                           (close(Var( '!=_s (with-key( base-type '!=_s )) )))
                           (close(App(
                              (close(App(
                                 (close(Var( '.0_s (with-key( base-type '.0_s )) )))
                                 (close(Var( 't_s (with-key( base-type 't_s )) )))
                              )))
                              (close(App(
                                 (close(Var( '.0_s (with-key( base-type '.0_s )) )))
                                 (close(App(
                                    (close(Lit( ':_s (with-key( base-type ':_s )) )))
                                    (close(App(
                                       (close(Lit( tag-type (with-key( base-type tag-type)) )))
                                       (close(AType(parse-type(key-of base-type))))
                                    )))
                                 )))
                              )))
                           )))
                        )))
                        (close(AType(t1 'U64_s)))
                     )))
                  )))
                  TAny
               ))) )))
            )))
            (set tokens remainder)
         ))
         ( (LCons( key (LCons( ':=_t remainder )) )) (
            (match (parse-many-expressions remainder) (
               ()
               ( (PME( re rr )) (
                  (set program (Seq(
                     (close program)
                     (close (Glb( key (close re) )))
                  )))
                  (set tokens rr)
               ))
            ))
         ))
         (remainder (
            (match (parse-many-expressions remainder) (
               ()
               ( (PME( term r1 )) (
                  (set program (Seq(
                     (close program)
                     (close term)
                  )))
                  (set tokens r1)
               ))
            ))
         ))
      ))
   ))
   program
) AST);

parse := λ. (: (
   (let tokens ast-tokenized-program)
   (set ast-tokenized-program (: LEOF List<Token>))
   (let tl (parse-toplevel tokens))
   (set ast-parsed-program (+( ast-parsed-program tl )))
) Nil);