
compile-push-rvalue := λctx e offset . (tail(
   (local e1)
   (local e2)
   (match (typecheck-slot( (typecheck-lookup e) Cons )) (
      ()
      ( (Cons( lt rt )) (
         (match e (
            ()
            ( (App( le re )) (tail(
               (set e1 (compile-push-rvalue( ctx le offset )))
               (set e2 (compile-push-rvalue( ctx re (expr::get-offset e1) )))
               (expr::chain( e1 e2 ))
            )))
            ( u (fail (UnexpectedRvalue e)))
         ))
      ))
      ( lt (tail(
         (set e1 (compile-expr-strict( ctx e offset Used )))
         (match (typecheck-slot( (expr::get-type e1) StackVariable )) (
            ()
            ( StackVariable e1 )
            ( _ (tail(
               ()
               (fragment-apply( ctx 'push lt (() e1) e1 ))
            )))
         ))
      )))
   ))
));

compile-expr-strict := λctx e offset used . (tail(
   (assert-typeof( 'compile-expr-strict::ctx ctx Context ))
   (assert-typeof( 'compile-expr-strict::e e Or<[Or<[Or<[App,Nil]>,Variable]>,Literal]> ))
   (assert-typeof( 'compile-expr-strict::offset offset Atom ))
   (assert-typeof( 'compile-expr-strict::used used Atom ))
   (local e1)
   (local e2)
   (local e3)
   (local e4)
   (local return)
   (match used (
      ()
      (Return (tail(
         (set e1 (compile-expr-strict( ctx e offset Used )))
         (match e (
            ()
            ( (App( (App( (Literal ':) re )) rtype )) (
               (fragment-apply( ctx 'cdecl::return (typecheck-lookup re) (() e1) e1 ))
            ))
            ( re (
               (fragment-apply( ctx 'cdecl::return (typecheck-lookup e) (() e1) e1 ))
            ))
         ))
      )))
      (_ (tail(
         (set return (match e (
            ()
            ( (App( (Lambda( (Variable lname) Nil )) rhs )) (tail(
               (local sz)
               (set sz (max( 8 (typecheck-sizeof (typecheck-lookup rhs)) )))
               (if sz () (
                  (fail (NoSizeOf (typecheck-lookup rhs)))
               ))
               (set e1 (compile-push-rvalue( ctx rhs offset )))
               (set offset (i2s (add( (s2i offset) (inv(s2i sz)) )) )) 
               (if (eq( sz '0 )) () (
                  (set e1 (expr::set-unframe( e1 (
                     \o \s 'unlet \s lname \s '= \s (quote-s rhs) \s ': \s (quote-s(typecheck-lookup rhs)) \n
                     (expr::get-unframe e1) \t 'add \s '$ sz , \s '%rsp \n
                  ))))
               ))
               (set ctx (context::bind( (expr::get-context e1) lname
                  (typecheck-ascript( (LocalVariable offset) (typecheck-lookup rhs) ))
               )))
               (set e1 (expr::set-context( e1 ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               (set e1 (expr::set-prog( e1 (
                  \o \s 'let \s lname \s '@ \s offset \n
                  \o \s 'let \s lname \s '= \s (quote-s rhs) \s ': \s (quote-s(typecheck-lookup rhs)) \n
                  (expr::get-prog e1)
               ))))
               e1
            )))
            ( (App( (Variable 'maybe-deref) r )) (tail(
               (local deref)
               (local new-size)
               (set new-size (typecheck-sizeof (typecheck-lookup r)))
               (match (typecheck-slot( (typecheck-lookup r) Array )) (
                  ()
                  ( (Array( x '? )) (
                     (if (typecheck-unify-implies( x '? )) () (tail(
                        (set deref True)
                        (set new-size (typecheck-sizeof x))
                     )))
                  ))
               ))
               (if deref (tail(
                  (set e1 (compile-expr-strict( ctx r offset Used )))
                  (set e1 (expr::set-type( e1 (typecheck-lookup r) )))
                  (set e2 (expr::new()))
                  (set e2 (expr::set-expr( e2 '0 )))
                  (set e3 (fragment-apply( ctx 'push (Cons( (typecheck-lookup r) (And( Constant Literal )) )) ((() e1) e2) e1 )))
                  (set e3 (expr::set-type( e3 StackVariable )))
                  (set offset (i2s(add( (s2i offset) (inv(s2i new-size)) ))))
                  (set e3 (expr::set-offset( e3 offset )))
                  (set e3 (expr::set-prog( e3 (
                     \o \s 'deref \s (quote-s r) \n
                     (expr::get-prog e3)
                  ))))
                  e3
               )) (
                  (compile-expr-strict( ctx r offset Used ))
               ))
            )))
            ( (App( (App( (Variable 'while) cond )) body )) (tail(
               (set e1 (compile-expr-strict( ctx cond offset Used )))
               (set e2 (compile-expr-strict( ctx body (expr::get-offset e1) Unused )))

               (match (expr::get-type e1) (
                  ()
                  (BranchConditional ())
                  ( et (tail(
                     (set e1 (expr::set-prog( e1 (
                        (expr::get-prog e1)
                        \t 'cmp \s '$0 , \s '%rax \n
                     ))))
                     (set e1 (expr::set-expr( e1 'jne )))
                  )))
               ))

               (set e3 (expr::chain( e1 e2 )))
               (local label-begin-loop)
               (set label-begin-loop (uuid()))
               (local label-do-loop)
               (set label-do-loop (uuid()))
               (local label-end-loop)
               (set label-end-loop (uuid()))
               (set e3 (expr::set-prog( e3 (
                  label-begin-loop ': \n
                  (expr::get-frame e1)
                  (expr::get-prog e1)
                  \t (expr::get-expr e1) \s label-do-loop \n
                  \t 'jmp \s label-end-loop \n
                  label-do-loop ': \n
                  (expr::get-frame e2)
                  (expr::get-prog e2)
                  (expr::get-unframe e2)
                  (expr::get-unframe e1)
                  \t 'jmp \s label-begin-loop \n
                  label-end-loop ': \n                  
                  (expr::get-unframe e1)
               ))))
               (set e3 (expr::set-frame( e3 () )))
               (set e3 (expr::set-unframe( e3 () )))
               (set e3 (expr::set-offset( e3 offset )))
               e3
            )))
            ( (App( (App( (App( (Variable 'if) cond )) t )) f )) (tail(
               (set e1 (compile-expr-strict( ctx cond offset Used )))
               (set e2 (compile-expr-strict( (expr::get-context e1) t (expr::get-offset e1) Used )))
               (set e3 (compile-expr-strict( (expr::get-context e1) f (expr::get-offset e1) Used )))
               (match (expr::get-type e1) (
                  ()
                  (BranchConditional ())
                  ( _ (tail(
                     (set e1 (expr::set-prog( e1 (
                        (expr::get-prog e1)
                        \t 'cmp \s '$0 , \s '%rax \n
                     ))))
                     (set e1 (expr::set-expr( e1 'jne )))
                  )))
               ))
               (set e4 e1)
               (local label-true-branch)
               (set label-true-branch (uuid()))
               (local label-false-branch)
               (set label-false-branch (uuid()))
               (local label-end)
               (set label-end (uuid()))
               (set e4 (expr::set-prog( e4 (
                  (expr::get-frame e1)
                  (expr::get-prog e1)
                  \t (expr::get-expr e1) \s label-true-branch \n
                  (expr::get-frame e3)
                  (expr::get-prog e3)
                  (expr::get-unframe e3)
                  \t 'jmp \s label-end \n
                  label-true-branch ': \n
                  (expr::get-frame e2)
                  (expr::get-prog e2)
                  (expr::get-unframe e2)
                  label-end ': \n
                  (expr::get-unframe e1)
               ))))
               (set e4 (expr::set-context( e4 ctx )))
               (set e4 (expr::set-offset( e4 offset )))
               (set e4 (expr::set-frame( e4 () )))
               (set e4 (expr::set-unframe( e4 () )))
               e4
            )))
            ( (App( (Variable 'label) (Variable label-name) )) (
               (match (get-strict-function( ctx label-name Label )) (
                  ()
                  ( (Label( lid )) (tail(
                     (set e2 (expr::new()))
                     (set e2 (expr::set-prog( e2 ( lid ': \n ) )))
                     (set e2 (expr::set-context( e2 ctx )))
                     (set e2 (expr::set-offset( e2 offset )))
                     e2
                  )))
                  ( u (ExpectedLabel u))
               ))
            ))
            ( (App( (App( (Variable 'set) lhs )) rhs )) (tail(
               (assert-eq( 'compile-expr-strict::set (head lhs) Variable ))
               (match (get-strict-function( ctx (tail lhs) (typecheck-lookup rhs))) (
                  ()
                  ( (LocalVariable( sv-offset )) (tail(
                     (set e1 (compile-expr-strict( ctx rhs offset Used )))
                     (set e1 (expr::set-type( e1 (typecheck-lookup rhs) )))
                     (set e2 (expr::new()))
                     (set e2 (expr::set-expr( e2 sv-offset )))
                     (set e2 (expr::set-context( e2 ctx )))
                     (set e2 (expr::set-offset( e2 offset )))
                     (set e2 (expr::set-type( e2 (typecheck-lookup lhs) )))
                     (set e3 (fragment-apply( ctx 'mov (Cons( (typecheck-lookup rhs) LocalVariable )) ((() e1) e2) e2 )))
                  )))
                  ( (GlobalVariable( uid )) (tail(
                     (set e1 (compile-expr-strict( ctx rhs offset Used )))
                     (set e1 (expr::set-type( e1 (typecheck-lookup rhs) )))
                     (set e2 (expr::new()))
                     (set e2 (expr::set-expr( e2 uid )))
                     (set e2 (expr::set-context( e2 ctx )))
                     (set e2 (expr::set-offset( e2 offset )))
                     (set e2 (expr::set-type( e2 (typecheck-lookup lhs) )))
                     (set e3 (fragment-apply( ctx 'mov (Cons( (typecheck-lookup rhs) GlobalVariable )) ((() e1) e2) e2 )))
                  )))
                  ( u (fail( UnexpectedAssignmentLhs lhs u )))
               ))
               e3
            )))
            ( (App( (App( (Literal :) (Literal lval) )) ltype )) (tail(
               (set ltype (typecheck-infer-type-compound ltype))
               (if (typecheck-unify-args( String ltype )) (tail(
                  (local uid)
                  (set uid (strict-declare-cstring( lval )))
                  (set e1 (expr::set-expr( (expr::new ()) uid )))
               )) (
                  (match lval (
                     ()
                     (True (set e1 (expr::set-expr( (expr::new ()) '1 ))))
                     (False (set e1 (expr::set-expr( (expr::new ()) '0 ))))
                     ('\\t (set e1 (expr::set-expr( (expr::new ()) '9 ))))
                     ('\\n (set e1 (expr::set-expr( (expr::new ()) '10 ))))
                     ('\\s (set e1 (expr::set-expr( (expr::new ()) '32 ))))
                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
                     ('\\` (set e1 (expr::set-expr( (expr::new ()) '39 ))))
                     ('\\[ (set e1 (expr::set-expr( (expr::new ()) '40 ))))
                     ('\\] (set e1 (expr::set-expr( (expr::new ()) '41 ))))
                     ('\\: (set e1 (expr::set-expr( (expr::new ()) '59 ))))
                     (_ (set e1 (expr::set-expr( (expr::new ()) lval ))))
                  ))
               ))
               (set e1 (expr::set-context( e1 ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               e1
            )))
            ( (App( (Variable 'sizeof) (Literal ltype) )) (tail(
               (set ltype (parse-type ltype))
               (set e1 (expr::set-expr( (expr::new ()) (typecheck-sizeof ltype) )))
               (set e1 (expr::set-context( e1 ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               (set e1 (expr::set-type( e1 ltype )))
               e1
            )))
            ( (Literal lval) (tail(
               (if (typecheck-unify-args( String (typecheck-lookup e) )) (tail(
                  (local uid)
                  (set uid (strict-declare-cstring( lval )))
                  (set e1 (expr::set-expr( (expr::new ()) uid )))
               )) (
                  (match lval (
                     ()
                     (True (set e1 (expr::set-expr( (expr::new ()) '1 ))))
                     (False (set e1 (expr::set-expr( (expr::new ()) '0 ))))
                     ('\\t (set e1 (expr::set-expr( (expr::new ()) '9 ))))
                     ('\\n (set e1 (expr::set-expr( (expr::new ()) '10 ))))
                     ('\\s (set e1 (expr::set-expr( (expr::new ()) '32 ))))
                     ('\\o (set e1 (expr::set-expr( (expr::new ()) '35 ))))
                     ('\\` (set e1 (expr::set-expr( (expr::new ()) '39 ))))
                     ('\\[ (set e1 (expr::set-expr( (expr::new ()) '40 ))))
                     ('\\] (set e1 (expr::set-expr( (expr::new ()) '41 ))))
                     ('\\: (set e1 (expr::set-expr( (expr::new ()) '59 ))))
                     (_ (set e1 (expr::set-expr( (expr::new ()) lval ))))
                  ))
               ))
               (set e1 (expr::set-context( e1 ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               e1
            )))
            ( (App( (App( (Literal ':) lval )) ltype )) (tail(
               (set e1 (compile-expr-strict( ctx lval offset Used )))
               (set e1 (expr::set-type( e1 (typecheck-lookup e) )))
               e1
            )))
            ( (App( (App( (Variable 'as) lval )) ltype )) (tail(
               (set e1 (compile-expr-strict( ctx lval offset Used )))
               (set e1 (expr::set-type( e1 (typecheck-lookup e) )))
               e1
            )))
            ( (App( (Variable 'tail) (App( l r )) )) (tail(
               (set e1 (compile-expr-strict( ctx l offset Unused )))
               (set e2 (compile-expr-strict( (expr::get-context e1) r (expr::get-offset e1) Used )))
               (set e2 (expr::set-frame( e2 (  (expr::get-frame e1) (expr::get-frame e2)  ))))
               (set e2 (expr::set-unframe( e2 (  (expr::get-unframe e1) (expr::get-unframe e2)  ))))
               (set e2 (expr::set-text( e2 (  (expr::get-text e1) (expr::get-text e2)  ))))
               (set e2 (expr::set-data( e2 (  (expr::get-data e1) (expr::get-data e2)  ))))
               (set e2 (expr::set-prog( e2 (  (expr::get-prog e1) (expr::get-prog e2)  ))))
               e2
            )))
            ( (App ((Variable 'gensym-label) (Variable arg))) (tail(
               (set ctx (context::bind( ctx arg
                  (typecheck-ascript( (Label( (uuid()) )) Label ))
               )))
               (set e1 (expr::set-context( (expr::new()) ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               e1
            )))
            ( Nil (tail(
               (set e1 (expr::new()) )
               (set e1 (expr::set-context( e1 ctx )))
               (set e1 (expr::set-offset( e1 offset )))
               e1
            )))
            ( (Variable v) (tail(
               (set e1 (fragment-get-local( ctx v offset )))
               (set e1 (expr::set-type( e1 (typecheck-lookup e) )))
               e1
            )))
            ( (App (l r)) (tail(
               (local result)
               (set result (match (typecheck-slot( (typecheck-lookup l) '-> )) (
                  ()
                  ( ('-> _) (match l (
                     ()
                     ( (Variable fname) (tail(
                        (set e1 (stack-call( ctx fname r offset )))
                        (set e1 (expr::set-type( e1 (typecheck-lookup e) )))
                        e1
                     )))
                     ( (Literal tag) (tail(
                        (set e1 (compile-push-rvalue( ctx r offset )))
                        (set e2 (fragment-apply( ctx 'push (And( (typecheck-lookup e) DontChain)) (() e1) e1 )))
                        (local sz)
                        (set sz (typecheck-sizeof(typecheck-lookup e)))
                        (set offset (expr::get-offset e2))
                        (set offset (i2s(add( (inv(s2i( sz ))) (s2i offset) ))))
                        (set e2 (expr::set-type( e2 StackVariable )))
                        (set e2 (expr::set-offset( e2 offset )))
                        e2
                     )))
                     ( u (tail(
                        (fail (ComplexFunctionConjugatesNotSupportedYet e))
                     )))
                  )))
                  ( _ (
                     (if (eq( used Used )) (
                        (fail( Raw Cons Cells Are Not Permitted In Strict Mode \n e ))
                     ) (tail(
                        (set e1 (compile-expr-strict( ctx l offset Unused )))
                        (set e2 (compile-expr-strict( (expr::get-context e1) r (expr::get-offset e1) Used )))
                        (set e2 (expr::set-frame( e2 (  (expr::get-frame e1) (expr::get-frame e2)  ))))
                        (set e2 (expr::set-unframe( e2 (  (expr::get-unframe e1) (expr::get-unframe e2)  ))))
                        (set e2 (expr::set-text( e2 (  (expr::get-text e1) (expr::get-text e2)  ))))
                        (set e2 (expr::set-data( e2 (  (expr::get-data e1) (expr::get-data e2)  ))))
                        (set e2 (expr::set-prog( e2 (  (expr::get-prog e1) (expr::get-prog e2)  ))))
                        e2
                     )))
                  ))
               )))
               result
            )))
            ( _ (fail (TODO CompileStrict e)))
         )))
         return
      )))
   ))
));

get-strict-function := λctx v arg_type . (tail(
   (assert-typeof( 'get-strict-function::ctx ctx Context ))
   (assert-typeof( 'get-strict-function::v v Atom ))
   (match (context::lookup( ctx v arg_type )) (
      ()
      ( (Fragment( body )) (
         (Fragment body)
      ))
      ( (GlobalFunction( body )) (
         (GlobalFunction body)
      ))
      ( (GlobalVariable( body )) (
         (GlobalVariable body)
      ))
      ( (Label lid) (
         (Label lid)
      ))
      ( (LocalVariable sv-offset) (
         (LocalVariable sv-offset)
      ))
      ( () (fail( UndefinedSymbol v arg_type )))
      ( u (fail( UnknownStrictFunction v arg_type u )))
   ))
));

strict-cstring-cache := ();
strict-declare-cstring := λ value . (tail(
   (local uid)
   (local cache)
   (set cache strict-cstring-cache)
   (while cache (tail(
      (if (eq( (head(tail( cache ))) value )) (tail(
         (set uid (tail(tail( cache ))))
         (set cache ())
      )) (
         (set cache (head cache))
      ))
   )))
   (if uid () (tail(
      (set uid (uuid()))
      (set assemble-data-section (assemble-data-section (
         uid ': \n
         '.ascii \s '" (escape-literal value) '" \n
         '.zero \s '1 \n
      )))
      (set strict-cstring-cache (strict-cstring-cache (value uid)))
   )))
   uid
));

strict-codegen-type-case := λ ctx base-type type-body case-number . (tail(
   (assert-typeof( 'strict-codegen-type-case::ctx ctx Context ))
   (if (typecheck-is-fragment base-type) () (match type-body (
      ()
      ( (App( (Literal enum-case) args )) (tail(
         (local args-type)
         (set args-type (typecheck-infer-type-compound args))
         (set args-type (Cons( args-type U64 )))

         (local taggeds-size)
         (set taggeds-size (typecheck-sizeof base-type))
         (local case-size)
         (set case-size (typecheck-sizeof args-type))
         (local case-padding)
         (set case-padding (i2s(add( (s2i taggeds-size) (inv(s2i( case-size ))) ))))

         #define 'push initializer
         (local body)
         (set body (Fragment (Lambda(
            (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
            (App( (Variable '.program) (
               (if (eq( case-padding 0 )) () (
                  \t 'sub \s '$ case-padding , \s '%rsp \n
               ))
               (App( (Variable '.program) (Variable 'src) ))
               DontChain
               \t 'pushq \s '$ case-number \n
            )))
         ))))
         (typecheck-ascript( body ('->(
            (And( enum-case base-type ))
            Nil
         ))))
         (set ctx (context::bind( ctx 'push body )))

         #define 'mov local initializer
         (local body)
         (set body (Fragment (Lambda(
            (App(
               (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
               (App( (App( (Literal ':) (Variable 'dst) )) (Literal LocalVariable) ))
            ))
            (App( (Variable '.program) (
               DontChain
               (if (eq( case-padding 0 )) () (
                  \t 'sub \s '$ case-padding , \s '%r15 \n
               ))
               (App( (Variable '.program) (Variable 'src) ))
               \t 'mov \s '%rbp , \s '%r15 \n
               \t 'add \s '$ (Variable 'dst) , \s '%r15 \n
               \t 'mov \s '$ case-size , \s '%r14 \n
               ('label 'while-push-start) ': \n
               \t 'cmp \s '$0 , \s '%r14 \n
               \t 'je \s ('label 'while-push-end) \n
               \t 'pop \s 0 \[ '%r15 \] \n
               \t 'sub \s '$8 , \s '%r14 \n
               \t 'add \s '$8 , \s '%r15 \n
               \t 'jmp \s ('label 'while-push-start) \n
               ('label 'while-push-end) ': \n
            )))
         ))))
         (typecheck-ascript( body ('->(
            (Cons( (And( enum-case base-type )) LocalVariable ))
            Nil
         ))))
         (set ctx (context::bind( ctx 'mov body )))

         #define 'mov global initializer
         (local body)
         (set body (Fragment (Lambda(
            (App(
               (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
               (App( (App( (Literal ':) (Variable 'dst) )) (Literal GlobalVariable) ))
            ))
            (App( (Variable '.program) (
               DontChain
               (if (eq( case-padding 0 )) () (
                  \t 'sub \s '$ case-padding , \s '%rsp \n
               ))
               (App( (Variable '.program) (Variable 'src) ))
               \t 'mov \s '$ (Variable 'dst) , \s '%r15 \n
               \t 'mov \s '$ case-size , \s '%r14 \n
               ('label 'while-push-start) ': \n
               \t 'cmp \s '$0 , \s '%r14 \n
               \t 'je \s ('label 'while-push-end) \n
               \t 'pop \s 0 \[ '%r15 \] \n
               \t 'sub \s '$8 , \s '%r14 \n
               \t 'add \s '$8 , \s '%r15 \n
               \t 'jmp \s ('label 'while-push-start) \n
               ('label 'while-push-end) ': \n
            )))
         ))))
         (typecheck-ascript( body ('->(
            (Cons( (And( enum-case base-type )) GlobalVariable ))
            Nil
         ))))
         (set ctx (context::bind( ctx 'mov body )))

         #define field accessors
         (local field-offset)
         (set field-offset 0)
         (local field-number)
         (set ctx (strict-bind-accessors( ctx base-type U64 0 () )))
         (while args-type (match args-type (
            ()
            ( (Cons( lt rt )) (tail(
               (set ctx (strict-bind-accessors( ctx enum-case rt field-offset field-number )))
               (set field-offset (i2s(add(
                  (s2i field-offset)
                  (s2i(max( 8 (typecheck-sizeof rt) )))
               ))))
               (set field-number (inc field-number))
               (set args-type lt)
            )))
            ( tt (tail(
               (set ctx (strict-bind-accessors( ctx enum-case tt field-offset field-number )))
               (set args-type ())
            )))
         )))
      )))
      ( (Literal enum-case) (tail(

         (local taggeds-size)
         (set taggeds-size (typecheck-sizeof base-type))
         (local case-size)
         (set case-size 8)
         (local case-padding)
         (set case-padding (i2s(add( (s2i taggeds-size) (inv(s2i( case-size ))) ))))

         #define 'push initializer
         (local body)
         (set body (Fragment (Lambda(
            (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
            (App( (Variable '.program) (
               (if (eq( case-padding 0 )) () (
                  \t 'sub \s '$ case-padding , \s '%rsp \n
               ))
               DontChain
               \t 'pushq \s '$ case-number \n
            )))
         ))))
         (typecheck-ascript( body ('->(
            (And( enum-case base-type ))
            StackVariable
         ))))
         (set ctx (context::bind( ctx 'push body )))

         #define 'mov local initializer
         (local body)
         (set body (Fragment (Lambda(
            (App(
               (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
               (App( (App( (Literal ':) (Variable 'dst) )) (Literal LocalVariable) ))
            ))
            (App( (Variable '.program) (
               DontChain
               \t 'mov \s '%rbp , \s '%r15 \n
               \t 'add \s '$ (Variable 'dst) , \s '%r15 \n
               \t 'movq \s '$ case-number , \s 0 \[ '%r15  \] \n
            )))
         ))))
         (typecheck-ascript( body ('->(
            (Cons( (And( enum-case base-type )) LocalVariable ))
            Nil
         ))))
         (set ctx (context::bind( ctx 'mov body )))

         #define 'mov global initializer
         (local body)
         (set body (Fragment (Lambda(
            (App(
               (App( (App( (Literal ':) (Variable 'src) )) (Literal Constant) ))
               (App( (App( (Literal ':) (Variable 'dst) )) (Literal GlobalVariable) ))
            ))
            (App( (Variable '.program) (
               DontChain
               \t 'mov \s '$ (Variable 'dst) , \s '%r15 \n
               \t 'movq \s '$ case-number , \s 0 \[ '%r15  \] \n
               (if (eq( case-padding 0 )) () (
                  \t 'sub \s '$ case-padding , \s '%r15 \n
               ))
            )))
         ))))
         (typecheck-ascript( body ('->(
            (Cons( (And( enum-case base-type )) GlobalVariable ))
            Nil
         ))))
         (set ctx (context::bind( ctx 'mov body )))

         #define '.0 accessor
         (set body (Fragment (Lambda(
            (App( (App( (Literal ':) (Variable 'src) )) (Literal LocalVariable) ))
            (App(
               (App( (Variable '.program) (
                  \t 'movq \s (App( (Variable '.expression) (Variable 'src) )) \s \[ '%rbp \] ,
                  \s '%r15 \n
               )))
               (App( (Variable '.expression) (
                  'r15
               )))
            ))
         ))))
         (typecheck-ascript( body ('->(
            (And( base-type LocalVariable ))
            Reg64
         ))))
         (set ctx (context::bind( ctx '.0 body )))

      )))
      ( () () )
      ( u (tail(
         (fail ('strict-codegen-type-case u))
      )))
   )))
   (assert-typeof( 'strict-codegen-type-case::ctx ctx Context ))
   ctx
));

strict-codegen-type := λ ctx type-name type-body case-number . (match type-body (
   ()
   ( (App( (App( tds (Variable '|) )) body )) (tail(
      (local base-type)
      (set base-type (typecheck-infer-type-compound type-name))
      (local next-case-number)
      (set next-case-number (i2s(inc(s2i( case-number )))))
      (set ctx (strict-codegen-type( ctx type-name tds next-case-number )))
      (strict-codegen-type-case( ctx base-type body case-number ))
   )))
   ( body (tail(
      (local base-type)
      (set base-type (typecheck-infer-type-compound type-name))
      (strict-codegen-type-case( ctx base-type type-body case-number ))
   )))
));

strict-bind-accessors := λ ctx base-type src-type field-offset field-number . (tail(
   (local body)
   (local register-name)
   (local return-type)
   (match (typecheck-sizeof src-type) (
      ()
      (1 (tail(
         (set register-name 'r15b)
         (set return-type 'Reg8)
      )))
      (2 (tail(
         (set register-name 'r15w)
         (set return-type 'Reg16)
      )))
      (4 (tail(
         (set register-name 'r15d)
         (set return-type 'Reg32)
      )))
      (8 (tail(
         (set register-name 'r15)
         (set return-type 'Reg64)
      )))
      (_ (tail(
         (set return-type ())
      )))
   ))
   (if return-type (tail(
      (set body (Fragment (Lambda(
         (App( (App( (Literal ':) (Variable 'src) )) (Literal LocalVariable) ))
         (App(
            (App( (Variable '.program) (
               \t 'mov \s ('+( ('.expression 'src) field-offset )) \s \[ '%rbp \] ,
               \s '% register-name \n
            )))
            (App( (Variable '.expression) (
               register-name
            )))
         ))
      ))))
      (typecheck-ascript( body ('->(
         (And( base-type LocalVariable ))
         return-type
      ))))
      (set ctx (context::bind( ctx (clone-rope( '. (i2s field-number) )) body )))
   )) (tail(
      (set body (Fragment (Lambda(
         (App( (App( (Literal ':) (Variable 'src) )) (Literal LocalVariable) ))
         (App( (Variable '.expression) (
            ('+( ('.expression 'src) field-offset ))
         )))
      ))))
      (typecheck-ascript( body ('->(
         (And( base-type LocalVariable ))
         LocalVariable
      ))))
      (set ctx (context::bind( ctx (clone-rope( '. (i2s field-number) )) body )))
   )))
   ctx
));
