aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/luxc/lang/translation/jvm/case.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm/case.lux')
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux301
1 files changed, 0 insertions, 301 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
deleted file mode 100644
index cb5004f83..000000000
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ /dev/null
@@ -1,301 +0,0 @@
-(.using
- [library
- [lux {"-" Type Label Primitive if exec let case}
- [abstract
- ["[0]" monad {"+" do}]]
- [control
- ["[0]" function]
- ["ex" exception {"+" exception:}]]
- [data
- [collection
- ["[0]" list ("[1]@[0]" mix)]]]
- [macro
- ["^" pattern]]
- [math
- [number
- ["n" nat]]]
- [target
- [jvm
- ["[0]" type {"+" Type}
- ["[0]" category {"+" Void Value Return Primitive Object Class Array Var Parameter Method}]
- ["[0]" descriptor {"+" Descriptor}]
- ["[0]" signature {"+" Signature}]]]]
- [tool
- [compiler
- ["[0]" phase ("operation@[0]" monad)]
- [meta
- [archive {"+" Archive}]]
- [language
- [lux
- ["[0]" synthesis {"+" Path Synthesis}]]]]]]]
- [luxc
- [lang
- [host
- ["$" jvm {"+" Label Inst Operation Phase Generator}
- ["_" inst]]]]]
- ["[0]" //
- ["[0]" runtime]
- ["[0]" 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.$Lefts runtime.$Right?) 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 [<tag> <unwrap> <dup> <pop> <test> <comparison> <if>]
- [{<tag> cons}
- (do [@ phase.monad]
- [forkG (is (Operation Inst)
- (monad.mix @ (function (_ [test thenP] elseG)
- (do @
- [thenG (path' stack_depth @else @end phase archive thenP)]
- (in (<| _.with_label (function (_ @else))
- (|>> <dup>
- (<test> test)
- <comparison>
- (<if> @else)
- <pop>
- thenG
- (_.label @else)
- elseG)))))
- (|>> <pop>
- (_.GOTO @else))
- {.#Item cons}))]
- (in (|>> peekI
- <unwrap>
- 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 [<pattern> <right?>]
- [(pattern (<pattern> lefts))
- (operation@in (<| _.with_label (function (_ @success))
- _.with_label (function (_ @fail))
- (|>> peekI
- (_.CHECKCAST //.$Variant)
- (structure.tagI lefts <right?>)
- (structure.flagI <right?>)
- (_.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 [<path> <projection>]
- [(pattern (<path> lefts))
- (operation@in (|>> peekI
- (<projection> lefts)
- pushI))
-
- (pattern (synthesis.path/seq
- (<path> lefts)
- (synthesis.!bind_top register thenP)))
- (do phase.monad
- [then! (path' stack_depth @else @end phase archive thenP)]
- (in (|>> peekI
- (<projection> 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 (exec phase archive [this that])
- (Generator [Synthesis Synthesis])
- (do phase.monad
- [this! (phase archive this)
- that! (phase archive that)]
- (in (|>> this!
- _.POP
- that!))))
-
-(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)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 23:00:16 +0000