(.module: [library [lux {"-" [Type Label if let case]} [abstract ["." monad {"+" [do]}]] [control ["." function] ["ex" exception {"+" [exception:]}]] [data [collection ["." list ("#@." mix)]]] [math [number ["n" nat]]] [target [jvm ["." type {"+" [Type]} ["." category {"+" [Void Value Return Primitive Object Class Array Var Parameter Method]}] ["." descriptor {"+" [Descriptor]}] ["." signature {"+" [Signature]}]]]] [tool [compiler ["." phase ("operation@." monad)] [meta [archive {"+" [Archive]}]] [language [lux ["." synthesis {"+" [Path Synthesis]}]]]]]]] [luxc [lang [host ["$" jvm {"+" [Label Inst Operation Phase Generator]} ["_" inst]]]]] ["." // ["." runtime] ["." structure]]) (def: (pop_altI stack_depth) (-> Nat Inst) (.case stack_depth 0 function.identity 1 _.POP 2 _.POP2 _ ... (n.> 2) (|>> _.POP2 (pop_altI (n.- 2 stack_depth))))) (def: peekI Inst (|>> _.DUP (_.int +0) _.AALOAD)) (def: pushI Inst (_.INVOKESTATIC //.$Runtime "pm_push" (type.method [(list) (list runtime.$Stack //.$Value) runtime.$Stack (list)]))) (def: popI (|>> (_.int +1) _.AALOAD (_.CHECKCAST runtime.$Stack))) (def: (leftsI value) (-> Nat Inst) (.case value 0 _.ICONST_0 1 _.ICONST_1 2 _.ICONST_2 3 _.ICONST_3 4 _.ICONST_4 5 _.ICONST_5 _ (_.int (.int value)))) (def: projectionJT (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])) (def: (left_projection lefts) (-> Nat Inst) (.let [[indexI accessI] (.case lefts 0 [_.ICONST_0 _.AALOAD] lefts [(leftsI lefts) (_.INVOKESTATIC //.$Runtime "tuple_left" ..projectionJT)])] (|>> (_.CHECKCAST //.$Tuple) indexI accessI))) (def: (right_projection lefts) (-> Nat Inst) (|>> (_.CHECKCAST //.$Tuple) (leftsI lefts) (_.INVOKESTATIC //.$Runtime "tuple_right" ..projectionJT))) (def: equalsJT (type.method [(list) (list //.$Value) type.boolean (list)])) (def: sideJT (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) (def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) (.case path #synthesis.Pop (operation@in ..popI) (#synthesis.Bind register) (operation@in (|>> peekI (_.ASTORE register))) (#synthesis.Bit_Fork when thenP elseP) (do phase.monad [thenG (path' stack_depth @else @end phase archive thenP) elseG (.case elseP (#.Some elseP) (path' stack_depth @else @end phase archive elseP) #.None (in (_.GOTO @else))) .let [ifI (.if when _.IFEQ _.IFNE)]] (in (<| _.with_label (function (_ @else)) (|>> peekI (_.unwrap type.boolean) (ifI @else) thenG (_.label @else) elseG)))) (^template [ ] [( cons) (do {@ phase.monad} [forkG (: (Operation Inst) (monad.mix @ (function (_ [test thenP] elseG) (do @ [thenG (path' stack_depth @else @end phase archive thenP)] (in (<| _.with_label (function (_ @else)) (|>> ( test) ( @else) thenG (_.label @else) elseG))))) (|>> (_.GOTO @else)) (#.Item cons)))] (in (|>> peekI forkG)))]) ([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] [#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] [#synthesis.Text_Fork (|>) _.DUP _.POP _.string (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" ..equalsJT) _.IFEQ]) (#synthesis.Then bodyS) (do phase.monad [bodyI (phase archive bodyS)] (in (|>> (pop_altI stack_depth) bodyI (_.GOTO @end)))) (^template [ ] [(^ ( lefts)) (operation@in (<| _.with_label (function (_ @success)) _.with_label (function (_ @fail)) (|>> peekI (_.CHECKCAST //.$Variant) (structure.tagI lefts ) (structure.flagI ) (_.INVOKESTATIC //.$Runtime "pm_variant" ..sideJT) _.DUP (_.IFNULL @fail) (_.GOTO @success) (_.label @fail) _.POP (_.GOTO @else) (_.label @success) pushI)))]) ([synthesis.side/left false] [synthesis.side/right true]) ... Extra optimization (^template [ ] [(^ ( lefts)) (operation@in (|>> peekI ( lefts) pushI)) (^ (synthesis.path/seq ( lefts) (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] (in (|>> peekI ( lefts) (_.ASTORE register) then!)))]) ([synthesis.member/left ..left_projection] [synthesis.member/right ..right_projection]) (#synthesis.Seq leftP rightP) (do phase.monad [leftI (path' stack_depth @else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] (in (|>> leftI rightI))) (#synthesis.Alt leftP rightP) (do phase.monad [@alt_else _.make_label leftI (path' (++ stack_depth) @alt_else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] (in (|>> _.DUP leftI (_.label @alt_else) _.POP rightI))) )) (def: failJT (type.method [(list) (list) type.void (list)])) (def: (path @end phase archive path) (-> Label Phase Archive Path (Operation Inst)) (do phase.monad [@else _.make_label pathI (..path' 1 @else @end phase archive path)] (in (|>> pathI (_.label @else) _.POP (_.INVOKESTATIC //.$Runtime "pm_fail" ..failJT) _.NULL (_.GOTO @end))))) (def: .public (if phase archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) (do phase.monad [testI (phase archive testS) thenI (phase archive thenS) elseI (phase archive elseS)] (in (<| _.with_label (function (_ @else)) _.with_label (function (_ @end)) (|>> testI (_.unwrap type.boolean) (_.IFEQ @else) thenI (_.GOTO @end) (_.label @else) elseI (_.label @end)))))) (def: .public (let phase archive [inputS register exprS]) (Generator [Synthesis Nat Synthesis]) (do phase.monad [inputI (phase archive inputS) exprI (phase archive exprS)] (in (|>> inputI (_.ASTORE register) exprI)))) (def: .public (get phase archive [path recordS]) (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] (in (list@mix (function (_ step so_far) (.let [next (.case step (#.Left lefts) (..left_projection lefts) (#.Right lefts) (..right_projection lefts))] (|>> so_far next))) recordG (list.reversed path))))) (def: .public (case phase archive [valueS path]) (Generator [Synthesis Path]) (do phase.monad [@end _.make_label valueI (phase archive valueS) pathI (..path @end phase archive path)] (in (|>> _.NULL valueI pushI pathI (_.label @end)))))