#global binding
compile-global := λ(: ctx FContext)(: k String)(: term AST). (: (tail(
(let kt (maybe-deref(typeof term)))
(match term (
()
( (Abs( lhs rhs tlt )) (if (is-open kt) () (tail(
(let args-type (domain kt))
(let args-size (typecheck-aligned-sizeof args-type))
(let ctx-2 (maybe-deref(compile-destructure-args( args-type ctx lhs 0_i64 ))))
(set ctx ctx-2)
(let ctx-3 (FCtxBind( (close ctx) 'cdecl::args-size_s TAny
(maybe-deref(fragment::expression(to-string args-size)))
)))(set ctx ctx-3)
(let stack-offset 0_i64)
(set stack-offset (-( stack-offset 8_i64 )))
(set stack-offset (-( stack-offset (as args-size I64) )))
(let e (maybe-deref(compile-expr( ctx rhs stack-offset Return ))))
(let text SNil)
(if (==( k 'main_s )) (tail(
(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 (maybe-deref(fragment::get( e 'frame_s ))))
(set text (SCons( (close text) (close frame) )))
(let program (maybe-deref(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 (maybe-deref(fragment::get( e 'text_s ))))
(set text (SCons( (close text) (close text-etc) )))
(set assemble-text-section (SCons( (close assemble-text-section) (close text) )))
))))
( (Asc( t tt )) (tail(
(let clean-tt (maybe-deref(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(typecheck-aligned-sizeof kt))))
)))
(set assemble-data-section (SCons(
(close assemble-data-section)
(close(SAtom '\n_s))
)))
(let kt (maybe-deref(typeof term)))
(let e1 (maybe-deref(compile-expr( ctx term -8_i64 Used ))))
(let e1-2 (maybe-deref(fragment::set-type( e1 kt ))))(set e1 e1-2)
(let e2 (maybe-deref(fragment-context::lookup( ctx k kt term ))))
(let e3 (maybe-deref(fragment-apply( ctx -8_i64 'mov_s
(FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
(typeof term)
term
))))
(set assemble-init-section (SCons(
(close assemble-init-section)
(close(fragment::get( e3 'program_s )))
)))
)))
( _ (
(exit-error( 'Unrecognized\sCompile\sGlobal\n_s term ))
))
))
)) Nil);
#top expression
compile-global := λ(: ctx FContext)(: term AST). (: (tail(
()
()
)) Nil);
compile-expr := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used IsUsed). (: (tail(
(let e (maybe-deref(fragment::new())))
(match used (
()
( Return (tail(
(let e-1 (maybe-deref(compile-expr-direct( ctx term stack-offset Used ))))(set e e-1)
(let e-2 (maybe-deref(fragment-apply( ctx stack-offset 'cdecl::return_s
(FLSeq( (close FLEOF) e ))
(typeof term)
term
))))(set e e-2)
)))
( _ (tail(
(let e-1 (maybe-deref(compile-expr-direct( ctx term stack-offset used ))))
(set e e-1)
)))
))
e
)) Fragment);
compile-expr-direct := λ(: ctx FContext)(: term AST)(: stack-offset I64)(: used IsUsed). (: (tail(
(let e (maybe-deref(fragment::new())))
(let e-2 (maybe-deref(fragment::set-context( e ctx ))))(set e e-2)
(let e-3 (maybe-deref(fragment::set-offset( e stack-offset ))))(set e e-3)
(match term (
()
( ASTNil () )
( ASTEOF () )
( (Var( id )) (tail(
(let e-1 (maybe-deref(fragment-context::lookup( ctx id (maybe-deref(typeof term)) term ))))(set e e-1)
(let e-2 (maybe-deref(fragment::set-context( e ctx ))))(set e e-2)
(let e-3 (maybe-deref(fragment::set-offset( e stack-offset ))))(set e e-3)
)))
( (Lit( val )) (tail(
(let ltype (maybe-deref(typeof term)))
(match (slot( ltype 'String_s )) (
()
( (TGround( 'String_s _ )) (tail(
(let e1 (maybe-deref(compile-declare-cstring( val ))))
(set e e1)
)))
( _ (tail(
(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 )) (tail(
(let e1 (maybe-deref(fragment::expression val)))
(set e e1)
)) (
(if (non-zero(class-of-tag val)) (tail(
(let tag-index (index-of-tag val))
(let e1 (maybe-deref(fragment::expression(to-string tag-index))))
(let e2 (maybe-deref(fragment::set( e1 'program_s (SCons( (close SNil) (close SNil) )) ))))
(set e e2)
)) (
(match val (
()
( 'True_s (tail( (let e1 (maybe-deref(fragment::expression '1_s))) (set e e1) )))
( 'False_s (tail( (let e1 (maybe-deref(fragment::expression '0_s))) (set e e1) )))
( '\\t_s (tail( (let e1 (maybe-deref(fragment::expression '9_s))) (set e e1) )))
( '\\n_s (tail( (let e1 (maybe-deref(fragment::expression '10_s))) (set e e1) )))
( '\\s_s (tail( (let e1 (maybe-deref(fragment::expression '32_s))) (set e e1) )))
( '\\o_s (tail( (let e1 (maybe-deref(fragment::expression '35_s))) (set e e1) )))
( '\\`_s (tail( (let e1 (maybe-deref(fragment::expression '39_s))) (set e e1) )))
( '\\[_s (tail( (let e1 (maybe-deref(fragment::expression '40_s))) (set e e1) )))
( '\\]_s (tail( (let e1 (maybe-deref(fragment::expression '41_s))) (set e e1) )))
( '\\:_s (tail( (let e1 (maybe-deref(fragment::expression '59_s))) (set e e1) )))
( _ (tail( (let e1 (maybe-deref(fragment::expression val))) (set e e1) )))
))
))
))
)))
))
(let e-2 (maybe-deref(fragment::set-context( e ctx ))))(set e e-2)
(let e-3 (maybe-deref(fragment::set-type( e ltype ))))(set e e-3)
)))
( (Asc( t tt )) (tail(
(let e1 (maybe-deref(compile-expr( ctx t stack-offset used ))))
(let e1-2 (maybe-deref(fragment::set-type( e1 (maybe-deref(typeof term)) ))))(set e1 e1-2)
(set e e1)
)))
( (App( (Var 'tail_s) (App( lt rt )) )) (tail(
(let e1 (maybe-deref(compile-expr( ctx lt stack-offset Unused ))))
(let e2 (maybe-deref(compile-expr( (maybe-deref(fragment::get-context e1)) rt (fragment::get-offset e1) Used ))))
(let e12 (maybe-deref(fragment::chain( e1 e2 ))))
(let e12-2 (maybe-deref(fragment::set-type( e12 (maybe-deref(typeof term)) ))))(set e12 e12-2)
(set e e12)
)))
( (App( (Var 'gensym-label_s) (Var id) )) (tail(
(let new-ctx (maybe-deref(fragment-context::bind(
ctx id (maybe-deref(tlabel())) (maybe-deref(fragment::label( (uuid()) )))
))))
(let e-1 (maybe-deref(fragment::set-context( e new-ctx ))))(set e e-1)
(let e-2 (maybe-deref(fragment::set-type( e (maybe-deref(t1 'Nil_s)) ))))(set e e-2)
)))
( (App( (Var 'label_s) (Var id) )) (tail(
(let l (maybe-deref(fragment-context::lookup( ctx id (maybe-deref(tlabel())) term ))))
(let prog (SCons(
(close(fragment::get( l 'expression_s )))
(close(SAtom ':\n_s))
)))
(let e-2 (maybe-deref(fragment::set( e 'program_s prog ))))(set e e-2)
(let e-3 (maybe-deref(fragment::set-type( e (maybe-deref(t1 'Nil_s)) ))))(set e e-3)
)))
( (App( (Var 'scope_s) t )) (tail(
(let e1 (maybe-deref(compile-expr( ctx t stack-offset Used ))))
(let e1-2 (maybe-deref(fragment::set-context( e1 ctx ))))
(set e e1-2)
)))
( (App( (Var 'maybe-deref_s) t )) (tail(
(let e1 (maybe-deref(compile-expr( ctx t stack-offset Used ))))
(set e e1)
(let tt (maybe-deref(typeof t)))
(match (slot( tt 'Array_s )) (
()
( (TGround( 'Array_s (TypeSeq( (TypeSeq( TypeEOF TAny )) _ )) )) () )
( (TGround( 'Array_s (TypeSeq( (TypeSeq( TypeEOF inner-tt )) TAny )) )) (tail(
(let e1-2 (maybe-deref(fragment::set-type( e1 tt ))))(set e1 e1-2)
(let e2 (maybe-deref(fragment::new())))
(let e2-2 (maybe-deref(fragment::set( e2 'expression_s (SAtom '0_s) ))))(set e2 e2-2)
(let e2-3 (maybe-deref(fragment::set-type( e2
(maybe-deref(tand(
(maybe-deref(t1 'Literal_s))
(maybe-deref(t1 'Constant_s))
)))
))))(set e2 e2-3)
(let e3 (maybe-deref(fragment-apply( ctx stack-offset 'push_s
(FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
(typeof term)
term
))))
(let e3-2 (maybe-deref(fragment::set-type( e3 (maybe-deref(tand( inner-tt (maybe-deref(t1 'StackVariable_s)) ))) ))))(set e3 e3-2)
(let new-offset (-( stack-offset (as (typecheck-aligned-sizeof inner-tt) I64) )))
(let e3-3 (maybe-deref(fragment::set-offset( e3 new-offset ))))(set e3 e3-3)
(set e e3)
)))
( _ () )
))
)))
( (Sizeof( tt )) (tail(
(let sz (typecheck-sizeof( tt )))
(let e1 (maybe-deref(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(tsized '8_s))
)))
)))
)))
(let e1-2 (maybe-deref(fragment::set-type( e1 et ))))(set e1 e1-2)
(let e1-3 (maybe-deref(fragment::set-context( e1 ctx ))))(set e1 e1-3)
(let e1-4 (maybe-deref(fragment::set-offset( e1 stack-offset ))))(set e1 e1-4)
(set e e1)
)))
( (As( t tt )) (tail(
(let e-1 (maybe-deref(compile-expr( ctx t stack-offset used ))))(set e e-1)
(let e-2 (maybe-deref(fragment::set-type( e (maybe-deref(typeof term)) ))))(set e e-2)
)))
( (App( (App( (Var 'set_s) (Var k) )) rhs )) (tail(
(let kt (maybe-deref(typeof rhs)))
(let e1 (maybe-deref(compile-expr( ctx rhs stack-offset Used ))))
(let e1-2 (maybe-deref(fragment::set-type( e1 kt ))))(set e1 e1-2)
(let e2 (maybe-deref(fragment-context::lookup( ctx k kt term ))))
(let e3 (maybe-deref(fragment-apply( ctx stack-offset 'mov_s
(FLSeq( (close(FLSeq( (close FLEOF) e1 ))) e2 ))
(typeof term)
term
))))(set e e3)
(let e3-2 (maybe-deref(fragment::set-context( e ctx ))))(set e e3-2)
(let e3-3 (maybe-deref(fragment::set-offset( e stack-offset ))))(set e e3-3)
)))
( (App( (App( (Var 'while_s) cond )) body )) (tail(
(let e1 (maybe-deref(compile-expr( ctx cond stack-offset Used ))))
(let e1-2 (maybe-deref(as-branch-conditional e1)))(set e1 e1-2)
(let e2 (maybe-deref(compile-expr( (maybe-deref(fragment::get-context e1)) body (fragment::get-offset e1) Unused ))))
(let label-begin-loop (uuid()))
(let label-do-loop (uuid()))
(let label-end-loop (uuid()))
(let e3 (maybe-deref(fragment::chain( e1 e2 ))))
(let text SNil)
(set text (SCons( (close text) (close(SAtom label-begin-loop)) )))
(set text (SCons( (close text) (close(SAtom ':\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e1 'frame_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e1 'program_s ))) )))
(set text (SCons( (close text) (close(SAtom '\t_s)) )))
(set text (SCons( (close text) (close(fragment::get( e1 'expression_s ))) )))
(set text (SCons( (close text) (close(SAtom '\s_s)) )))
(set text (SCons( (close text) (close(SAtom label-do-loop)) )))
(set text (SCons( (close text) (close(SAtom '\n\tjmp\s_s)) )))
(set text (SCons( (close text) (close(SAtom label-end-loop)) )))
(set text (SCons( (close text) (close(SAtom '\n_s)) )))
(set text (SCons( (close text) (close(SAtom label-do-loop)) )))
(set text (SCons( (close text) (close(SAtom ':\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e2 'frame_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e2 'program_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e2 'unframe_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e1 'unframe_s ))) )))
(set text (SCons( (close text) (close(SAtom '\tjmp\s_s)) )))
(set text (SCons( (close text) (close(SAtom label-begin-loop)) )))
(set text (SCons( (close text) (close(SAtom '\n_s)) )))
(set text (SCons( (close text) (close(SAtom label-end-loop)) )))
(set text (SCons( (close text) (close(SAtom ':\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e1 'unframe_s ))) )))
(let e3-2 (maybe-deref(fragment::set( e3 'program_s text ))))(set e3 e3-2)
(let e3-3 (maybe-deref(fragment::set( e3 'frame_s SNil ))))(set e3 e3-3)
(let e3-4 (maybe-deref(fragment::set( e3 'unframe_s SNil ))))(set e3 e3-4)
(let e3-5 (maybe-deref(fragment::set-context( e3 ctx ))))(set e3 e3-5)
(let e3-6 (maybe-deref(fragment::set-offset( e3 stack-offset ))))(set e3 e3-6)
(let e3-7 (maybe-deref(fragment::set-type( e3 (maybe-deref(typeof term)) ))))(set e3 e3-7)
(set e e3)
)))
( (App( (App( (App( (Var 'if_s) cond )) t )) f )) (tail(
(let rsp-offset (+( stack-offset -8_i64 )))
(let e1 (maybe-deref(compile-expr( ctx cond rsp-offset Used ))))
(let e1-4 (maybe-deref(as-branch-conditional e1)))(set e1 e1-4)
(let e2 (maybe-deref(compile-expr( (maybe-deref(fragment::get-context e1)) t (fragment::get-offset e1) used ))))
(let e3 (maybe-deref(compile-expr( (maybe-deref(fragment::get-context e1)) f (fragment::get-offset e1) used ))))
(let end-offset (fragment::get-offset e2))
(let label-true-branch (uuid()))
(let label-end (uuid()))
(let text SNil)
(set text (SCons( (close text) (close(SAtom '\tpush\s%rbp\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e1 'frame_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e1 'program_s ))) )))
(set text (SCons( (close text) (close(SAtom '\t_s)) )))
(set text (SCons( (close text) (close(fragment::get( e1 'expression_s ))) )))
(set text (SCons( (close text) (close(SAtom '\s_s)) )))
(set text (SCons( (close text) (close(SAtom label-true-branch)) )))
(set text (SCons( (close text) (close(SAtom '\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e3 'frame_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e3 'program_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e3 'unframe_s ))) )))
(set text (SCons( (close text) (close(SAtom '\tjmp\s_s)) )))
(set text (SCons( (close text) (close(SAtom label-end)) )))
(set text (SCons( (close text) (close(SAtom '\n_s)) )))
(set text (SCons( (close text) (close(SAtom label-true-branch)) )))
(set text (SCons( (close text) (close(SAtom ':\n_s)) )))
(set text (SCons( (close text) (close(fragment::get( e2 'frame_s ))) )))
(set text (SCons( (close text) (close(fragment::get( e2 'program_s ))) )))
(set text (SCons( (close text) (close(SAtom label-end)) )))
(set text (SCons( (close text) (close(SAtom ':\n_s)) )))
(set text (SCons( (close text) (close(SAtom '\tmov\s_s)) )))
(set text (SCons( (close text) (close(SAtom (to-string rsp-offset))) )))
(set text (SCons( (close text) (close(SAtom '\[%rbp\],\s%rsp\n_s)) )))
(set text (SCons( (close text) (close(SAtom '\tadd\s$_s)) )))
(set text (SCons( (close text) (close(SAtom (to-string end-offset))) )))
(set text (SCons( (close text) (close(SAtom ',\s%rsp\n_s)) )))
(let e1-5 (maybe-deref(fragment::set( e1 'program_s text ))))(set e1 e1-5)
(let e1-6 (maybe-deref(fragment::set-context( e1 (maybe-deref(fragment::get-context e2)) ))))(set e1 e1-6)
(let e1-7 (maybe-deref(fragment::set-offset( e1 end-offset ))))(set e1 e1-7)
(let e1-8 (maybe-deref(fragment::set( e1 'frame_s SNil ))))(set e1 e1-8)
(let e1-9 (maybe-deref(fragment::set( e1 'unframe_s
(SCons(
(close(fragment::get( e1 'unframe_s )))
(close(SCons(
(close(fragment::get( e2 'unframe_s )))
(close(SAtom '\tadd\s$8,\s%rsp\n_s ))
)))
))
))))(set e1 e1-9)
(let e1-10 (maybe-deref(fragment::set-type( e1 (maybe-deref(typeof term)) ))))(set e1 e1-10)
(set e e1)
)))
( (App( (Abs( (Var lhs) ASTNil tlt )) rhs )) (tail(
(let rtype (maybe-deref(typeof rhs)))
(let rtype-clean (maybe-deref(without-representation rtype)))(set rtype rtype-clean)
(let rtype-2 (TAnd( (close rtype) (close(t1 'LocalVariable_s)) )))(set rtype rtype-2)
(let rtype-3 (maybe-deref(typecheck-annotate-size( rtype ))))(set rtype rtype-3)
(let size (typecheck-aligned-sizeof rtype))
(let e1 (maybe-deref(compile-push-rvalue( ctx rhs stack-offset ))))
(let bind-offset (-( stack-offset (as size I64) )))
(let e1-2 (maybe-deref(fragment::set( e1 'unframe_s
(SCons(
(close(fragment::get( e1 'unframe_s )))
(close(SCons(
(close(SAtom '\tadd\s$_s))
(close(SCons(
(close(SAtom(to-string size)))
(close(SAtom ',\s%rsp\n_s))
)))
)))
))
))))
(let new-ctx (maybe-deref(fragment-context::bind(
ctx lhs rtype (maybe-deref(fragment::local-variable( bind-offset rtype )))
))))
(let e1-3 (maybe-deref(fragment::set-context( e1-2 new-ctx ))))
(let e1-4 (maybe-deref(fragment::set-offset( e1-3 bind-offset ))))
(let e1-5 (maybe-deref(fragment::set-type( e1-4 (maybe-deref(typeof term)) ))))
(set e e1-5)
)))
( (App( f a )) (
(match (slot( (maybe-deref(typeof f)) 'Arrow_s )) (
()
( (TGround( 'Arrow_s _ )) (
(match f (
()
( (Var fname) (tail(
(let e1 (maybe-deref(compile-stack-call( ctx fname (maybe-deref(typeof term)) a stack-offset used ))))
(set e e1)
)))
( (Asc( (Var fname) ft )) (tail(
(let e1 (maybe-deref(compile-stack-call( ctx fname (maybe-deref(typeof term)) a stack-offset used ))))
(set e e1)
)))
( (Lit fname) (tail(
(let e1 (maybe-deref(compile-constructor( ctx fname (maybe-deref(typeof term)) (maybe-deref(typeof a)) a stack-offset ))))
(set e e1)
)))
( (Asc( (Lit fname) ft )) (tail(
(let e1 (maybe-deref(compile-constructor( ctx fname (maybe-deref(typeof term)) (maybe-deref(typeof a)) a stack-offset ))))
(set e e1)
)))
( _ (
(exit-error( 'Unexpected\sApplication\sTerm_s term ))
))
))
))
( _ (
(if (is( used Used )) (
(exit-error( 'Raw\sCons\sCells\sNot\sPermitted\sIn\sStrict\sMode_s term ))
) (tail(
(let e1 (maybe-deref(compile-expr( ctx f stack-offset Unused ))))
(let e2 (maybe-deref(compile-expr( (maybe-deref(fragment::get-context e1)) a (fragment::get-offset e1) used ))))
(let e12 (maybe-deref(fragment::chain( e1 e2 ))))
(set e e12)
)))
))
))
))
( u (exit-error( 'compile-expr\sUnsupported\sExpression_s term )))
))
(if (non-zero(maybe-deref(fragment::get-context( e )))) () (
(exit-error( 'Context\sBecame\sNull_s term ))
))
e
)) Fragment);
compile-destructure-args := λ(: tt Type)(: ctx FContext)(: lhs AST)(: offset I64). (: (tail(
(match lhs (
()
( (App( rst (Asc( (Var k) kt )) )) (
(match (slot( tt 'Cons_s )) (
()
( (TGround( 'Cons_s (TypeSeq( (TypeSeq( TypeEOF rst-tt )) p2 )) )) (tail(
(let new-ctx-2 (maybe-deref(compile-destructure-args( rst-tt ctx rst offset ))))
(let rst-sz (typecheck-aligned-sizeof rst-tt))
(let rst-offset (-( offset (as rst-sz I64) )))
(let kt-2 (TAnd( (close kt) (close(t1 'LocalVariable_s)) )))(set kt kt-2)
(let sz (typecheck-aligned-sizeof kt))
(let new-offset (-( rst-offset (as sz I64) )))
(let new-ctx (maybe-deref(fragment-context::bind(
new-ctx-2 k kt (maybe-deref(fragment::local-variable( new-offset kt )))
))))
(set ctx new-ctx)
)))
( _ (exit-error( 'Destructure\sExpected\sCons_s lhs )))
))
))
( (Asc( (Var k) kt )) (tail(
(let kt-2 (TAnd( (close kt) (close(t1 'LocalVariable_s)) )))(set kt kt-2)
(let sz (typecheck-aligned-sizeof kt))
(let new-offset (-( offset (as sz I64) )))
(let new-ctx (maybe-deref(fragment-context::bind(
ctx k kt (maybe-deref(fragment::local-variable( new-offset kt )))
))))
(set ctx new-ctx)
)))
( _ () )
))
ctx
)) FContext);
compile-stack-call := λ(: ctx FContext)(: function-name String)(: return-type Type)(: args AST)(: offset I64)(: used IsUsed). (: (tail(
(let f (maybe-deref(fragment-context::lookup( ctx function-name (maybe-deref(typeof args)) args ))))
(let function-type (maybe-deref(fragment::get-type f)))
(let r (maybe-deref(fragment::new())))
(match (maybe-deref(fragment::get( f 'fragment-type_s ))) (
()
( (SAtom 'Fragment_s) (tail(
(let f-args (maybe-deref(compile-fragment-args( ctx args offset ))))
(let r-2 (maybe-deref(fragment-apply( ctx offset function-name f-args return-type args ))))(set r r-2)
(let r-6 (maybe-deref(fragment::set-offset( r offset ))))(set r r-6)
(let r-7 (maybe-deref(fragment::set-type( r return-type ))))(set r r-7)
)))
( _ (tail(
(let push-args (maybe-deref(compile-stack-call-push-args( ctx args offset ))))
(let call SNil)
(let function-id (mangle-identifier( function-name function-type )))
(set call (SCons( (close call) (close(SAtom '\oCall\sFunction\s_s)) )))
(set call (SCons( (close call) (close(SAtom function-name)) )))
(set call (SCons( (close call) (close(SAtom '\s:\s_s)) )))
(set call (SCons( (close call) (close(SAtom(to-string (maybe-deref(fragment::get-type f))))) )))
(set call (SCons( (close call) (close(SAtom '\n\oArgument:\s_s)) )))
(set call (SCons( (close call) (close(SAtom function-name)) )))
(set call (SCons( (close call) (close(SAtom '\s:\s_s)) )))
(set call (SCons( (close call) (close(SAtom(to-string (maybe-deref(typeof args))))) )))
(set call (SCons( (close call) (close(SAtom '\n_s)) )))
(set call (SCons( (close call) (close(SAtom '\oReturn:\s_s)) )))
(set call (SCons( (close call) (close(SAtom function-name)) )))
(set call (SCons( (close call) (close(SAtom '\s:\s_s)) )))
(set call (SCons( (close call) (close(SAtom(to-string return-type))) )))
(set call (SCons( (close call) (close(SAtom '\n_s)) )))
(set call (SCons( (close call) (close(SAtom '\tpush\s%rbp\n_s)) )))
(set call (SCons( (close call) (close(SAtom '\tmov\s%rsp,\s%rbp\n_s)) )))
(set call (SCons( (close call) (close(fragment::get( push-args 'program_s ))) )))
(set call (SCons( (close call) (close(SAtom '\tcall\s_s)) )))
(set call (SCons( (close call) (close(SAtom function-id)) )))
(set call (SCons( (close call) (close(SAtom '\n_s)) )))
(set call (SCons( (close call) (close(SAtom '\tmov\s%rbp,\s%rsp\n_s)) )))
(set call (SCons( (close call) (close(SAtom '\tpop\s%rbp\n_s)) )))
(let r-6 (maybe-deref(fragment::set-offset( r offset ))))(set r r-6)
(let expr 'Invalid\sExpression_s)
(match (typecheck-sizeof return-type) (
()
( 0_u64 ())
( 1_u64 (set expr 'al_s))
( 2_u64 (set expr 'ax_s))
( 4_u64 (set expr 'eax_s))
( 8_u64 (set expr 'rax_s))
( rsz (
(if (is( used Used )) (tail(
(let rsi 0_u64)
(let args-size (typecheck-sizeof(maybe-deref(typeof args))))
(let rel-off (-( -24_i64 (as args-size I64) )))
(while (<( rsi rsz )) (tail(
(set call (SCons( (close call) (close(SAtom '\tpush\s_s)) )))
(set call (SCons( (close call) (close(SAtom(to-string rel-off))) )))
(set call (SCons( (close call) (close(SAtom '\[%rsp\]\n_s)) )))
(set rsi (+( rsi 8_u64 )))
)))
(let r-7 (maybe-deref(fragment::set-offset( r (-( offset (as rsz I64) )) ))))(set r r-7)
)) (tail(
(let r-7 (maybe-deref(fragment::set-offset( r offset ))))(set r r-7)
)))
))
))
(let r-3 (maybe-deref(fragment::set( r 'program_s call ))))(set r r-3)
(let r-4 (maybe-deref(fragment::set( r 'expression_s (SAtom expr) ))))(set r r-4)
(let r-5 (maybe-deref(fragment::set-type( r return-type ))))(set r r-5)
)))
))
(let r-1 (maybe-deref(fragment::set-context( r ctx ))))(set r r-1)
r
)) Fragment);
compile-translate-local-variables := λ(: ctx FContext)(: delta I64). (: (tail(
(match ctx (
()
( FCtxEOF () )
( (FCtxBind( rst k kt f )) (tail(
(let rst (maybe-deref(compile-translate-local-variables( rst delta ))))
(match (maybe-deref(fragment::get( f 'fragment-type_s ))) (
()
( (SAtom 'LocalVariable_s) (
(match (maybe-deref(fragment::get( f 'expression_s ))) (
()
( (SAtom previous-offset) (tail(
(let p-offset (to-i64 previous-offset))
(let new-offset (+( p-offset delta )))
(let new-f (maybe-deref(fragment::set( f 'expression_s (SAtom(to-string new-offset)) ))))
(set ctx (FCtxBind( (close rst) k kt new-f )))
)))
))
))
( _ (set ctx (FCtxBind( (close rst) k kt f ))) )
))
)))
))
(close ctx)
)) FContext[]);
compile-stack-call-push-args := λ(: ctx FContext)(: args AST)(: inner-offset I64). (: (tail(
(let args-type (maybe-deref(typeof args)))
(let args-size (typecheck-aligned-sizeof args-type))
(let stack-offset 0_i64)
# is stack-offset really just zero here? TODO confirm
(let translate-delta (-( 8_i64 inner-offset )))
(let ctx-2 (maybe-deref(compile-translate-local-variables( ctx translate-delta ))))(set ctx ctx-2)
(let r (maybe-deref(fragment::new())))
(let e1 (maybe-deref(compile-push-rvalue( ctx args stack-offset ))))
(set r e1)
r
)) Fragment);
as-branch-conditional := λ(: f Fragment). (: (tail(
(let ft (maybe-deref(fragment::get-type f)))
(match (slot( ft 'BranchConditional_s )) (
()
( (TGround( 'BranchConditional_s _ )) () )
( _ (tail(
(let f-1 (maybe-deref(fragment::set-type( f (maybe-deref(t1 'BranchConditional_s)) ))))(set f f-1)
(let f-2 (maybe-deref(fragment::set( f 'expression_s (SAtom 'jne_s) ))))(set f f-2)
(let f-3 (maybe-deref(fragment::set( f 'program_s
(SCons(
(close(fragment::get( f 'program_s )))
(close(SAtom '\tcmp\s$0,\s%rax\n_s))
))
))))(set f f-3)
)))
))
f
)) Fragment);
cstring-cache := (: SSEOF StringStringList);
compile-declare-cstring := λ(: val String). (: (tail(
(let cache cstring-cache)
(let id '_s)
(while (non-zero cache) (match cache (
()
( (SSSeq( rst k v )) (
(if (==( k val )) (tail(
(set id v)
(set cache SSEOF)
)) (set cache rst))
))
)))
(if (head-string id) () (tail(
(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.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.zero\s1\n_s)) )))
(set cstring-cache (SSSeq(
(close cstring-cache) val id
)))
)))
(let r (maybe-deref(fragment::new())))
(let r-2 (maybe-deref(fragment::set( r 'expression_s (SAtom id) ))))(set r r-2)
(close r)
)) Fragment[]);
compile-maybe-push-stack := λ(: ctx FContext)(: offset I64)(: fragment Fragment)(: expression-type Type)(: sloc AST). (: (tail(
(let ft (maybe-deref(fragment::get-type( fragment ))))
(if (non-zero ft) () (set ft expression-type))
(match (slot( ft 'StackVariable_s )) (
()
( (TGround( 'StackVariable_s _ )) () )
( _ (tail(
(let f-arg (maybe-deref(fragment::set-type( fragment ft ))))(set fragment f-arg)
(let direct-type (t3( 'Arrow_s
(maybe-deref(tand( (t1 'Nil_s) (maybe-deref(tsized '0_s)) )))
ft
)))
(let f-1 (maybe-deref(fragment-apply(
ctx offset 'push_s
(FLSeq( (close FLEOF) fragment )) direct-type sloc
))))(set fragment f-1)
(let f-sz (as (typecheck-sizeof ft) I64))
(let f-2 (maybe-deref(fragment::set-offset( fragment (-( offset f-sz )) ))))(set fragment f-2)
)))
))
fragment
)) Fragment);
compile-push-rvalue := λ(: ctx FContext)(: rval AST)(: offset I64). (: (tail(
(let r (maybe-deref(fragment::new())))
(let et (maybe-deref(typeof rval)))
(match (slot( et 'Cons_s )) (
()
( (TGround( 'Cons_s (TypeSeq( (TypeSeq( TypeEOF p1 )) p2 )) )) (
(match rval (
()
( (App( le re )) (tail(
(let e1 (maybe-deref(compile-push-rvalue( ctx le offset ))))
(let e2 (maybe-deref(compile-expr( ctx re (fragment::get-offset e1) Used ))))
(let e2-2 (maybe-deref(compile-maybe-push-stack( ctx (fragment::get-offset e2) e2 p2 rval ))))(set e2 e2-2)
(let sz (typecheck-sizeof(maybe-deref(typeof rval))))
(let e2-3 (maybe-deref(fragment::set-offset( e2 (-( offset (as sz I64) )) ))))(set e2 e2-3)
(set r (maybe-deref(fragment::chain( e1 e2 ))))
)))
( u (exit-error( 'Invalid\sRvalue_s rval )))
))
))
( _ (tail(
(let sz (typecheck-sizeof(maybe-deref(typeof rval))))
(if (==( sz 0_u64 )) (tail(
(let r-1 (maybe-deref(fragment::set-context( r ctx ))))(set r r-1)
(let r-2 (maybe-deref(fragment::set-offset( r offset ))))(set r r-2)
(let r-3 (maybe-deref(fragment::set( r 'program_s (SCons( (close SNil) (close SNil) )) ))))(set r r-3)
)) (tail(
(let e1 (maybe-deref(compile-expr( ctx rval offset Used ))))
(let e1-2 (maybe-deref(compile-maybe-push-stack( ctx (fragment::get-offset e1) e1 et rval ))))(set e1 e1-2)
(let e1-3 (maybe-deref(fragment::set-offset( e1 (-( offset (as sz I64) )) ))))(set e1 e1-3)
(set r e1)
)))
)))
))
r
)) Fragment);
compile-fragment-args := λ(: ctx FContext)(: rval AST)(: offset I64). (: (tail(
(let r FLEOF)
(let et (maybe-deref(typeof rval)))
(match (slot( et 'Cons_s )) (
()
( (TGround( 'Cons_s (TypeSeq( (TypeSeq( TypeEOF p1 )) p2 )) )) (
(match rval (
()
( (App( le re )) (tail(
(let e1 (maybe-deref(compile-fragment-args( ctx le offset ))))
(let e2 (maybe-deref(compile-expr( ctx re offset Used ))))
(if (non-zero(maybe-deref(fragment::get-type e2))) () (tail(
(let e2-2 (maybe-deref(fragment::set-type( e2 p2 ))))(set e2 e2-2)
)))
(set r (FLSeq( (close e1) e2 )))
)))
( u (exit-error( 'Invalid\sRvalue_s rval )))
))
))
( _ (tail(
(let e1 (maybe-deref(compile-expr( ctx rval offset Used ))))
(if (non-zero(maybe-deref(fragment::get-type e1))) () (tail(
(let e1-2 (maybe-deref(fragment::set-type( e1 et ))))(set e1 e1-2)
)))
(set r (FLSeq( (close FLEOF) e1 )))
)))
))
r
)) FragmentList);
compile-constructor := λ(: ctx FContext)(: tag-name String)(: return-type Type)(: args-type Type)(: args AST)(: offset I64). (: (tail(
(let whitespace-sz (-( (-( (typecheck-sizeof return-type) (typecheck-sizeof args-type) )) 8_u64 )))
(let e1 (maybe-deref(compile-push-rvalue( ctx args (-( offset (as whitespace-sz I64) )) ))))
(let e1-2 (maybe-deref(fragment::set-type( e1 (maybe-deref(t1 tag-name)) ))))(set e1 e1-2)
(let args-type-sized (maybe-deref(tand(
args-type
(maybe-deref(tsized(to-string(typecheck-sizeof args-type))))
))))
(let r (maybe-deref(fragment-apply(
ctx offset 'push_s
(FLSeq( (close FLEOF) e1 )) (t3( 'Arrow_s args-type-sized return-type )) args
))))
(let r-1 (maybe-deref(fragment::set-context( r ctx ))))(set r r-1)
(let r-2 (maybe-deref(fragment::set-type( r return-type ))))(set r r-2)
(let new-offset (-( offset (as (typecheck-sizeof return-type) I64) )))
(let r-3 (maybe-deref(fragment::set-offset( r new-offset ))))(set r r-3)
r
)) Fragment);