
assemble-text-section                    := ();
assemble-data-section                    := ();
assemble-argv-referenced                 := ();

assemble := λprogram . (
   (local target)
   (set target 'tmp.s)
   (while cli-config (tail(
      (match (tail cli-config) (
         ()
         ((Target t) (set target t))
      ))
      (set cli-config (head cli-config))
   )))

   (local main_e)
   (local main_pd)

   (local e1)
   (local e2)

   (local output_pd)
   (set output_pd ( () () ))

   (local global_ctx)
   (set global_ctx (context::new()))
   (local preview_program)
   (set preview_program program)

   (while preview_program (match preview_program (
      ()
      ( (pc (Global ('main (
            (Lambda( lhs rhs ))
         )))) (
         (set global_ctx (context::bind( global_ctx 'argc
            (typecheck-ascript( (GlobalVariable 'argc) (parse-type 'U64+GlobalVariable) ))
         )))
         (set global_ctx (context::bind( global_ctx 'argv
            (typecheck-ascript( (GlobalVariable 'argv) (parse-type 'String[?]+GlobalVariable) ))
         )))
         (set assemble-argv-referenced True)
         (set preview_program pc)
      ))
      ( (pc1 (Global ('main body))) (
         (set preview_program pc1)
      ))
      ( (pc2 (GExpr e)) (
         (set preview_program pc2)
      ))
      ( (pc3 (Global (fname body))) (
         (match body (
            ()
            ( Nil (tail(
               (set output_pd (
                  (head output_pd)
                  (
                     (tail output_pd)
                     (label-case fname)
                     ': \n \t '.zero \s '16 \n
                  )
               ))
               (set global_ctx (context::bind( global_ctx fname
                  (typecheck-ascript( (GlobalVariable body) (typecheck-lookup body) ))
               )))
            )))
            ( (Lambda(lhs rhs)) (tail(
               (set global_ctx (context::bind( global_ctx fname
                  (typecheck-ascript( (GlobalFunction body) (typecheck-lookup body) ))
               )))
            )))
            ( (App( (App( (Literal ':) body-initial )) body-type )) (tail(
               (local mtype)
               (set mtype (typecheck-lookup body))
               (local mname)
               (set mname (mangle-identifier( fname mtype )))
               (set output_pd (
                  (head output_pd)
                  (
                     (tail output_pd)
                     mname ': \n
                     (assemble-initialize-data( body-initial mtype ))
                  )
               ))
               (set global_ctx (context::bind( global_ctx fname
                  (typecheck-ascript( (GlobalVariable mname) mtype ))
               )))
            )))
            ( other (tail(
               (fail (GlobalsMustBeAscripted other))
            )))
         ))
         (set preview_program pc3)
      ))
      ( (prog (Fragment( (Variable fname) fbody ))) (
         (set global_ctx (context::bind( global_ctx fname
            (typecheck-ascript( (Fragment fbody) (typecheck-lookup fbody) ))
         )))
         (set preview_program prog)
      ))
      ( (prog (Type( tn tb ))) (
         (set global_ctx (strict-codegen-type( global_ctx tn tb 0 )) )
         (set preview_program prog)
      ))
      ( (prog (Size( _ _ ))) (
         (set preview_program prog)
      ))
      ( u (
         (fail (UnexpectedProgram (tail u)))
      ))
   )))

   (while program (match program (
      ()
      ( (pc (Global ('main (
            (Lambda( lhs rhs ))
         )))) (
         (set main_e rhs)
         (set program pc)
      ))
      ( (pc (Global ('main body))) (
         (set main_e body)
         (set program pc)
      ))
      ( (pc (GExpr e)) (
         (set main_pd (compile-append( main_pd global_ctx e )))
         (set program pc)
      ))
      ( (pc (Global (fname body))) (
         (match body (
            ()
            ( Nil (
            ))
            ( (Lambda(lhs rhs)) (
               (if config-strict (
                  (set e1 (stack-define( global_ctx fname body )))
               ) (
                  (set e1 (define-calling-convention-s( global_ctx fname body )))
               ))
               (set output_pd (
                  ( (head output_pd) (expr::get-text e1) )
                  ( (tail output_pd) (expr::get-data e1) )
               ))
            ))
            ( (App( (App( (Literal ':) body-initial )) body-type )) (tail(
               (local mtype)
               (set mtype (typecheck-lookup body-initial))
               (local lhs)
               (set lhs (Variable fname))
               (typecheck-ascript( lhs mtype ))
               (set main_pd (compile-append(
                  main_pd global_ctx
                  (App( (App( (Variable 'set) lhs )) body-initial ))
               )))
            )))
         ))
         (set program pc)
      ))
      ( (pc (Fragment( _ _ ))) (
         (set program pc)
      ))
      ( (pc (Type( _ _ ))) (
         (set program pc)
      ))
      ( (pc (Size( _ _ ))) (
         (set program pc)
      ))
      ( u (
         (fail (UnexpectedProgram (tail u)))
      ))
   )))

   (if main_e (
      (set main_pd (compile-append( main_pd global_ctx main_e )))
   ) ())

   (set output_pd (
      (
         (assemble-program-header())
         (before-main())
         (if assemble-argv-referenced (assemble-argv-prog-header()) ())
         (enter-function())
         (expr::get-frame main_pd)
         (expr::get-prog main_pd)
         (expr::get-unframe main_pd)
         (exit-cleanup())
         (head output_pd)
         (expr::get-text main_pd)
         (if config-nostd () (stdlib-functions()))
      )
      ( (if config-nostd () (stdlib-data()))
        (tail output_pd) (expr::get-data main_pd)
        (if assemble-argv-referenced (assemble-argv-data-header()) ())
      )
   ))
   (set output_pd (
      ((head output_pd) assemble-text-section)
      ((assemble-data-header()) (tail output_pd) assemble-data-section)
   ))

   (write-file (target (clone-rope output_pd)))
   (debug-memory-usage 'assemble)
);

assemble-initialize-data := λ e tt . (
   (match e (
      ()
      ( (Literal v) (match (typecheck-datatype tt) (
         ()
         (I8 ( \t '.byte \s v \n ))
         (U8 (tail(
            (if (eq( v True )) (set v '1) ())
            (if (eq( v False )) (set v '0) ())
            (\t '.byte \s v \n)
         )))
         (I16 ( \t '.2byte \s v \n ))
         (U16 ( \t '.2byte \s v \n ))
         (I32 ( \t '.4byte \s v \n ))
         (U32 ( \t '.4byte \s v \n ))
         (I64 ( \t '.8byte \s v \n ))
         (U64 ( \t '.8byte \s v \n ))
         (_ ( \t '.zero \s (typecheck-sizeof tt) \n ))
      )))
      ( _ (
         \t '.zero \s (typecheck-sizeof tt) \n
      ))
   ))
);

assemble-data-header := λ .(
  '.data                                  \n
);

assemble-argv-data-header := λ .(
  'argc:                                  \n
  \t '.zero \s 8                          \n
  'argv:                                  \n
  \t '.zero \s 8192                       \n
);
assemble-argv-prog-header := λ .(
  \t 'pop \s '%r15                        \n
  \t 'mov \s '$argc , \s '%r14            \n
  \t 'mov \s '%r15 , \s '0 \[ '%r14 \]    \n
  \t 'mov \s '$argv , \s '%r14            \n
  'argv_populate_loop_begin:              \n
  \t 'cmp \s '$0 , \s '%r15               \n
  \t 'je \s 'argv_populate_loop_end       \n
  \t 'pop \s '%r13                        \n
  \t 'mov \s '%r13 , \s '0 \[ '%r14 \]    \n
  \t 'add \s '$8 , \s '%r14               \n
  \t 'dec \s '%r15                        \n
  \t 'jmp \s 'argv_populate_loop_begin    \n
  'argv_populate_loop_end:                \n
);

assemble-program-header := λ .(
   '.global \s '_start                    \n
   '.text                                 \n
   '_start:                               \n
   \t 'jmp \s 'main                       \n
);

