aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/procedure
diff options
context:
space:
mode:
authorEduardo Julian2017-10-12 01:27:48 -0400
committerEduardo Julian2017-10-12 01:27:48 -0400
commitf3acc0d67e6cd4e7245c1e169a3c0469da4373a3 (patch)
tree9ed4796b085abb535ae6bee2f804166c30787691 /new-luxc/source/luxc/generator/procedure
parent1594c2c866db18c6c5360ae2451ffd38b879fc49 (diff)
- Compilation and tests for primitive conversions.
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/generator/procedure.jvm.lux14
-rw-r--r--new-luxc/source/luxc/generator/procedure/common.jvm.lux29
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux106
3 files changed, 134 insertions, 15 deletions
diff --git a/new-luxc/source/luxc/generator/procedure.jvm.lux b/new-luxc/source/luxc/generator/procedure.jvm.lux
index 524513eb5..c564a668a 100644
--- a/new-luxc/source/luxc/generator/procedure.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure.jvm.lux
@@ -4,16 +4,22 @@
(lux (control [monad #+ do])
(data [maybe]
text/format
- (coll ["d" dict])))
+ (coll [dict])))
(luxc ["&" base]
(lang ["ls" synthesis])
- (generator (procedure ["&&;" common])
- (host ["$" jvm]))))
+ (generator (host ["$" jvm])))
+ (. ["./;" common]
+ ["./;" host]))
+
+(def: procedures
+ ./common;Bundle
+ (|> ./common;procedures
+ (dict;merge ./host;procedures)))
(def: #export (generate-procedure generate name args)
(-> (-> ls;Synthesis (Lux $;Inst)) Text (List ls;Synthesis)
(Lux $;Inst))
(<| (maybe;default (&;fail (format "Unknown procedure: " (%t name))))
(do maybe;Monad<Maybe>
- [proc (d;get name &&common;procedures)]
+ [proc (dict;get name procedures)]
(wrap (proc generate args)))))
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)
+ )))