diff options
Diffstat (limited to 'new-luxc/source/luxc/generator/procedure')
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure/common.jvm.lux | 29 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure/host.jvm.lux | 106 |
2 files changed, 124 insertions, 11 deletions
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux index ffbe69708..70f38f962 100644 --- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux @@ -34,22 +34,22 @@ (#static NEGATIVE_INFINITY Double)) ## [Types] -(type: Generator +(type: #export Generator (-> ls;Synthesis (Lux $;Inst))) -(type: Proc +(type: #export Proc (-> Generator (List ls;Synthesis) (Lux $;Inst))) -(type: Bundle +(type: #export Bundle (Dict Text Proc)) (syntax: (Vector [size s;nat] elemT) (wrap (list (` [(~@ (list;repeat size elemT))])))) -(type: Nullary (-> (Vector +0 $;Inst) $;Inst)) -(type: Unary (-> (Vector +1 $;Inst) $;Inst)) -(type: Binary (-> (Vector +2 $;Inst) $;Inst)) -(type: Trinary (-> (Vector +3 $;Inst) $;Inst)) +(type: #export Nullary (-> (Vector +0 $;Inst) $;Inst)) +(type: #export Unary (-> (Vector +1 $;Inst) $;Inst)) +(type: #export Binary (-> (Vector +2 $;Inst) $;Inst)) +(type: #export Trinary (-> (Vector +3 $;Inst) $;Inst)) ## [Utils] (def: $Object $;Type ($t;class "java.lang.Object" (list))) @@ -58,12 +58,19 @@ (def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list))) (def: $Function $;Type ($t;class &runtime;function-class (list))) -(def: (install name unnamed) +(def: #export (install name unnamed) (-> Text (-> Text Proc) (-> Bundle Bundle)) (dict;put name (unnamed name))) -(def: (wrong-amount-error proc expected actual) +(def: #export (prefix prefix bundle) + (-> Text Bundle Bundle) + (|> bundle + dict;entries + (list/map (function [[key val]] [(format prefix " " key) val])) + (dict;from-list text;Hash<Text>))) + +(def: (wrong-arity proc expected actual) (-> Text Nat Nat Text) (format "Wrong number of arguments for " (%t proc) "\n" "Expected: " (|> expected nat-to-int %i) "\n" @@ -73,7 +80,7 @@ (with-gensyms [g!proc g!name g!generate g!inputs] (do @ [g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))] - (wrap (list (` (def: ((~ (code;local-symbol name)) (~ g!proc)) + (wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc)) (-> (-> (Vector (~ (code;nat arity)) $;Inst) $;Inst) (-> Text Proc)) (function [(~ g!name)] @@ -88,7 +95,7 @@ ((~' wrap) ((~ g!proc) [(~@ g!input+)]))) (~' _) - (macro;fail (wrong-amount-error (~ g!name) +1 (list;size (~ g!inputs)))))))))))))) + (macro;fail (wrong-arity (~ g!name) +1 (list;size (~ g!inputs)))))))))))))) (arity: nullary +0) (arity: unary +1) diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux new file mode 100644 index 000000000..66b7bc77e --- /dev/null +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -0,0 +1,106 @@ +(;module: + lux + (lux (control [monad #+ do]) + (data [text] + text/format + (coll [list "list/" Functor<List>] + [dict #+ Dict])) + [macro #+ with-gensyms] + (macro [code] + ["s" syntax #+ syntax:]) + [host]) + (luxc ["&" base] + (lang ["la" analysis] + ["ls" synthesis]) + ["&;" analyser] + ["&;" synthesizer] + (synthesizer [function]) + (generator ["&;" common] + ["&;" runtime] + (host ["$" jvm] + (jvm ["$t" type] + ["$d" def] + ["$i" inst])))) + ["@" ../common]) + +(do-template [<name> <inst>] + [(def: <name> + $;Inst + <inst>)] + + [L2S (|>. $i;L2I $i;I2S)] + [L2B (|>. $i;L2I $i;I2B)] + ) + +(do-template [<name> <unwrap> <conversion> <wrap>] + [(def: (<name> inputI) + @;Unary + (if (is $i;NOP <conversion>) + (|>. inputI + ($i;unwrap <unwrap>) + ($i;wrap <wrap>)) + (|>. inputI + ($i;unwrap <unwrap>) + <conversion> + ($i;wrap <wrap>))))] + + [convert//double-to-float #$;Double $i;D2F #$;Float] + [convert//double-to-int #$;Double $i;D2I #$;Int] + [convert//double-to-long #$;Double $i;D2L #$;Long] + [convert//float-to-double #$;Float $i;F2D #$;Double] + [convert//float-to-int #$;Float $i;F2I #$;Int] + [convert//float-to-long #$;Float $i;F2L #$;Long] + [convert//int-to-byte #$;Int $i;I2B #$;Byte] + [convert//int-to-char #$;Int $i;I2C #$;Char] + [convert//int-to-double #$;Int $i;I2D #$;Double] + [convert//int-to-float #$;Int $i;I2F #$;Float] + [convert//int-to-long #$;Int $i;I2L #$;Long] + [convert//int-to-short #$;Int $i;I2S #$;Short] + [convert//long-to-double #$;Long $i;L2D #$;Double] + [convert//long-to-float #$;Long $i;L2F #$;Float] + [convert//long-to-int #$;Long $i;L2I #$;Int] + [convert//long-to-short #$;Long L2S #$;Short] + [convert//long-to-byte #$;Long L2B #$;Byte] + [convert//char-to-byte #$;Char $i;I2B #$;Byte] + [convert//char-to-short #$;Char $i;I2S #$;Short] + [convert//char-to-int #$;Char $i;NOP #$;Int] + [convert//char-to-long #$;Char $i;I2L #$;Long] + [convert//byte-to-long #$;Byte $i;I2L #$;Long] + [convert//short-to-long #$;Short $i;I2L #$;Long] + ) + +(def: conversion-procs + @;Bundle + (<| (@;prefix "convert") + (|> (dict;new text;Hash<Text>) + (@;install "double-to-float" (@;unary convert//double-to-float)) + (@;install "double-to-int" (@;unary convert//double-to-int)) + (@;install "double-to-long" (@;unary convert//double-to-long)) + (@;install "float-to-double" (@;unary convert//float-to-double)) + (@;install "float-to-int" (@;unary convert//float-to-int)) + (@;install "float-to-long" (@;unary convert//float-to-long)) + (@;install "int-to-byte" (@;unary convert//int-to-byte)) + (@;install "int-to-char" (@;unary convert//int-to-char)) + (@;install "int-to-double" (@;unary convert//int-to-double)) + (@;install "int-to-float" (@;unary convert//int-to-float)) + (@;install "int-to-long" (@;unary convert//int-to-long)) + (@;install "int-to-short" (@;unary convert//int-to-short)) + (@;install "long-to-double" (@;unary convert//long-to-double)) + (@;install "long-to-float" (@;unary convert//long-to-float)) + (@;install "long-to-int" (@;unary convert//long-to-int)) + (@;install "long-to-short" (@;unary convert//long-to-short)) + (@;install "long-to-byte" (@;unary convert//long-to-byte)) + (@;install "char-to-byte" (@;unary convert//char-to-byte)) + (@;install "char-to-short" (@;unary convert//char-to-short)) + (@;install "char-to-int" (@;unary convert//char-to-int)) + (@;install "char-to-long" (@;unary convert//char-to-long)) + (@;install "byte-to-long" (@;unary convert//byte-to-long)) + (@;install "short-to-long" (@;unary convert//short-to-long)) + ))) + +(def: #export procedures + @;Bundle + (<| (@;prefix "jvm") + (|> (dict;new text;Hash<Text>) + (dict;merge conversion-procs) + ))) |