From bcd3d9ee8f6797f758a2abea98d5cb6a74cc7df0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 15 Jun 2018 00:11:33 -0400 Subject: - WIP: Adjustments to new-luxc based on recent changes to stdlib. --- new-luxc/source/luxc/lang/host/jvm/def.lux | 2 +- new-luxc/source/luxc/lang/host/jvm/inst.lux | 126 +++++++++++++------------- new-luxc/source/luxc/lang/host/jvm/type.lux | 134 ++++++++++++++-------------- 3 files changed, 131 insertions(+), 131 deletions(-) (limited to 'new-luxc/source/luxc/lang/host') diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index 4cb7aba3e..86f7999ba 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -272,7 +272,7 @@ [long-field Int $t.long id] [float-field Frac $t.float host.double-to-float] [double-field Frac $t.double id] - [char-field Nat $t.char (|>> nat-to-int host.long-to-int host.int-to-char)] + [char-field Nat $t.char (|>> .int host.long-to-int host.int-to-char)] [string-field Text ($t.class "java.lang.String" (list)) id] ) diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index d088c5324..671a2bb3c 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -1,5 +1,5 @@ (.module: - [lux #- char] + [lux #- int char] (lux (control monad ["p" parser]) (data [maybe] @@ -11,8 +11,8 @@ (macro [code] ["s" syntax #+ syntax:]) [function]) - ["$" //] - (// ["$t" type])) + [//] + [//type]) ## [Host] (host.import #long java/lang/Object) @@ -117,12 +117,12 @@ (#e.Success [compiler (Label::new [])]))) (def: #export (with-label action) - (-> (-> Label $.Inst) $.Inst) + (-> (-> Label //.Inst) //.Inst) (action (Label::new []))) (do-template [ ] [(def: #export ( value) - (-> $.Inst) + (-> //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitLdcInsn [( value)]))))] @@ -131,7 +131,7 @@ [int Int host.long-to-int] [long Int id] [double Frac id] - [char Nat (|>> nat-to-int host.long-to-int host.int-to-char)] + [char Nat (|>> .int host.long-to-int host.int-to-char)] [string Text id] ) @@ -139,14 +139,14 @@ (wrap (list (code.local-symbol (format "Opcodes::" base))))) (def: #export NULL - $.Inst + //.Inst (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) (do-template [] [(def: #export - $.Inst + //.Inst (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix )]))))] @@ -207,10 +207,10 @@ (do-template [] [(def: #export ( register) - (-> Nat $.Inst) + (-> Nat //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitVarInsn [(prefix ) (nat-to-int register)]))))] + (MethodVisitor::visitVarInsn [(prefix ) (.int register)]))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -218,10 +218,10 @@ (do-template [ ] [(def: #export ( class field type) - (-> Text Text $.Type $.Inst) + (-> Text Text //.Type //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [ ($t.binary-name class) field ($t.descriptor type)]))))] + (MethodVisitor::visitFieldInsn [ (//type.binary-name class) field (//type.descriptor type)]))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -232,10 +232,10 @@ (do-template [ ] [(def: #export ( class) - (-> Text $.Inst) + (-> Text //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [ ($t.binary-name class)]))))] + (MethodVisitor::visitTypeInsn [ (//type.binary-name class)]))))] [CHECKCAST Opcodes::CHECKCAST] [NEW Opcodes::NEW] @@ -244,25 +244,25 @@ ) (def: #export (NEWARRAY type) - (-> $.Primitive $.Inst) + (-> //.Primitive //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type - #$.Boolean Opcodes::T_BOOLEAN - #$.Byte Opcodes::T_BYTE - #$.Short Opcodes::T_SHORT - #$.Int Opcodes::T_INT - #$.Long Opcodes::T_LONG - #$.Float Opcodes::T_FLOAT - #$.Double Opcodes::T_DOUBLE - #$.Char Opcodes::T_CHAR)])))) + #//.Boolean Opcodes::T_BOOLEAN + #//.Byte Opcodes::T_BYTE + #//.Short Opcodes::T_SHORT + #//.Int Opcodes::T_INT + #//.Long Opcodes::T_LONG + #//.Float Opcodes::T_FLOAT + #//.Double Opcodes::T_DOUBLE + #//.Char Opcodes::T_CHAR)])))) (do-template [ ] [(def: #export ( class method-name method-signature interface?) - (-> Text Text $.Method Bool $.Inst) + (-> Text Text //.Method Bool //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [ ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn [ (//type.binary-name class) method-name (//type.method-descriptor method-signature) interface?]))))] [INVOKESTATIC Opcodes::INVOKESTATIC] [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] @@ -272,7 +272,7 @@ (do-template [] [(def: #export ( @where) - (-> $.Label $.Inst) + (-> //.Label //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitJumpInsn [(prefix ) @where]))))] @@ -283,7 +283,7 @@ ) (def: #export (TABLESWITCH min max default labels) - (-> Int Int $.Label (List $.Label) $.Inst) + (-> Int Int //.Label (List //.Label) //.Inst) (function (_ visitor) (let [num-labels (list.size labels) labels-array (host.array Label num-labels) @@ -292,84 +292,84 @@ (exec (host.array-write idx (maybe.assume (list.nth idx labels)) labels-array) - (recur (n/inc idx))) + (recur (inc idx))) []))] (do-to visitor (MethodVisitor::visitTableSwitchInsn [min max default labels-array]))))) (def: #export (try @from @to @handler exception) - (-> $.Label $.Label $.Label Text $.Inst) + (-> //.Label //.Label //.Label Text //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTryCatchBlock [@from @to @handler ($t.binary-name exception)])))) + (MethodVisitor::visitTryCatchBlock [@from @to @handler (//type.binary-name exception)])))) (def: #export (label @label) - (-> $.Label $.Inst) + (-> //.Label //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitLabel [@label])))) (def: #export (array type) - (-> $.Type $.Inst) + (-> //.Type //.Inst) (case type - (#$.Primitive prim) + (#//.Primitive prim) (NEWARRAY prim) - (#$.Generic generic) + (#//.Generic generic) (let [elem-class (case generic - (#$.Class class params) - ($t.binary-name class) + (#//.Class class params) + (//type.binary-name class) _ - ($t.binary-name "java.lang.Object"))] + (//type.binary-name "java.lang.Object"))] (ANEWARRAY elem-class)) _ - (ANEWARRAY ($t.descriptor type)))) + (ANEWARRAY (//type.descriptor type)))) (def: (primitive-wrapper type) - (-> $.Primitive Text) + (-> //.Primitive Text) (case type - #$.Boolean "java.lang.Boolean" - #$.Byte "java.lang.Byte" - #$.Short "java.lang.Short" - #$.Int "java.lang.Integer" - #$.Long "java.lang.Long" - #$.Float "java.lang.Float" - #$.Double "java.lang.Double" - #$.Char "java.lang.Character")) + #//.Boolean "java.lang.Boolean" + #//.Byte "java.lang.Byte" + #//.Short "java.lang.Short" + #//.Int "java.lang.Integer" + #//.Long "java.lang.Long" + #//.Float "java.lang.Float" + #//.Double "java.lang.Double" + #//.Char "java.lang.Character")) (def: (primitive-unwrap type) - (-> $.Primitive Text) + (-> //.Primitive Text) (case type - #$.Boolean "booleanValue" - #$.Byte "byteValue" - #$.Short "shortValue" - #$.Int "intValue" - #$.Long "longValue" - #$.Float "floatValue" - #$.Double "doubleValue" - #$.Char "charValue")) + #//.Boolean "booleanValue" + #//.Byte "byteValue" + #//.Short "shortValue" + #//.Int "intValue" + #//.Long "longValue" + #//.Float "floatValue" + #//.Double "doubleValue" + #//.Char "charValue")) (def: #export (wrap type) - (-> $.Primitive $.Inst) + (-> //.Primitive //.Inst) (let [class (primitive-wrapper type)] (|>> (INVOKESTATIC class "valueOf" - ($t.method (list (#$.Primitive type)) - (#.Some ($t.class class (list))) - (list)) + (//type.method (list (#//.Primitive type)) + (#.Some (//type.class class (list))) + (list)) false)))) (def: #export (unwrap type) - (-> $.Primitive $.Inst) + (-> //.Primitive //.Inst) (let [class (primitive-wrapper type)] (|>> (CHECKCAST class) (INVOKEVIRTUAL class (primitive-unwrap type) - ($t.method (list) (#.Some (#$.Primitive type)) (list)) + (//type.method (list) (#.Some (#//.Primitive type)) (list)) false)))) (def: #export (fuse insts) - (-> (List $.Inst) $.Inst) + (-> (List //.Inst) //.Inst) (case insts #.Nil id diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux index b29ffc4a0..0c36e6799 100644 --- a/new-luxc/source/luxc/lang/host/jvm/type.lux +++ b/new-luxc/source/luxc/lang/host/jvm/type.lux @@ -1,123 +1,123 @@ (.module: - [lux #- char] + [lux #- int char] (lux (data [text] text/format (coll [list "list/" Functor]))) - ["$" //]) + [//]) ## Types (do-template [ ] - [(def: #export $.Type (#$.Primitive ))] - - [boolean #$.Boolean] - [byte #$.Byte] - [short #$.Short] - [int #$.Int] - [long #$.Long] - [float #$.Float] - [double #$.Double] - [char #$.Char] + [(def: #export //.Type (#//.Primitive ))] + + [boolean #//.Boolean] + [byte #//.Byte] + [short #//.Short] + [int #//.Int] + [long #//.Long] + [float #//.Float] + [double #//.Double] + [char #//.Char] ) (def: #export (class name params) - (-> Text (List $.Generic) $.Type) - (#$.Generic (#$.Class name params))) + (-> Text (List //.Generic) //.Type) + (#//.Generic (#//.Class name params))) (def: #export (var name) - (-> Text $.Type) - (#$.Generic (#$.Var name))) + (-> Text //.Type) + (#//.Generic (#//.Var name))) (def: #export (wildcard bound) - (-> (Maybe [$.Bound $.Generic]) $.Type) - (#$.Generic (#$.Wildcard bound))) + (-> (Maybe [//.Bound //.Generic]) //.Type) + (#//.Generic (#//.Wildcard bound))) (def: #export (array depth elemT) - (-> Nat $.Type $.Type) + (-> Nat //.Type //.Type) (case depth +0 elemT - _ (#$.Array (array (n/dec depth) elemT)))) + _ (#//.Array (array (dec depth) elemT)))) (def: #export (binary-name class) (-> Text Text) (text.replace-all "." "/" class)) (def: #export (descriptor type) - (-> $.Type Text) + (-> //.Type Text) (case type - (#$.Primitive prim) + (#//.Primitive prim) (case prim - #$.Boolean "Z" - #$.Byte "B" - #$.Short "S" - #$.Int "I" - #$.Long "J" - #$.Float "F" - #$.Double "D" - #$.Char "C") - - (#$.Array sub) + #//.Boolean "Z" + #//.Byte "B" + #//.Short "S" + #//.Int "I" + #//.Long "J" + #//.Float "F" + #//.Double "D" + #//.Char "C") + + (#//.Array sub) (format "[" (descriptor sub)) - (#$.Generic generic) + (#//.Generic generic) (case generic - (#$.Class class params) + (#//.Class class params) (format "L" (binary-name class) ";") - (^or (#$.Var name) (#$.Wildcard ?bound)) - (descriptor (#$.Generic (#$.Class "java.lang.Object" (list))))) + (^or (#//.Var name) (#//.Wildcard ?bound)) + (descriptor (#//.Generic (#//.Class "java.lang.Object" (list))))) )) (def: #export (signature type) - (-> $.Type Text) + (-> //.Type Text) (case type - (#$.Primitive prim) + (#//.Primitive prim) (case prim - #$.Boolean "Z" - #$.Byte "B" - #$.Short "S" - #$.Int "I" - #$.Long "J" - #$.Float "F" - #$.Double "D" - #$.Char "C") - - (#$.Array sub) + #//.Boolean "Z" + #//.Byte "B" + #//.Short "S" + #//.Int "I" + #//.Long "J" + #//.Float "F" + #//.Double "D" + #//.Char "C") + + (#//.Array sub) (format "[" (signature sub)) - (#$.Generic generic) + (#//.Generic generic) (case generic - (#$.Class class params) + (#//.Class class params) (let [=params (if (list.empty? params) "" (format "<" (|> params - (list/map (|>> #$.Generic signature)) + (list/map (|>> #//.Generic signature)) (text.join-with "")) ">"))] (format "L" (binary-name class) =params ";")) - (#$.Var name) + (#//.Var name) (format "T" name ";") - (#$.Wildcard #.None) + (#//.Wildcard #.None) "*" (^template [ ] - (#$.Wildcard (#.Some [ bound])) - (format (signature (#$.Generic bound)))) - ([#$.Upper "+"] - [#$.Lower "-"])) + (#//.Wildcard (#.Some [ bound])) + (format (signature (#//.Generic bound)))) + ([#//.Upper "+"] + [#//.Lower "-"])) )) ## Methods (def: #export (method args return exceptions) - (-> (List $.Type) (Maybe $.Type) (List $.Generic) $.Method) - {#$.args args #$.return return #$.exceptions exceptions}) + (-> (List //.Type) (Maybe //.Type) (List //.Generic) //.Method) + {#//.args args #//.return return #//.exceptions exceptions}) (def: #export (method-descriptor method) - (-> $.Method Text) - (format "(" (text.join-with "" (list/map descriptor (get@ #$.args method))) ")" - (case (get@ #$.return method) + (-> //.Method Text) + (format "(" (text.join-with "" (list/map descriptor (get@ #//.args method))) ")" + (case (get@ #//.return method) #.None "V" @@ -125,14 +125,14 @@ (descriptor return)))) (def: #export (method-signature method) - (-> $.Method Text) - (format "(" (|> (get@ #$.args method) (list/map signature) (text.join-with "")) ")" - (case (get@ #$.return method) + (-> //.Method Text) + (format "(" (|> (get@ #//.args method) (list/map signature) (text.join-with "")) ")" + (case (get@ #//.return method) #.None "V" (#.Some return) (signature return)) - (|> (get@ #$.exceptions method) - (list/map (|>> #$.Generic signature (format "^"))) + (|> (get@ #//.exceptions method) + (list/map (|>> #//.Generic signature (format "^"))) (text.join-with "")))) -- cgit v1.2.3