

stack-call := λ ctx function-name function-args offset . (tail(
   (assert-typeof( 'stack-call::ctx ctx Context ))
   (assert-typeof( 'stack-call::function-name function-name Atom ))
   (assert-typeof( 'stack-call::offset offset Atom ))
   (local e1)
   (match (get-strict-function(ctx function-name (typecheck-lookup function-args))) (
      ()
      ( (GlobalFunction( body )) (tail(
         (local e-args)
         (set e-args (stack-call-destructure-args( ctx function-args offset 0 )))
         (assert-typeof( 'stack-call::e-args e-args StrictExpr ))
         (local e-call)
         (set e-call (expr::new()))
         (local copy-bytes)
         (local src-offset)
         (local copy-offset)
         (set src-offset (s2i 8)) # stack pointer is 64 bits
         (local copy-size)
         (set copy-size (s2i (expr::get-expr e-args)))
         (set copy-offset (inv( copy-size )))
         (while copy-size (tail(
            (set copy-bytes ( copy-bytes
               \t 'mov \s (i2s( src-offset )) \[ '%rbp \] , \s '%rax \n
               \t 'mov \s '%rax , \s (i2s( copy-offset )) \[ '%rbp \] \n
            ))
            (set copy-offset (add( (s2i '8) copy-offset )))
            (set src-offset (add( (s2i '8) src-offset )))
            (set copy-size (add( (s2i '-8) copy-size )))
         )))
         (local args-size)
         (set args-size (expr::get-expr e-args))
         (if (eq( args-size 0 )) () (
            (set args-size (max( '8 args-size )))
         ))
         (set e-call (expr::set-prog( e-call (
            \o \s 'call \s function-name \s ': \s (quote-s (typecheck-lookup function-args)) \n
            (expr::get-frame e-args)
            (expr::get-prog e-args)
            (enter-function())
            (if (eq( args-size 0 )) () (
               ( \t 'sub \s '$ args-size , \s '%rsp \n )
            ))
            copy-bytes
            (\t 'call \s (mangle-identifier( function-name (typecheck-lookup body) )) \n)
            (if (eq( args-size 0 )) () (
               ( \t 'add \s '$ args-size , \s '%rsp \n )
            ))
            (\t 'mov \s '%rbp, \s '%rsp              \n
             \t 'pop \s '%rbp                        \n)
            (expr::get-unframe e-args)
         ))))
         (set e-call (expr::set-expr( e-call (
            (match (typecheck-sizeof (typecheck-rvalue (typecheck-lookup body))) (
               ()
               ( 1 'al )
               ( 2 'ax )
               ( 4 'eax )
               ( 8 'rax )
            ))
         ))))
         (set e-call (expr::set-context( e-call ctx )))
         (set e-call (expr::set-offset( e-call offset )))
         e-call
      )))
      ( (Fragment( body )) (tail(
         (set e1 (expr::new()))
         (set e1 (expr::set-offset( e1 offset )))
         (set e1 (expr::set-context( e1 ctx )))
         (local args)
         (set args (stack-destructure-args( ctx function-args offset Fragment )))
         (fragment-apply-direct(
            (get-strict-function( ctx function-name (typecheck-lookup function-args) ))
            args e1 ()
         ))
      )))
      ( l (fail (UnknownFunctionCall function-name (typecheck-lookup function-args) l)) )
   ))
));

stack-call-destructure-args := λ ctx e-args offset args-size . (tail(
   (assert-typeof( 'stack-call-destructure-args::offset offset Atom ))
   (assert-typeof( 'stack-call-destructure-args::args-size args-size Atom ))  
   (match (typecheck-slot( (typecheck-lookup e-args) Cons )) (
      ()
      ( (Cons( lt rt )) (tail(
         (local e1)
         (local e2)
         (match e-args (
            ()
            ( (App( inner outer )) (tail(
               (set e1 (stack-call-push-arg( ctx outer offset args-size )))
               (set e2 (stack-call-destructure-args( (expr::get-context e1) inner (expr::get-offset e1) (expr::get-expr e1) )))
               (expr::chain( e1 e2 ))
            )))
            ( u (fail (InvalidArgs e-args)))
         ))
      )))
      ( tt (tail(
         ()
         (stack-call-push-arg( ctx e-args offset args-size ))
      )))
   ))
   # Returns StrictExpr:
   #    frame (Add Size of Local Variable)
   #    program (evaluate args)
   #    unframe (Sub Size of Local Variable)
   #    expr (size of arguments)
));

stack-call-push-arg := λ ctx e-arg offset args-size . (tail(
   (assert-typeof( 'stack-call-push-arg::offset offset Atom ))
   (assert-typeof( 'stack-call-push-arg::args-size args-size Atom ))
   (local e1)
   (local e2)
   (local et)
   (set et (typecheck-lookup e-arg))
   (local e-sz)
   (set e-sz (typecheck-sizeof et))
   (if (eq( e-sz '0 )) () (
      (set e-sz (max( 8 e-sz )))
   ))
   (set args-size (i2s(add( (s2i args-size) (s2i e-sz) ))) )
   (local new-offset)
   (set new-offset(  (i2s(add( (s2i offset) (inv(s2i( e-sz ))) ))) ))
   
   (local unframe)
   (if (eq( e-sz '0 )) () (
      (set unframe ( \t 'add \s '$ (max( '8 e-sz )) , \s '%rsp \n ))
   ))

   (set e1 (compile-expr-strict( ctx e-arg new-offset Used )))
   (set e1 (expr::set-type( e1 (typecheck-lookup e-arg))))

   (if (typecheck-has-representation( typecheck-lookup e-arg )) (
      (set e2 (fragment-apply(
         ctx 'push (typecheck-lookup e-arg)
         (() e1) e1
      )))
   ) (
      (set e2 e1)
   ))

   (set e2 (expr::set-unframe( e2 ((expr::get-unframe e2) unframe) )))
   (set e2 (expr::set-expr( e2 args-size )))
   (set e2 (expr::set-offset( e2 new-offset )))
   e2
));

stack-destructure-args := λ ctx function-args offset arg-mode . (tail(
   (assert-typeof( 'stack-destructure-args::arg-mode arg-mode Atom ))
   (match ( function-args (typecheck-slot( (typecheck-lookup function-args) Cons )) arg-mode ) (
      ()
      ( ( (App( fl fr )) (Cons( tl tr )) Fragment ) (tail(
         (local inner-e)
         (set inner-e (stack-destructure-args( ctx fl offset Fragment )))
         (local outer-e)
         (set outer-e (compile-expr-strict( ctx fr offset Used )))
         (set outer-e (expr::set-type( outer-e (typecheck-lookup fr))))
         (inner-e outer-e)
      )))
      ( ( fa tt Fragment ) (tail(
         (local outer-e)
         (set outer-e (compile-expr-strict( ctx fa offset Used )))
         (set outer-e (expr::set-type( outer-e (typecheck-lookup fa))))
         (() outer-e)
      )))
      ( u (fail ('stack-destructure-args u )))
   ))
));

stack-define := λ ctx fname lmb . (tail(
   (assert-typeof( 'stack-define::ctx ctx Context ))
   (match lmb (
      ()
      ( (Lambda( lhs rhs )) (tail(
         (local e1)
         (local e2)
         (local text)
         (set e1 (stack-define-destructure( ctx lhs () )))
         (local stack_offset)
         (set stack_offset (expr::get-offset e1))
         (set stack_offset (i2s(add( (s2i(stack_offset)) (s2i '-8) ))) )
         (set e2 (compile-expr-strict( (expr::get-context e1) rhs stack_offset Return)))
         (set text ( text (mangle-identifier( fname (typecheck-lookup lmb) )) ': \n ))
         (set text ( text (expr::get-frame e2) ))
         (set text ( text (expr::get-prog e2) ))
         (set text ( text (expr::get-unframe e2) ))
         (set text ( text (\t 'ret \n) ))
         (set text ( text (expr::get-text e2) ))
         (local return)
         (set return (expr::new()))
         (set return (expr::set-text( return text )))
         (set return (expr::set-data( return (expr::get-data e2) )))
         return
      )))
   ))
));

stack-define-destructure := λ ctx lhs offset . (match lhs (
   ()
   ( (App( (App( (Literal :) (Variable lname) )) ltype )) (tail(
      (set ltype (typecheck-infer-type-compound ltype) )
      (local size)
      (set size (typecheck-sizeof ltype))
      (set size (max( '8 size )))
      (local new_offset)
      (set new_offset (add( offset (inv(s2i size)) )) )
      (local return)
      (set ctx (context::bind( ctx lname
         (typecheck-ascript( (LocalVariable (i2s new_offset)) ltype ))
      )))
      (set return (expr::new()))
      (set return (expr::set-context( return ctx )))
      (set return (expr::set-offset( return (i2s new_offset) )))
      return
   )))
   ( (App( more (App( (App( (Literal :) (Variable lname) )) ltype )) )) (tail(
      (set ltype (typecheck-infer-type-compound ltype) )
      (local size)
      (set size (typecheck-sizeof ltype))
      (set size (max( '8 size )))
      (local new_offset)
      (set new_offset (add( offset (inv(s2i size)) )) )
      (local more-e)
      (set more-e (stack-define-destructure( ctx more new_offset )))
      (set ctx (context::bind( (expr::get-context more-e) lname
         (typecheck-ascript( (LocalVariable (i2s new_offset)) ltype ))
      )))
      (local return)
      (set return (expr::new()))
      (set return (expr::set-context( return ctx )))
      (set return (expr::set-offset( return (expr::get-offset more-e) )))
      return
   )))
   ( Nil (tail(
      (local return)
      (set return (expr::new()))
      (set return (expr::set-context( return ctx )))
      (set return (expr::set-offset( return offset )))
      return
   )))
   ( u (fail (UnknownStackArg lhs)))
));
