blob-expr := λ(: ctx FContext)(: term AST). (: (
   (let e (fragment::new()))
   (set e (fragment::set-context( e ctx )))
   (set e (fragment::set-type( e (typeof term) )))
   (match term (
      ()
      ( ASTNil () )
      ( ASTEOF () )
      ( (Meta _) () )
      ( (Var( id _ )) (
         (set e (fragment-context::lookup( ctx id (typeof term) term )))
      ))
      ( (Lit( val _ )) (
         (set e (fragment::set( e 'program_s (SAtom val) )))
      ))
      ( (App( (Lit( ':_s _ )) (App( t (AType tt) )) )) (
         (set e (blob-expr( ctx t )))
      ))
      ( (App( (Var( 'as_s _ )) (App( t (AType tt) )) )) (
         (set e (blob-expr( ctx t )))
         (set e (fragment::set-type( e (typeof term) )))
      ))
      ( (App( (Abs( (Var( lhs _ )) ASTNil tlt )) rhs )) (
         (let rtype (typeof rhs))
         (set ctx (fragment-context::bind(
            ctx lhs rtype (blob-expr( ctx rhs ))
         )))
         (set e (fragment::set-context( e ctx )))
      ))
      ( (App( f a )) (
         (match (slot( (typeof f) 'Arrow_s )) (
            ()
            ( (TGround( 'Arrow_s _ )) (
               (match f (
                  ()
                  ( (Var( fname _ )) (
                     (set e (blob-call( ctx fname a )))
                  ))
               ))
            ))
            ( _ (
               (let e1 (blob-expr( ctx f )))
               (let e2 (blob-expr( ctx a )))
               (set e (fragment::chain( e1 e2 )))
               (set e (fragment::set-type( e (typeof term) )))
            ))
         ))
      ))
   ))
   e
) Fragment);

blob-call := λ(: ctx FContext)(: function-name String)(: args AST). (: (
   (let f (fragment-context::lookup( ctx function-name (typeof args) args )))
   (let f-args (blob-args( ctx args )))
   (let r (fragment::new()))
   (match (fragment::get( f 'fragment-type_s )) (
      ()
      ( (SAtom 'Fragment_s) (
         (match (fragment::get-term f) (
            ()
            ( (Abs( lhs rhs _ )) (
               (let inner-ctx (blob-destructure( ctx lhs f-args )))
               (set r (fragment-apply( inner-ctx 0_i64 function-name f-args (range(fragment::get-type f)) args True_u8 )))
            ))
         ))
      ))
      ( (SAtom 'Function_s) (
         (match (fragment::get-term f) (
            ()
            ( (Abs( lhs rhs _ )) (
               (let inner-ctx (blob-destructure( ctx lhs f-args )))
               (set r (blob-expr( inner-ctx rhs )))
            ))
         ))
      ))
   ))
   (set r (fragment::set-context( r ctx )))
   r
) Fragment);

blob-bind-one := λ(: ctx FContext)(: k String)(: kt Type)(: arg Fragment). (: (
   (match kt (
      ()
      ( (TGround( '..._s (LCons( p1 LEOF )) )) (
         (if (can-unify( p1 (fragment::get-type arg) )) (
            (set ctx (fragment-context::bind-vararg(
               ctx k kt arg
            )))
         ) ())
      ))
      ( _ (
         (set ctx (fragment-context::bind(
            ctx k kt arg
         )))
      ))
   ))
   ctx
) FContext);

blob-destructure := λ(: ctx FContext)(: lhs AST)(: args FragmentList). (: (
   (match lhs (
      ()
      ( (App( lhs-rst (App( (Lit( ':_s _ )) (App( (Var( k _ )) (AType kt) )) )) )) (
         (match args (
            ()
            ( (FLSeq( args-rst args-f )) (
               (match kt (
                  ()
                  ( (TGround( '..._s _ )) (
                     (let m-ctx (blob-bind-one( ctx k kt args-f )))
                     (if (is( ctx m-ctx )) ( # rejected binding
                        (set ctx (blob-destructure( ctx lhs-rst args )))
                     ) ( # accepted binding
                        (set ctx (blob-destructure( m-ctx lhs args-rst )))
                     ))
                  ))
                  ( _ (
                     (set ctx (blob-bind-one( ctx k kt args-f )))
                     (set ctx (blob-destructure( ctx lhs-rst args-rst )))
                  ))
               ))
            ))
            ( _ () )
         ))
      ))
      ( (App( (Lit( ':_s _ )) (App( (Var( k _ )) (AType kt) )) )) (
         (match args (
            ()
            ( (FLSeq( args-rst args-f )) (
               (set ctx (blob-bind-one( ctx k kt args-f )))
               (set ctx (blob-destructure( ctx lhs args-rst )))
            ))
            ( _ () )
         ))
      ))
      ( _ () )
   ))
   ctx
) FContext);

blob-args := λ(: ctx FContext)(: rval AST). (: (
   (let r FLEOF)
   (match (slot( (typeof rval) 'Cons_s )) (
      ()
      ( (TGround( 'Cons_s (LCons( p2 (LCons( p1 LEOF )) )) )) (
         (match rval (
            ()
            ( (App( le re )) (
               (let e1 (blob-args( ctx le )))
               (let e2 (blob-expr( ctx re )))
               (set r (FLSeq( (close e1) e2 )))
            ))
         ))
      ))
      ( _ (
         (let e1 (blob-expr( ctx rval )))
         (set r (FLSeq( (close FLEOF) e1 )))
      ))
   ))
   r
) FragmentList);