(;module: lux (lux (control [monad #+ do]) (data [text] text/format (coll [list "list/" Functor] [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 [ ] [(def: $;Inst )] [L2S (|>. $i;L2I $i;I2S)] [L2B (|>. $i;L2I $i;I2B)] ) (do-template [ ] [(def: ( inputI) @;Unary (if (is $i;NOP ) (|>. inputI ($i;unwrap ) ($i;wrap )) (|>. inputI ($i;unwrap ) ($i;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) (@;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)) ))) (do-template [ ] [(def: ( [xI yI]) @;Binary (|>. xI ($i;unwrap ) yI ($i;unwrap ) ($i;wrap )))] [int//+ $i;IADD #$;Int #$;Int #$;Int] [int//- $i;ISUB #$;Int #$;Int #$;Int] [int//* $i;IMUL #$;Int #$;Int #$;Int] [int/// $i;IDIV #$;Int #$;Int #$;Int] [int//% $i;IREM #$;Int #$;Int #$;Int] [int//and $i;IAND #$;Int #$;Int #$;Int] [int//or $i;IOR #$;Int #$;Int #$;Int] [int//xor $i;IXOR #$;Int #$;Int #$;Int] [int//shl $i;ISHL #$;Int #$;Int #$;Int] [int//shr $i;ISHR #$;Int #$;Int #$;Int] [int//ushr $i;IUSHR #$;Int #$;Int #$;Int] [long//+ $i;LADD #$;Long #$;Long #$;Long] [long//- $i;LSUB #$;Long #$;Long #$;Long] [long//* $i;LMUL #$;Long #$;Long #$;Long] [long/// $i;LDIV #$;Long #$;Long #$;Long] [long//% $i;LREM #$;Long #$;Long #$;Long] [long//and $i;LAND #$;Long #$;Long #$;Long] [long//or $i;LOR #$;Long #$;Long #$;Long] [long//xor $i;LXOR #$;Long #$;Long #$;Long] [long//shl $i;LSHL #$;Long #$;Int #$;Long] [long//shr $i;LSHR #$;Long #$;Int #$;Long] [long//ushr $i;LUSHR #$;Long #$;Int #$;Long] [float//+ $i;FADD #$;Float #$;Float #$;Float] [float//- $i;FSUB #$;Float #$;Float #$;Float] [float//* $i;FMUL #$;Float #$;Float #$;Float] [float/// $i;FDIV #$;Float #$;Float #$;Float] [float//% $i;FREM #$;Float #$;Float #$;Float] [double//+ $i;DADD #$;Double #$;Double #$;Double] [double//- $i;DSUB #$;Double #$;Double #$;Double] [double//* $i;DMUL #$;Double #$;Double #$;Double] [double/// $i;DDIV #$;Double #$;Double #$;Double] [double//% $i;DREM #$;Double #$;Double #$;Double] ) (do-template [ ] [(def: ( [xI yI]) @;Binary (<| $i;with-label (function [@then]) $i;with-label (function [@end]) (|>. xI ($i;unwrap ) yI ($i;unwrap ) ( @then) ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list))) ($i;GOTO @end) ($i;label @then) ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list))) ($i;label @end))))] [int//= $i;IF_ICMPEQ #$;Int #$;Int #$;Boolean] [int//< $i;IF_ICMPLT #$;Int #$;Int #$;Boolean] [char//= $i;IF_ICMPEQ #$;Char #$;Char #$;Boolean] [char//< $i;IF_ICMPLT #$;Char #$;Char #$;Boolean] ) (do-template [ ] [(def: ( [xI yI]) @;Binary (<| $i;with-label (function [@then]) $i;with-label (function [@end]) (|>. xI ($i;unwrap ) yI ($i;unwrap ) ($i;int ) ($i;IF_ICMPEQ @then) ($i;GETSTATIC "java.lang.Boolean" "FALSE" ($t;class "java.lang.Boolean" (list))) ($i;GOTO @end) ($i;label @then) ($i;GETSTATIC "java.lang.Boolean" "TRUE" ($t;class "java.lang.Boolean" (list))) ($i;label @end))))] [long//= $i;LCMP 0 #$;Long #$;Long #$;Boolean] [long//< $i;LCMP -1 #$;Long #$;Long #$;Boolean] [float//= $i;FCMPG 0 #$;Float #$;Float #$;Boolean] [float//< $i;FCMPG -1 #$;Float #$;Float #$;Boolean] [double//= $i;DCMPG 0 #$;Double #$;Double #$;Boolean] [double//< $i;DCMPG -1 #$;Double #$;Double #$;Boolean] ) (def: int-procs @;Bundle (<| (@;prefix "int") (|> (dict;new text;Hash) (@;install "+" (@;binary int//+)) (@;install "-" (@;binary int//-)) (@;install "*" (@;binary int//*)) (@;install "/" (@;binary int///)) (@;install "%" (@;binary int//%)) (@;install "=" (@;binary int//=)) (@;install "<" (@;binary int//<)) (@;install "and" (@;binary int//and)) (@;install "or" (@;binary int//or)) (@;install "xor" (@;binary int//xor)) (@;install "shl" (@;binary int//shl)) (@;install "shr" (@;binary int//shr)) (@;install "ushr" (@;binary int//ushr)) ))) (def: long-procs @;Bundle (<| (@;prefix "long") (|> (dict;new text;Hash) (@;install "+" (@;binary long//+)) (@;install "-" (@;binary long//-)) (@;install "*" (@;binary long//*)) (@;install "/" (@;binary long///)) (@;install "%" (@;binary long//%)) (@;install "=" (@;binary long//=)) (@;install "<" (@;binary long//<)) (@;install "and" (@;binary long//and)) (@;install "or" (@;binary long//or)) (@;install "xor" (@;binary long//xor)) (@;install "shl" (@;binary long//shl)) (@;install "shr" (@;binary long//shr)) (@;install "ushr" (@;binary long//ushr)) ))) (def: float-procs @;Bundle (<| (@;prefix "float") (|> (dict;new text;Hash) (@;install "+" (@;binary float//+)) (@;install "-" (@;binary float//-)) (@;install "*" (@;binary float//*)) (@;install "/" (@;binary float///)) (@;install "%" (@;binary float//%)) (@;install "=" (@;binary float//=)) (@;install "<" (@;binary float//<)) ))) (def: double-procs @;Bundle (<| (@;prefix "double") (|> (dict;new text;Hash) (@;install "+" (@;binary double//+)) (@;install "-" (@;binary double//-)) (@;install "*" (@;binary double//*)) (@;install "/" (@;binary double///)) (@;install "%" (@;binary double//%)) (@;install "=" (@;binary double//=)) (@;install "<" (@;binary double//<)) ))) (def: char-procs @;Bundle (<| (@;prefix "char") (|> (dict;new text;Hash) (@;install "=" (@;binary char//=)) (@;install "<" (@;binary char//<)) ))) (def: #export procedures @;Bundle (<| (@;prefix "jvm") (|> (dict;new text;Hash) (dict;merge conversion-procs) (dict;merge int-procs) (dict;merge long-procs) (dict;merge float-procs) (dict;merge double-procs) (dict;merge char-procs) )))