diff options
author | Eduardo Julian | 2017-10-12 18:14:19 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-10-12 18:14:19 -0400 |
commit | 4b672d27a1a1a79643c43cf06917072cc97c1289 (patch) | |
tree | 6136e952c0e87172921ad4bf5c0ee128a085a0ba /new-luxc/source/luxc/generator/procedure/host.jvm.lux | |
parent | 50c370878c0f9985a8b6d1003af9e9f6282b853e (diff) |
- Compilation and tests for arrays.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/generator/procedure/host.jvm.lux | 97 |
1 files changed, 97 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux index c99c23385..128e8b517 100644 --- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -261,6 +261,102 @@ (@;install "<" (@;binary char//<)) ))) +(def: (array//length arrayI) + @;Unary + (|>. arrayI + $i;ARRAYLENGTH + $i;I2L + ($i;wrap #$;Long))) + +(def: (array//new proc generate inputs) + (-> Text @;Proc) + (case inputs + (^ (list (#ls;Nat level) (#ls;Text class) lengthS)) + (do macro;Monad<Lux> + [lengthI (generate lengthS) + #let [arrayJT ($t;array level (case class + "boolean" $t;boolean + "byte" $t;byte + "short" $t;short + "int" $t;int + "long" $t;long + "float" $t;float + "double" $t;double + "char" $t;char + _ ($t;class class (list))))]] + (wrap (|>. lengthI + ($i;unwrap #$;Long) + $i;L2I + ($i;array arrayJT)))) + + _ + (&;fail (format "Wrong syntax for '" proc "'.")))) + +(def: (array//read proc generate inputs) + (-> Text @;Proc) + (case inputs + (^ (list (#ls;Text class) idxS arrayS)) + (do macro;Monad<Lux> + [arrayI (generate arrayS) + idxI (generate idxS) + #let [loadI (case class + "boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean)) + "byte" (|>. $i;BALOAD ($i;wrap #$;Byte)) + "short" (|>. $i;SALOAD ($i;wrap #$;Short)) + "int" (|>. $i;IALOAD ($i;wrap #$;Int)) + "long" (|>. $i;LALOAD ($i;wrap #$;Long)) + "float" (|>. $i;FALOAD ($i;wrap #$;Float)) + "double" (|>. $i;DALOAD ($i;wrap #$;Double)) + "char" (|>. $i;CALOAD ($i;wrap #$;Char)) + _ $i;AALOAD)]] + (wrap (|>. arrayI + idxI + ($i;unwrap #$;Long) + $i;L2I + loadI))) + + _ + (&;fail (format "Wrong syntax for '" proc "'.")))) + +(def: (array//write proc generate inputs) + (-> Text @;Proc) + (case inputs + (^ (list (#ls;Text class) idxS valueS arrayS)) + (do macro;Monad<Lux> + [arrayI (generate arrayS) + idxI (generate idxS) + valueI (generate valueS) + #let [storeI (case class + "boolean" (|>. ($i;unwrap #$;Boolean) $i;BASTORE) + "byte" (|>. ($i;unwrap #$;Byte) $i;BASTORE) + "short" (|>. ($i;unwrap #$;Short) $i;SASTORE) + "int" (|>. ($i;unwrap #$;Int) $i;IASTORE) + "long" (|>. ($i;unwrap #$;Long) $i;LASTORE) + "float" (|>. ($i;unwrap #$;Float) $i;FASTORE) + "double" (|>. ($i;unwrap #$;Double) $i;DASTORE) + "char" (|>. ($i;unwrap #$;Char) $i;CASTORE) + _ $i;AASTORE)]] + (wrap (|>. arrayI + $i;DUP + idxI + ($i;unwrap #$;Long) + $i;L2I + valueI + storeI))) + + _ + (&;fail (format "Wrong syntax for '" proc "'.")))) + +(def: array-procs + @;Bundle + (<| (@;prefix "array") + (|> (dict;new text;Hash<Text>) + (@;install "length" (@;unary array//length)) + (@;install "new" array//new) + (@;install "read" array//read) + (@;install "write" array//write) + ))) + (def: #export procedures @;Bundle (<| (@;prefix "jvm") @@ -271,4 +367,5 @@ (dict;merge float-procs) (dict;merge double-procs) (dict;merge char-procs) + (dict;merge array-procs) ))) |