diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux | 70 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux | 112 | 
2 files changed, 93 insertions, 89 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux index aeaa1d664..cead0848e 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux @@ -1,5 +1,5 @@  (.module: -  [lux #* +  [lux (#- Type)     [abstract      ["." monad (#+ do)]]     [control @@ -10,6 +10,9 @@       format]      [collection       ["." dictionary]]] +   [target +    [jvm +     ["_t" type (#+ Type Method)]]]     [tool      [compiler       ["." synthesis (#+ Synthesis)] @@ -23,8 +26,7 @@    [luxc     [lang      [host -     ["$" jvm (#+ Label Inst Method Bundle) -      ["_t" type] +     ["$" jvm (#+ Label Inst Bundle)        ["_" inst]]]]]    ["." ///     ["." runtime]]) @@ -33,12 +35,12 @@    (#static MIN_VALUE Double)    (#static MAX_VALUE Double)) -(def: $Object-Array $.Type (_t.array 1 ///.$Object)) -(def: $String $.Type (_t.class "java.lang.String" (list))) -(def: $CharSequence $.Type (_t.class "java.lang.CharSequence" (list))) +(def: $Object-Array Type (_t.array 1 ///.$Object)) +(def: $String Type (_t.class "java.lang.String" (list))) +(def: $CharSequence Type (_t.class "java.lang.CharSequence" (list))) -(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long))) -(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I)) +(def: lux-intI Inst (|>> _.I2L (_.wrap #_t.Long))) +(def: jvm-intI Inst (|>> (_.unwrap #_t.Long) _.L2I))  (def: check-stringI Inst (_.CHECKCAST "java.lang.String"))  (def: (predicateI tester) @@ -73,9 +75,9 @@  (template [<name> <op>]    [(def: (<name> [maskI inputI])       (Binary Inst) -     (|>> inputI (_.unwrap #$.Long) -          maskI (_.unwrap #$.Long) -          <op> (_.wrap #$.Long)))] +     (|>> inputI (_.unwrap #_t.Long) +          maskI (_.unwrap #_t.Long) +          <op> (_.wrap #_t.Long)))]    [bit::and _.LAND]    [bit::or  _.LOR] @@ -85,10 +87,10 @@  (template [<name> <op>]    [(def: (<name> [shiftI inputI])       (Binary Inst) -     (|>> inputI (_.unwrap #$.Long) +     (|>> inputI (_.unwrap #_t.Long)            shiftI jvm-intI            <op> -          (_.wrap #$.Long)))] +          (_.wrap #_t.Long)))]    [bit::left-shift             _.LSHL]    [bit::arithmetic-right-shift _.LSHR] @@ -100,9 +102,9 @@       (Nullary Inst)       (|>> <const> (_.wrap <type>)))] -  [frac::smallest (_.double (Double::MIN_VALUE))            #$.Double] -  [frac::min      (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double] -  [frac::max      (_.double (Double::MAX_VALUE))            #$.Double] +  [frac::smallest (_.double (Double::MIN_VALUE))            #_t.Double] +  [frac::min      (_.double (f/* -1.0 (Double::MAX_VALUE))) #_t.Double] +  [frac::max      (_.double (Double::MAX_VALUE))            #_t.Double]    )  (template [<name> <type> <op>] @@ -113,17 +115,17 @@            <op>            (_.wrap <type>)))] -  [i64::+  #$.Long   _.LADD] -  [i64::-  #$.Long   _.LSUB] -  [int::*  #$.Long   _.LMUL] -  [int::/  #$.Long   _.LDIV] -  [int::%  #$.Long   _.LREM] +  [i64::+  #_t.Long   _.LADD] +  [i64::-  #_t.Long   _.LSUB] +  [int::*  #_t.Long   _.LMUL] +  [int::/  #_t.Long   _.LDIV] +  [int::%  #_t.Long   _.LREM] -  [frac::+ #$.Double _.DADD] -  [frac::- #$.Double _.DSUB] -  [frac::* #$.Double _.DMUL] -  [frac::/ #$.Double _.DDIV] -  [frac::% #$.Double _.DREM] +  [frac::+ #_t.Double _.DADD] +  [frac::- #_t.Double _.DSUB] +  [frac::* #_t.Double _.DMUL] +  [frac::/ #_t.Double _.DDIV] +  [frac::% #_t.Double _.DREM]    )  (template [<eq> <lt> <unwrap> <cmp>] @@ -139,8 +141,8 @@       [<eq> +0]       [<lt> -1])] -  [i64::= int::< (_.unwrap #$.Long)   _.LCMP] -  [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] +  [i64::= int::< (_.unwrap #_t.Long)   _.LCMP] +  [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG]    )  (template [<name> <prepare> <transform>] @@ -148,12 +150,12 @@       (Unary Inst)       (|>> inputI <prepare> <transform>))] -  [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] -  [int::char (_.unwrap #$.Long) +  [int::frac (_.unwrap #_t.Long) (<| (_.wrap #_t.Double) _.L2D)] +  [int::char (_.unwrap #_t.Long)     ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))] -  [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] -  [frac::encode (_.unwrap #$.Double) +  [frac::int (_.unwrap #_t.Double) (<| (_.wrap #_t.Long) _.D2L)] +  [frac::encode (_.unwrap #_t.Double)     (_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]    [frac::decode ..check-stringI     (_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)] @@ -175,7 +177,7 @@    [text::= (<|) (<|)     (_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0) -   (_.wrap #$.Boolean)] +   (_.wrap #_t.Boolean)]    [text::< ..check-stringI ..check-stringI     (_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)     (predicateI _.IFLT)] @@ -244,7 +246,7 @@  (def: (io::current-time _)    (Nullary Inst)    (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0) -       (_.wrap #$.Long))) +       (_.wrap #_t.Long)))  (def: bundle::lux    Bundle diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux index c4bc66923..7d9cd9cc5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux @@ -1,5 +1,5 @@  (.module: -  [lux (#- int char) +  [lux (#- Type int char)     [abstract      ["." monad (#+ do)]]     [control @@ -14,6 +14,9 @@      [collection       ["." list ("#@." functor)]       ["." dictionary (#+ Dictionary)]]] +   [target +    [jvm +     ["_t" type (#+ Primitive Type Method)]]]     [tool      [compiler       ["." synthesis (#+ Synthesis %synthesis)] @@ -27,8 +30,7 @@    [luxc     [lang      [host -     ["$" jvm (#+ Primitive Label Inst Method Handler Bundle Operation) -      ["_t" type] +     ["$" jvm (#+ Label Inst Handler Bundle Operation)        ["_" inst]]]]])  (template [<name>] @@ -57,30 +59,30 @@         (|>> inputI              <conversion>)))] -  [conversion::double-to-float #$.Double _.D2F #$.Float] -  [conversion::double-to-int #$.Double _.D2I #$.Int] -  [conversion::double-to-long #$.Double _.D2L #$.Long] -  [conversion::float-to-double #$.Float _.F2D #$.Double] -  [conversion::float-to-int #$.Float _.F2I #$.Int] -  [conversion::float-to-long #$.Float _.F2L #$.Long] -  [conversion::int-to-byte #$.Int _.I2B #$.Byte] -  [conversion::int-to-char #$.Int _.I2C #$.Char] -  [conversion::int-to-double #$.Int _.I2D #$.Double] -  [conversion::int-to-float #$.Int _.I2F #$.Float] -  [conversion::int-to-long #$.Int _.I2L #$.Long] -  [conversion::int-to-short #$.Int _.I2S #$.Short] -  [conversion::long-to-double #$.Long _.L2D #$.Double] -  [conversion::long-to-float #$.Long _.L2F #$.Float] -  [conversion::long-to-int #$.Long _.L2I #$.Int] -  [conversion::long-to-short #$.Long L2S #$.Short] -  [conversion::long-to-byte #$.Long L2B #$.Byte] -  [conversion::long-to-char #$.Long L2C #$.Char] -  [conversion::char-to-byte #$.Char _.I2B #$.Byte] -  [conversion::char-to-short #$.Char _.I2S #$.Short] -  [conversion::char-to-int #$.Char _.NOP #$.Int] -  [conversion::char-to-long #$.Char _.I2L #$.Long] -  [conversion::byte-to-long #$.Byte _.I2L #$.Long] -  [conversion::short-to-long #$.Short _.I2L #$.Long] +  [conversion::double-to-float #_t.Double _.D2F #_t.Float] +  [conversion::double-to-int #_t.Double _.D2I #_t.Int] +  [conversion::double-to-long #_t.Double _.D2L #_t.Long] +  [conversion::float-to-double #_t.Float _.F2D #_t.Double] +  [conversion::float-to-int #_t.Float _.F2I #_t.Int] +  [conversion::float-to-long #_t.Float _.F2L #_t.Long] +  [conversion::int-to-byte #_t.Int _.I2B #_t.Byte] +  [conversion::int-to-char #_t.Int _.I2C #_t.Char] +  [conversion::int-to-double #_t.Int _.I2D #_t.Double] +  [conversion::int-to-float #_t.Int _.I2F #_t.Float] +  [conversion::int-to-long #_t.Int _.I2L #_t.Long] +  [conversion::int-to-short #_t.Int _.I2S #_t.Short] +  [conversion::long-to-double #_t.Long _.L2D #_t.Double] +  [conversion::long-to-float #_t.Long _.L2F #_t.Float] +  [conversion::long-to-int #_t.Long _.L2I #_t.Int] +  [conversion::long-to-short #_t.Long L2S #_t.Short] +  [conversion::long-to-byte #_t.Long L2B #_t.Byte] +  [conversion::long-to-char #_t.Long L2C #_t.Char] +  [conversion::char-to-byte #_t.Char _.I2B #_t.Byte] +  [conversion::char-to-short #_t.Char _.I2S #_t.Short] +  [conversion::char-to-int #_t.Char _.NOP #_t.Int] +  [conversion::char-to-long #_t.Char _.I2L #_t.Long] +  [conversion::byte-to-long #_t.Byte _.I2L #_t.Long] +  [conversion::short-to-long #_t.Short _.I2L #_t.Long]    )  (def: conversion @@ -281,7 +283,7 @@            )))  (def: (array-java-type nesting elem-class) -  (-> Nat Text $.Type) +  (-> Nat Text Type)    (_t.array nesting              (case elem-class                "boolean" _t.boolean @@ -447,7 +449,7 @@        [objectI (generate objectS)]        (wrap (|>> objectI                   (_.INSTANCEOF class) -                 (_.wrap #$.Boolean)))) +                 (_.wrap #_t.Boolean))))      _      (phase.throw extension.invalid-syntax [proc %synthesis inputs]))) @@ -466,14 +468,14 @@            [<object> <primitive>]            (wrap (|>> valueI (_.unwrap <type>)))) -        (["boolean" "java.lang.Boolean"   #$.Boolean] -         ["byte"    "java.lang.Byte"      #$.Byte] -         ["short"   "java.lang.Short"     #$.Short] -         ["int"     "java.lang.Integer"   #$.Int] -         ["long"    "java.lang.Long"      #$.Long] -         ["float"   "java.lang.Float"     #$.Float] -         ["double"  "java.lang.Double"    #$.Double] -         ["char"    "java.lang.Character" #$.Char]) +        (["boolean" "java.lang.Boolean"   #_t.Boolean] +         ["byte"    "java.lang.Byte"      #_t.Byte] +         ["short"   "java.lang.Short"     #_t.Short] +         ["int"     "java.lang.Integer"   #_t.Int] +         ["long"    "java.lang.Long"      #_t.Long] +         ["float"   "java.lang.Float"     #_t.Float] +         ["double"  "java.lang.Double"    #_t.Double] +         ["char"    "java.lang.Character" #_t.Char])          _          (wrap valueI))) @@ -496,14 +498,14 @@  (def: primitives    (Dictionary Text Primitive) -  (|> (list ["boolean" #$.Boolean] -            ["byte" #$.Byte] -            ["short" #$.Short] -            ["int" #$.Int] -            ["long" #$.Long] -            ["float" #$.Float] -            ["double" #$.Double] -            ["char" #$.Char]) +  (|> (list ["boolean" #_t.Boolean] +            ["byte" #_t.Byte] +            ["short" #_t.Short] +            ["int" #_t.Int] +            ["long" #_t.Long] +            ["float" #_t.Float] +            ["double" #_t.Double] +            ["char" #_t.Char])        (dictionary.from-list text.hash)))  (def: (static::get proc generate inputs) @@ -516,7 +518,7 @@        []        (case (dictionary.get unboxed primitives)          (#.Some primitive) -        (wrap (_.GETSTATIC class field (#$.Primitive primitive))) +        (wrap (_.GETSTATIC class field (#_t.Primitive primitive)))          #.None          (wrap (_.GETSTATIC class field (_t.class unboxed (list)))))) @@ -536,7 +538,7 @@        (case (dictionary.get unboxed primitives)          (#.Some primitive)          (wrap (|>> valueI -                   (_.PUTSTATIC class field (#$.Primitive primitive)) +                   (_.PUTSTATIC class field (#_t.Primitive primitive))                     (_.string synthesis.unit)))          #.None @@ -561,7 +563,7 @@          (#.Some primitive)          (wrap (|>> objectI                     (_.CHECKCAST class) -                   (_.GETFIELD class field (#$.Primitive primitive)))) +                   (_.GETFIELD class field (#_t.Primitive primitive))))          #.None          (wrap (|>> objectI @@ -588,7 +590,7 @@                     (_.CHECKCAST class)                     _.DUP                     valueI -                   (_.PUTFIELD class field (#$.Primitive primitive)))) +                   (_.PUTFIELD class field (#_t.Primitive primitive))))          #.None          (wrap (|>> objectI @@ -602,7 +604,7 @@      (phase.throw extension.invalid-syntax [proc %synthesis inputs])))  (def: base-type -  (l.Parser $.Type) +  (l.Parser Type)    ($_ p.either        (p.after (l.this "boolean") (p@wrap _t.boolean))        (p.after (l.this "byte") (p@wrap _t.byte)) @@ -618,14 +620,14 @@        ))  (def: java-type -  (l.Parser $.Type) +  (l.Parser Type)    (do p.monad      [raw base-type       nesting (p.some (l.this "[]"))]      (wrap (_t.array (list.size nesting) raw))))  (def: (generate-type argD) -  (-> Text (Operation $.Type)) +  (-> Text (Operation Type))    (case (l.run argD java-type)      (#error.Failure error)      (phase.throw invalid-syntax-for-jvm-type argD) @@ -635,7 +637,7 @@  (def: (generate-arg generate argS)    (-> (-> Synthesis (Operation Inst)) Synthesis -      (Operation [$.Type Inst])) +      (Operation [Type Inst]))    (case argS      (^ (synthesis.tuple (list (synthesis.text argD) argS)))      (do phase.monad @@ -647,7 +649,7 @@      (phase.throw invalid-syntax-for-argument-generation "")))  (def: (method-return-type description) -  (-> Text (Operation (Maybe $.Type))) +  (-> Text (Operation (Maybe Type)))    (case description      "void"      (phase@wrap #.None) @@ -656,7 +658,7 @@      (phase@map (|>> #.Some) (generate-type description))))  (def: (prepare-argI [type argI]) -  (-> [$.Type Inst] Inst) +  (-> [Type Inst] Inst)    (case (_t.class-name type)      (#.Some class-name)      (|>> argI  | 
