From af7f85c4eb724f2888ecce9c8b52d6d3bb1cd807 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 27 Apr 2019 23:41:47 -0400 Subject: Moved JVM type machinery to stdlib. --- .../luxc/lang/translation/jvm/procedure/common.lux | 70 ++++++------- .../luxc/lang/translation/jvm/procedure/host.lux | 112 +++++++++++---------- 2 files changed, 93 insertions(+), 89 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure') 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 [ ] [(def: ( [maskI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) - maskI (_.unwrap #$.Long) - (_.wrap #$.Long)))] + (|>> inputI (_.unwrap #_t.Long) + maskI (_.unwrap #_t.Long) + (_.wrap #_t.Long)))] [bit::and _.LAND] [bit::or _.LOR] @@ -85,10 +87,10 @@ (template [ ] [(def: ( [shiftI inputI]) (Binary Inst) - (|>> inputI (_.unwrap #$.Long) + (|>> inputI (_.unwrap #_t.Long) shiftI jvm-intI - (_.wrap #$.Long)))] + (_.wrap #_t.Long)))] [bit::left-shift _.LSHL] [bit::arithmetic-right-shift _.LSHR] @@ -100,9 +102,9 @@ (Nullary Inst) (|>> (_.wrap )))] - [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 [ ] @@ -113,17 +115,17 @@ (_.wrap )))] - [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 [ ] @@ -139,8 +141,8 @@ [ +0] [ -1])] - [i64::= int::< (_.unwrap #$.Long) _.LCMP] - [frac::= frac::< (_.unwrap #$.Double) _.DCMPG] + [i64::= int::< (_.unwrap #_t.Long) _.LCMP] + [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG] ) (template [ ] @@ -148,12 +150,12 @@ (Unary Inst) (|>> inputI ))] - [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 [] @@ -57,30 +59,30 @@ (|>> inputI )))] - [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 @@ [ ] (wrap (|>> valueI (_.unwrap )))) - (["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 -- cgit v1.2.3