translate-local-variables := λ(: ctx FContext)(: delta I64). (: (
   (match ctx (
      ()
      ( FCtxEOF () )
      ( (FCtxBind( rst k kt f )) (
         (set rst (translate-local-variables( rst delta )))
         (match (fragment::get( f 'fragment-type_s )) (
            ()
            ( (SAtom 'LocalVariable_s) (
               (match (fragment::get( f 'expression_s )) (
                  ()
                  ( (SAtom previous-offset) (
                     (let p-offset (to-i64 previous-offset))
                     (let new-offset (+( p-offset delta )))
                     (set f (fragment::set( f 'expression_s (SAtom(to-string new-offset)) )))
                     (set ctx (FCtxBind( (close rst) k kt f )))
                  ))
               ))
            ))
            ( _ (set ctx (FCtxBind( (close rst) k kt f ))) )
         ))
      ))
   ))
   ctx
) FContext);

compile-expr := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used IsUsed). (: (
   (let e (fragment::new()))
   (match used (
      ()
      ( Return (
         (set e (compile-expr-direct( ctx term stack-offset Tail )))
         (let term-tt (typeof term))
         (set e (fragment-apply( ctx stack-offset 'cdecl::return_s
            (FLSeq( (close FLEOF) e ))
            (typeof term)
            term
         )))
      ))
      ( _ (
         (set e (compile-expr-direct( ctx term stack-offset used )))
      ))
   ))
   e
) Fragment);

compile-stack-call-push-args := λ(: ctx FContext)(: args AST)(: stack-offset I64). (: (
   (let r (compile-push-rvalue( ctx args stack-offset )))
   r
) Fragment);

compile-destructure-args := λ(: tt Type)(: ctx FContext)(: lhs AST)(: offset I64). (: (
   (match lhs (
      ()
      ( (App( rst (App( (Lit( ':_s _ )) (App( (Var( k _ )) (AType kt) )) )) )) (
         (match (slot( tt 'Cons_s )) (
            ()
            ( (TGround( 'Cons_s (LCons( p2 (LCons( rst-tt LEOF )) )) )) (
               (set ctx (compile-destructure-args( rst-tt ctx rst offset )))
               (let rst-sz (sizeof-aligned rst-tt))
               (let rst-offset (-( offset (as rst-sz I64) )))
               (set kt (and( (denormalize kt) (t1 'LocalVariable_s) )))
               (let sz (sizeof-aligned kt))
               (let new-offset (-( rst-offset (as sz I64) )))
               (set ctx (fragment-context::bind(
                  ctx k kt (fragment::local-variable( new-offset kt ))
               )))
            ))
         ))
      ))
      ( (App( (Lit( ':_s _ )) (App( (Var( k _ )) (AType kt) )) )) (
         (set kt (and( (denormalize kt) (t1 'LocalVariable_s) )))
         (let sz (sizeof-aligned kt))
         (let new-offset (-( offset (as sz I64) )))
         (set ctx (fragment-context::bind(
            ctx k kt (fragment::local-variable( new-offset kt ))
         )))
      ))
      ( _ () )
   ))
   ctx
) FContext);

as-branch-conditional := λ(: f Fragment)(: sloc AST). (: (
   (let ft (fragment::get-type f))
   (match (slot( ft 'BranchConditional_s )) (
      ()
      ( (TGround( 'BranchConditional_s _ )) () )
      ( _ (
         (set f (fragment-apply(
            (fragment::get-context f) (fragment::get-offset f) 'as-branch-conditional_s
            (FLSeq( (close FLEOF) f )) (t3( 'Arrow_s ft (t1 'BranchConditional_s) )) sloc
         )))
      ))
   ))
   f
) Fragment);

cstring-cache := (: SSEOF StringStringList);
compile-declare-cstring := λ(: val String). (: (
   (let cache cstring-cache)
   (let id '_s)
   (while (non-zero cache) (match cache (
      ()
      ( (SSSeq( rst k v )) (
         (if (==( k val )) (
            (set id v)
            (set cache SSEOF)
         ) (set cache rst))
      ))
   )))
   (if (head-string id) () (
      (set id (uuid()))
      (set assemble-data-section (SCons( (close assemble-data-section) (close(SAtom id)) )))
      (set assemble-data-section (SCons( (close assemble-data-section) (close(SAtom ':\n\t.ascii\s"_s)) )))
      (set assemble-data-section (SCons( (close assemble-data-section) (close(SAtom( escape-literal val ))) )))
      (set assemble-data-section (SCons( (close assemble-data-section) (close(SAtom '"\n\t.zero\s1\n_s)) )))
      (set cstring-cache (SSSeq(
         (close cstring-cache) val id
      )))
   ))
   (let r (fragment::new()))
   (set r (fragment::set( r 'expression_s (SAtom id) )))
   r
) Fragment);

compile-constructor := λ(: ctx FContext)(: tag-name String)(: return-type Type)(: args-type Type)(: args AST)(: offset I64). (: (
   (let whitespace-sz (-( (-( (sizeof-aligned return-type) (sizeof-aligned args-type) )) 8_u64 )))
   (let e (compile-push-rvalue( ctx args (-( offset (as whitespace-sz I64) )) 1_u64 )))
   (let constructor-parms (and(
      (t2( 'Constructor_s (t1 tag-name) ))
      (and(
         (t2( 'Sized_s (t1(to-string(sizeof-aligned return-type))) ))
         (t2( 'FieldsSized_s (t1(to-string(sizeof-aligned args-type))) ))
      ))
   )))
   (set e (fragment::set-type( e (denormalize constructor-parms) )))
   (let r (fragment-apply(
      ctx offset 'push_s
      (FLSeq( (close FLEOF) e )) (t3( 'Arrow_s constructor-parms return-type )) args
   )))
   (set r (fragment::set-context( r ctx )))
   (set r (fragment::set-type( r (denormalize return-type) )))
   (let new-offset (-( offset (as (sizeof-type return-type) I64) )))
   (set r (fragment::set-offset( r new-offset )))
   r
) Fragment);

compile-push-rvalue := λ(: ctx FContext)(: rval AST)(: offset I64). (: (
   (compile-push-rvalue( ctx rval offset 0_u64 ))
) Fragment);

compile-push-rvalue := λ(: ctx FContext)(: rval AST)(: offset I64)(: count U64). (: (
   (let r (fragment::new()))
   (match (slot( (typeof rval) 'Cons_s )) (
      ()
      ( (TGround( 'Cons_s (LCons( p2 (LCons( p1 LEOF )) )) )) (
         (match rval (
            ()
            ( (App( le re )) (
               (let e1 (compile-push-rvalue( ctx le offset count )))
               (if (!=( count 0_u64 )) (
                  (let re-tt (typeof re))
                  (if (non-zero(slot( re-tt 'Rc_s ))) (
                     (let inc-rc (Var( 'inc_s (token::new 'inc_s) )))
                     (set re-tt (guess-representation(without-representation re-tt)))
                     (ascript( inc-rc (t3( 'Arrow_s (typeof re) re-tt )) ))
                     (set re (App( (close inc-rc) (close re) )))
                     (ascript( re re-tt ))
                  ) ())
               ) ())
               (let e2 (compile-expr( ctx re (fragment::get-offset e1) Used )))
               (set e2 (compile-maybe-push-stack( ctx (fragment::get-offset e2) e2 p2 rval )))
               (let sz (sizeof-type(typeof rval)))
               (set e2 (fragment::set-offset( e2 (-( offset (as sz I64) )) )))
               (set r (fragment::chain( e1 e2 )))
            ))
         ))
      ))
      ( _ (
         (let sz (sizeof-type(typeof rval)))
         (if (==( sz 0_u64 )) (
            (set r (fragment::set-context( r ctx )))
            (set r (fragment::set-offset( r offset )))
            (set r (fragment::set( r 'program_s (SCons( (close SNil) (close SNil) )) )))
         ) (
            (if (!=( count 0_u64 )) (
               (let rval-tt (typeof rval))
               (if (non-zero(slot( rval-tt 'Rc_s ))) (
                  (let inc-rc (Var( 'inc_s (token::new 'inc_s) )))
                  (set rval-tt (guess-representation(without-representation rval-tt)))
                  (ascript( inc-rc (t3( 'Arrow_s (typeof rval) rval-tt )) ))
                  (set rval (App( (close inc-rc) (close rval) )))
                  (ascript( rval rval-tt ))
               ) ())
            ) ())
            (set r (compile-expr( ctx rval offset Used )))
            (set r (compile-maybe-push-stack( ctx (fragment::get-offset r) r (typeof rval) rval )))
            (set r (fragment::set-offset( r (-( offset (as sz I64) )) )))
         ))
      ))
   ))
   r
) Fragment);

compile-fragment-args := λ(: ctx FContext)(: function-args-type Type)(: rval AST)(: offset I64). (: (
   (let r FLEOF)
   (match (slot( (typeof rval) 'Cons_s )) (
      ()
      ( (TGround( 'Cons_s (LCons( p2 (LCons( p1 LEOF )) )) )) (
         (match rval (
            ()
            ( (App( le re )) (
               (let e1 (compile-fragment-args( ctx (cons-head function-args-type) le offset )))
               (if (non-zero(slot( (cons-head function-args-type) 'Meta_s 'OntoStack_s ))) (
                  (set offset (-( offset (as (sizeof-aligned(cons-head function-args-type)) I64) )))
               ) ())
               (if (non-zero(slot( (cons-tail(cons-head function-args-type)) 'Meta_s 'OntoStack_s ))) (
                  (set offset (-( offset (as (sizeof-aligned(cons-tail(cons-head function-args-type))) I64) )))
               ) ())
               (let e2 (compile-expr( ctx re offset Used )))
               (if (non-zero(fragment::get-type e2)) () (
                  (set e2 (fragment::set-type( e2 (denormalize p2) )))
               ))
               (set r (FLSeq( (close e1) e2 )))
            ))
         ))
      ))
      ( _ (
         (let e1 (compile-expr( ctx rval offset Used )))
         (if (non-zero(fragment::get-type e1)) () (
            (set e1 (fragment::set-type( e1 (typeof rval) )))
         ))
         (set r (FLSeq( (close FLEOF) e1 )))
      ))
   ))
   r
) FragmentList);

compile-maybe-push-stack := λ(: ctx FContext)(: offset I64)(: fragment Fragment)(: expression-type Type)(: sloc AST). (: (
   (let ft (fragment::get-type( fragment )))
   (if (non-zero ft) () (set ft expression-type))
   (match (slot( ft 'StackVariable_s )) (
      ()
      ( (TGround( 'StackVariable_s _ )) () )
      ( _ (
         (set fragment (fragment::set-type( fragment (denormalize ft) )))
         (set fragment (fragment-apply(
            ctx offset 'push_s
            (FLSeq( (close FLEOF) fragment ))
            (t3( 'Arrow_s ft
               (and( (t1 'StackVariable_s) (t2( 'Sized_s (t1(to-string(sizeof-aligned ft))) )) ))
            ))
            sloc
         )))
         (let f-sz (as (sizeof-aligned ft) I64))
         (set fragment (fragment::set-offset( fragment (-( offset f-sz )) )))
      ))
   ))
   fragment
) Fragment);

compile-global := λ(: ctx FContext)(: k String)(: term AST). (: (
   (let kt (typeof term))
   (match term (
      ()
      ( (Abs( lhs rhs tlt )) (if (is-open kt) () (
         (let args-type (domain kt))
         (let args-size (sizeof-aligned args-type))
         (set ctx (compile-destructure-args( args-type ctx lhs 0_i64 )))
         (set ctx (FCtxBind( (close ctx) 'cdecl::args-size_s TAny
            (fragment::expression(to-string args-size))
         )))
         (let stack-offset 0_i64)
         (set stack-offset (-( stack-offset 8_i64 )))
         (set stack-offset (-( stack-offset (as args-size I64) )))
         (let e (compile-expr( ctx rhs stack-offset Return )))
         (let text SNil)
         (if (==( k 'main_s )) (
            (set main-with True_u8)
            (match lhs (
               ()
               ( ASTNil () )
               ( _ (set main-with-argv True_u8) )
            ))
            (set text (SCons( (close text) (close(SAtom( 'main_s ))) )))
         ) (
            (set text (SCons( (close text) (close(SAtom( (mangle-identifier( k kt )) ))) )))
         ))
         (set text (SCons( (close text) (close(SAtom( ':\n_s ))) )))
         (let frame (fragment::get( e 'frame_s )))
         (set text (SCons( (close text) (close frame) )))
         (let program (fragment::get( e 'program_s )))
         (set text (SCons( (close text) (close program) )))
         (set text (SCons( (close text) (close(SAtom '\tmov\s%rbp,\s%rsp\n_s)) )))
         (set text (SCons( (close text) (close(SAtom '\tsub\s$_s)) )))
         (set text (SCons( (close text) (close(SAtom (to-string(+( args-size 8_u64 ))) )) )))
         (set text (SCons( (close text) (close(SAtom ',\s%rsp\n_s)) )))
         (set text (SCons( (close text) (close(SAtom '\tret\n_s)) )))
         (let text-etc (fragment::get( e 'text_s )))
         (set text (SCons( (close text) (close text-etc) )))
         (set assemble-text-section (SCons( (close assemble-text-section) (close text) )))
      )))
      ( (App( (Lit( ':_s _ )) (App( t (AType tt) )) )) (
         (let clean-tt (without-representation kt))
         (let mid (mangle-identifier( k clean-tt )))
         (set assemble-data-section (SCons(
            (close assemble-data-section)
            (close(SAtom mid))
         )))
         (set assemble-data-section (SCons(
            (close assemble-data-section)
            (close(SAtom ':\n.zero\s_s))
         )))
         (set assemble-data-section (SCons(
            (close assemble-data-section)
            (close(SAtom (to-string(sizeof-aligned kt))))
         )))
         (set assemble-data-section (SCons(
            (close assemble-data-section)
            (close(SAtom '\n_s))
         )))

         (let e1 (compile-expr( ctx term -8_i64 Used )))
         (set e1 (fragment::set-type( e1 (denormalize kt) )))
         (let e2 (fragment-context::lookup( ctx k kt term )))
         (let e3 (fragment-apply( ctx -8_i64 'mov_s
            (FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
            (t3( 'Arrow_s (t3( 'Cons_s (typeof t) (t1 'GlobalVariable_s) )) (t1 'Nil_s) ))
            term
         )))
         (set assemble-init-section (SCons(
            (close assemble-init-section)
            (close(fragment::get( e3 'program_s )))
         )))
      ))
   ))
) Nil);

compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used IsUsed). (: (
   (let e (fragment::new()))
   (set e (fragment::set-context( e ctx )))
   (set e (fragment::set-offset( e stack-offset )))
   (match term (
      ()
      ( ASTNil (
         (set e (fragment::set-type( e (denormalize(t1 'Nil_s)) )))
      ))
      ( ASTEOF () )
      ( (Var( id _ )) (
         (set e (fragment-context::lookup( ctx id (typeof term) term )))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-offset( e stack-offset )))
      ))
      ( (Lit( val _ )) (
         (let ltype (typeof term))
         (match (slot( ltype 'String_s )) (
            ()
            ( (TGround( 'String_s _ )) (
               (set e (compile-declare-cstring( val )))
            ))
            ( _ (
               (let isa-fragment False_u8)
               (match (slot( ltype 'Reg8_s )) (
                  ()
                  ( (TGround( 'Reg8_s _ )) (set isa-fragment True_u8) )
                  ( _ () )
               ))
               (match (slot( ltype 'Reg16_s )) (
                  ()
                  ( (TGround( 'Reg16_s _ )) (set isa-fragment True_u8) )
                  ( _ () )
               ))
               (match (slot( ltype 'Reg32_s )) (
                  ()
                  ( (TGround( 'Reg32_s _ )) (set isa-fragment True_u8) )
                  ( _ () )
               ))
               (match (slot( ltype 'Reg64_s )) (
                  ()
                  ( (TGround( 'Reg64_s _ )) (set isa-fragment True_u8) )
                  ( _ () )
               ))
               (if (==( isa-fragment True_u8 )) (
                  (set e (fragment::expression val))
               ) (
                  (if (non-zero(class-of-tag val)) (
                     (let tag-index (index-of-tag val))
                     (set e (fragment::expression(to-string tag-index)))
                     (set e (fragment::set( e 'program_s (SCons( (close SNil) (close SNil) )) )))
                  ) (
                     (match val (
                        ()
                        ( 'True_s (set e (fragment::expression '1_s)) )
                        ( 'False_s (set e (fragment::expression '0_s)) )
                        ( '\\t_s (set e (fragment::expression '9_s)) )
                        ( '\\n_s (set e (fragment::expression '10_s)) )
                        ( '\\s_s (set e (fragment::expression '32_s)) )
                        ( '\\o_s (set e (fragment::expression '35_s)) )
                        ( '\\`_s (set e (fragment::expression '39_s)) )
                        ( '\\[_s (set e (fragment::expression '40_s)) )
                        ( '\\]_s (set e (fragment::expression '41_s)) )
                        ( '\\:_s (set e (fragment::expression '59_s)) )
                        ( _ (set e (fragment::expression val)) )
                     ))
                  ))
               ))
            ))
         ))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-type( e (denormalize ltype) )))
      ))
      ( (App( (Lit( ':_s _ )) (App( t (AType tt) )) )) (
         (set e (compile-expr( ctx t stack-offset used )))
      ))
      ( (App( (Var( 'gensym-label_s _ )) (Var( id _ )) )) (
         (set ctx (fragment-context::bind(
            ctx id (t1 'Label_s) (fragment::label( (uuid()) ))
         )))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-type( e (denormalize(t1 'Nil_s)) )))
      ))
      ( (App( (Var( 'label_s _ )) (Var( id _ )) )) (
         (let l (fragment-context::lookup( ctx id (t1 'Label_s) term )))
         (let prog (SCons(
            (close(fragment::get( l 'expression_s )))
            (close(SAtom ':\n_s))
         )))
         (set e (fragment::set( e 'program_s prog )))
         (set e (fragment::set-type( e (denormalize(t1 'Nil_s)) )))
      ))
      ( (App( (Var( 'scope_s _ )) t )) (
         (set e (compile-expr( ctx t stack-offset Tail )))
         (set e (fragment::set-context( e ctx )))
      ))
      ( (App( (Var( 'open_s _ )) t )) (
         (set e (compile-expr( ctx t stack-offset Used )))
         (let tt (typeof t))
         (match (slot( tt 'Array_s )) (
            ()
            ( (TGround( 'Array_s (LCons( _ (LCons( TAny LEOF )) )) )) () )
            ( (TGround( 'Array_s (LCons( TAny (LCons( inner-tt LEOF )) )) )) (
               (let e1 (fragment::set-type( e (denormalize tt) )))
               (let e2 (fragment::new()))
               (set e2 (fragment::set( e2 'expression_s (SAtom '0_s) )))
               (let c-tt (and(
                  (t1 'Literal_s)
                  (t1 'Constant_s)
               )))
               (set e2 (fragment::set-type( e2 (denormalize c-tt) )))
               (set e (fragment-apply( ctx stack-offset 'push_s
                  (FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
                  (t3( 'Arrow_s (t3( 'Cons_s tt c-tt ))
                                (and( (t1 'StackVariable_s) (t2( 'Sized_s (t1(to-string(sizeof-aligned inner-tt))) )) ))
                  ))
                  term
               )))
               (set e (fragment::set-type( e (and( (denormalize inner-tt) (t1 'StackVariable_s) )) )))
               (let new-offset (-( stack-offset (as (sizeof-aligned inner-tt) I64) )))
               (set e (fragment::set-offset( e new-offset )))
            ))
            ( _ () )
         ))
      ))
      ( (App( (Var( 'sizeof_s _ )) (AType tt) )) (
         (let sz (sizeof-type( tt )))
         (set e (fragment::expression(to-string sz)))
         (let et (TAnd( 
            (close(t1 'Literal_s))
            (close(TAnd(
               (close(t1 'Constant_s))
               (close(TAnd(
                  (close(t1 'U64_s))
                  (close(t2( 'Sized_s (t1 '8_s) )))
               )))
            )))
         )))
         (set e (fragment::set-type( e et )))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-offset( e stack-offset )))
      ))
      ( (App( (Var( 'as_s _ )) (App( t (AType tt) )) )) (
         (set e (compile-expr( ctx t stack-offset used )))
         (set e (fragment::set-type( e (typeof term) )))
      ))
      ( (App( (App( (Var( 'set_s _ )) (Var( k _ )) )) rhs )) (
         (let kt (typeof rhs))

         (let e1 (compile-expr( ctx rhs stack-offset Used )))
         (set e1 (fragment::set-type( e1 kt )))
         (let e2 (fragment-context::lookup( ctx k kt term )))
         (set e (fragment-apply( ctx stack-offset 'mov_s
            (FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
            (t3( 'Arrow_s (t3( 'Cons_s (fragment::get-type e1) (fragment::get-type e2) )) (t1 'Nil_s) ))
            term
         )))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-offset( e stack-offset )))
      ))
      ( (App( (App( (Var( 'while_s _ )) cond )) body )) (
         (let e1 (compile-expr( ctx cond stack-offset Used )))
         (set e1 (as-branch-conditional( e1 cond )))
         (let e2 (compile-expr( (fragment::get-context e1) body (fragment::get-offset e1) Unused )))

         (let ectx (fragment::new()))
         (set ectx (fragment::set-type( ectx (t1( 'ImplicitContext_s )) )))

         (set e (fragment-apply( ctx stack-offset 'primitive::while_s
            (FLSeq( (close(FLSeq( (close(FLSeq( (close FLEOF) ectx ))) e1 ))) e2 )) (typeof term) term
         )))

         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-offset( e stack-offset )))
         (set e (fragment::set-type( e (typeof term) )))
      ))
      ( (App( (App( (App( (Var( 'if_s _ )) cond )) t )) f )) (
         (let rsp-offset (+( stack-offset -8_i64 )))
         (let e1 (as-branch-conditional(
            (compile-expr( ctx cond rsp-offset Used )) cond
         )))
         (let e2 (compile-expr( (fragment::get-context e1) t (fragment::get-offset e1) Tail )))
         (let end-offset (fragment::get-offset e2))
         (set e2 (compile-maybe-push-stack( (fragment::get-context e2) (fragment::get-offset e2) e2 (typeof term) term )))
         (set e2 (fragment::set-type( e2 (typeof t) )))
         (let e3 (compile-expr( (fragment::get-context e1) f (fragment::get-offset e1) Tail )))
         (set e3 (compile-maybe-push-stack( (fragment::get-context e3) (fragment::get-offset e3) e3 (typeof term) term )))
         (set e3 (fragment::set-type( e3 (typeof f) )))

         (let ectx (fragment::new()))
         (set ectx (fragment::set( ectx 'rsp-offset_s (SAtom(to-string rsp-offset)) ))) 
         (set ectx (fragment::set( ectx 'end-offset_s (SAtom(to-string end-offset)) ))) 
         (set ectx (fragment::set( ectx 'return-size_s (SAtom(to-string(sizeof-type(typeof term)))) ))) 
         (set ectx (fragment::set-type( ectx (t1( 'ImplicitContext_s )) )))

         (set e (fragment-apply( ctx stack-offset 'primitive::if_s
            (FLSeq( (close(FLSeq( (close(FLSeq( (close(FLSeq( (close FLEOF) ectx ))) e1 ))) e2 ))) e3 )) (typeof term) term
         )))

         (set e (fragment::set-context( e (fragment::get-context e2) )))
         (set e (fragment::set-offset( e end-offset )))
         (if (>( (sizeof-type(typeof term)) 8_u64 )) (
            (set e (fragment::set-type( e (and( (typeof term) (t1 'StackVariable_s) )) )))
         ) (
            (set e (fragment::set-type( e (typeof term) )))
         ))
      ))
      ( (App( (Abs( (Var( lhs _ )) ASTNil tlt )) rhs )) (
         (let rtype (typeof rhs))
         (set rtype (without-representation rtype))
         (set rtype (and( rtype (t1 'LocalVariable_s) )))
         (set rtype (with-size( rtype )))
         (let size (sizeof-aligned rtype))
         (set e (compile-push-rvalue( ctx rhs stack-offset )))
         (let bind-offset (-( stack-offset (as size I64) )))
         (let unframe-del SNil)
         (set ctx (fragment-context::bind(
            ctx lhs rtype (fragment::local-variable( bind-offset rtype ))
         )))
         (match term (
            ()
            ( (App( (Abs( lhs-var _ _ )) _ )) (
               (if (non-zero(fragment::get-type(fragment-context::lookup-soft( ctx 'del_s (typeof lhs-var) term )))) (
                  (let del-call (compile-stack-calls( ctx 'del_s rtype lhs-var stack-offset used )))
                  (set unframe-del (fragment::get( del-call 'program_s )))
               ) ())
            ))
         ))
         (set e (fragment::set( e 'del_s unframe-del )))
         (set e (fragment::set( e 'unframe_s
            (SCons(
               (close(fragment::get( e 'unframe_s )))
               (close(SCons(
                  (close(SAtom '\tadd\s$_s))
                  (close(SCons(
                     (close(SAtom(to-string size)))
                     (close(SAtom ',\s%rsp\n_s))
                  )))
               )))
            ))
         )))
         (set e (fragment::set-context( e ctx )))
         (set e (fragment::set-offset( e bind-offset )))
         (set e (fragment::set-type( e (typeof term) )))
      ))
      ( (App( f a )) (
         (match (slot( (typeof f) 'Arrow_s )) (
            ()
            ( (TGround( 'Arrow_s _ )) (
               (match f (
                  ()
                  ( (Var( fname _ )) (
                     (set e (compile-stack-calls( ctx fname (typeof term) a stack-offset used )))
                  ))
                  ( (App( (Lit( ':_s _ )) (App( (Var( fname _ )) (AType ft) )) )) (
                     (set e (compile-stack-calls( ctx fname (typeof term) a stack-offset used )))
                  ))
                  ( (Lit( fname _ )) (
                     (set e (compile-constructor( ctx fname (typeof term) (typeof a) a stack-offset )))
                  ))
                  ( (App( (Lit( ':_s _ )) (App( (Lit( fname _ )) (AType ft) )) )) (
                     (set e (compile-constructor( ctx fname (typeof term) (typeof a) a stack-offset )))
                  ))
               ))
            ))
            ( _ (
               (if (is( used Unused )) (scope(
                  (let e1 (compile-expr( ctx f stack-offset Unused )))
                  (let e2 (compile-expr( (fragment::get-context e1) a (fragment::get-offset e1) Unused )))
                  (set e (fragment::chain( e1 e2 )))
                  (set e (fragment::set-type( e (typeof term) )))
               )) (scope(
                  (let e1 (compile-expr( ctx f stack-offset Unused )))
                  (let e2 (compile-expr( (fragment::get-context e1) a (fragment::get-offset e1) Used )))
                  (set e (fragment::chain( e1 e2 )))
                  (set e (fragment::set-type( e (typeof term) )))
               )))
            ))
         ))
      ))
   ))
   e
) Fragment);

compile-stack-calls := λ(: ctx FContext)(: function-name String)(: return-type Type)(: args AST)(: offset I64)(: used IsUsed). (: (
   (let r (fragment::new()))
   (set r (fragment::set-context( r ctx )))
   (set r (fragment::set-offset( r offset )))
   (let fs (fragment-context::lookups( ctx function-name (typeof args) args )))
   (for-each (f in fs) (
      (set r (fragment::chain(
         r
         (compile-stack-call( ctx f function-name return-type args offset used ))
      )))
   ))
   r
) Fragment);

compile-stack-call := λ(: ctx FContext)(: f Fragment)(: function-name String)(: return-type Type)(: args AST)(: offset I64)(: used IsUsed). (: (
   (let function-type (fragment::get-type f))
   (let r (fragment::new()))

   (match (fragment::get( f 'fragment-type_s )) (
      ()
      ( (SAtom 'Fragment_s) (
         (let f-args (compile-fragment-args( ctx (domain function-type) args offset )))
         (set r (fragment-apply( ctx offset function-name f-args return-type args )))
         (set r (fragment::set-offset( r offset )))
         (set r (fragment::set-type( r (denormalize return-type) )))
      ))
      ( _ (
         (if (is( used Tail )) (set used Used) ())
         (if (is( used Call )) (set used Used) ())
         (let push-args (compile-stack-call-push-args( ctx args offset )))
         (set push-args (fragment::set-type( push-args (t1( 'FunctionArguments_s )) )))
         (let call SNil)
         (let function-id (mangle-identifier( function-name function-type )))
         (let return-size (sizeof-type return-type))

         (let ectx (fragment::new()))
         (set ectx (fragment::set( ectx 'function-id_s (SAtom function-id) )))
         (set ectx (fragment::set( ectx 'function-name_s (SAtom function-name) )))
         (set ectx (fragment::set( ectx 'function-type_s (SAtom(to-string(fragment::get-type f))) )))
         (set ectx (fragment::set( ectx 'function-id_s (SAtom function-id) )))
         (set ectx (fragment::set( ectx 'return-size_s (SAtom(to-string return-size)) )))
         (set ectx (fragment::set( ectx 'args-size_s (SAtom(to-string(sizeof-type(typeof args)))) )))
         (set ectx (fragment::set( ectx 'used_s (SAtom(to-string used)) )))
         (set ectx (fragment::set-type( ectx (t1( 'ImplicitContext_s )) )))

         (set r (fragment-apply( ctx offset 'cdecl::call_s
            (FLSeq( (close(FLSeq( (close FLEOF) ectx ))) push-args )) (typeof args) args
         )))

         (set r (fragment::set-offset( r offset )))
         (if (>( return-size 8_u64 )) (
            (if (is( used Used )) (
               (set r (fragment::set-offset( r (-( offset (as return-size I64) )) )))
            ) ())
         ) ())
         (set r (fragment::set-type( r (denormalize return-type) )))
      ))
   ))
   (set r (fragment::set-context( r ctx )))
   r
) Fragment);