diff options
Diffstat (limited to '')
78 files changed, 478 insertions, 525 deletions
diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux index c4dff15ec..f02af30c5 100644 --- a/new-luxc/source/luxc/lang.lux +++ b/new-luxc/source/luxc/lang.lux @@ -1,17 +1,8 @@ (.module: lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - [product] - ["e" error] - [text "text/" Eq<Text>] - text/format - (coll [list])) - [macro] - (macro ["s" syntax #+ syntax:]) - (lang (type ["tc" check]))) - (luxc (lang ["la" analysis]))) + (lux (data [maybe] + [text] + text/format))) (def: (normalize-char char) (-> Nat Text) @@ -42,12 +33,12 @@ _ (text.from-code char))) -(def: underflow Nat (n/dec +0)) +(def: underflow Nat (dec +0)) (def: #export (normalize-name name) (-> Text Text) - (loop [idx (n/dec (text.size name)) + (loop [idx (dec (text.size name)) output ""] (if (n/= underflow idx) output - (recur (n/dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output))))) + (recur (dec idx) (format (|> (text.nth idx name) maybe.assume normalize-char) output))))) diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux index 01afaeccc..ba617aa42 100644 --- a/new-luxc/source/luxc/lang/host.jvm.lux +++ b/new-luxc/source/luxc/lang/host.jvm.lux @@ -11,10 +11,11 @@ [array])) [macro] [host #+ do-to object] - [io]) - (luxc ["&" lang] - (lang [".L" variable #+ Register] - (translation (jvm [".T" common]))))) + [io] + ["//" lang] + (lang ["//." reference #+ Register])) + (luxc [lang] + (lang (translation (jvm [".T" common]))))) (host.import org/objectweb/asm/Label) @@ -57,7 +58,7 @@ (array.from-list (list (:! Object class-name) (:! Object byte-code) (:! Object (host.long-to-int 0)) - (:! Object (host.long-to-int (nat-to-int (host.array-length byte-code))))))] + (:! Object (host.long-to-int (.int (host.array-length byte-code))))))] ClassLoader::defineClass)) (def: (fetch-byte-code class-name store) @@ -122,14 +123,14 @@ anchor]) #.None - ((&.throw No-Anchor "") compiler)))) + ((//.throw No-Anchor "") compiler)))) (def: #export (with-context name expr) (All [a] (-> Text (Meta a) (Meta a))) (.function (_ compiler) (let [old (:! commonT.Host (get@ #.host compiler))] (case (expr (set@ #.host - (:! Nothing (set@ #commonT.context [(&.normalize-name name) +0] old)) + (:! Nothing (set@ #commonT.context [(lang.normalize-name name) +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host @@ -147,14 +148,14 @@ (.function (_ compiler) (let [old (:! commonT.Host (get@ #.host compiler)) [old-name old-sub] (get@ #commonT.context old) - new-name (format old-name "$" (%i (nat-to-int old-sub)))] + new-name (format old-name "$" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #commonT.context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! commonT.Host) - (set@ #commonT.context [old-name (n/inc old-sub)]) + (set@ #commonT.context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) 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 [<name> <type> <prepare>] [(def: #export (<name> value) - (-> <type> $.Inst) + (-> <type> //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitLdcInsn [(<prepare> 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 [<name>] [(def: #export <name> - $.Inst + //.Inst (function (_ visitor) (do-to visitor (MethodVisitor::visitInsn [(prefix <name>)]))))] @@ -207,10 +207,10 @@ (do-template [<name>] [(def: #export (<name> register) - (-> Nat $.Inst) + (-> Nat //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitVarInsn [(prefix <name>) (nat-to-int register)]))))] + (MethodVisitor::visitVarInsn [(prefix <name>) (.int register)]))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -218,10 +218,10 @@ (do-template [<name> <inst>] [(def: #export (<name> class field type) - (-> Text Text $.Type $.Inst) + (-> Text Text //.Type //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [<inst> ($t.binary-name class) field ($t.descriptor type)]))))] + (MethodVisitor::visitFieldInsn [<inst> (//type.binary-name class) field (//type.descriptor type)]))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -232,10 +232,10 @@ (do-template [<name> <inst>] [(def: #export (<name> class) - (-> Text $.Inst) + (-> Text //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [<inst> ($t.binary-name class)]))))] + (MethodVisitor::visitTypeInsn [<inst> (//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 [<name> <inst>] [(def: #export (<name> class method-name method-signature interface?) - (-> Text Text $.Method Bool $.Inst) + (-> Text Text //.Method Bool //.Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [<inst> ($t.binary-name class) method-name ($t.method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn [<inst> (//type.binary-name class) method-name (//type.method-descriptor method-signature) interface?]))))] [INVOKESTATIC Opcodes::INVOKESTATIC] [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] @@ -272,7 +272,7 @@ (do-template [<name>] [(def: #export (<name> @where) - (-> $.Label $.Inst) + (-> //.Label //.Inst) (function (_ visitor) (do-to visitor (MethodVisitor::visitJumpInsn [(prefix <name>) @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<List>]))) - ["$" //]) + [//]) ## Types (do-template [<name> <primitive>] - [(def: #export <name> $.Type (#$.Primitive <primitive>))] - - [boolean #$.Boolean] - [byte #$.Byte] - [short #$.Short] - [int #$.Int] - [long #$.Long] - [float #$.Float] - [double #$.Double] - [char #$.Char] + [(def: #export <name> //.Type (#//.Primitive <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 [<tag> <prefix>] - (#$.Wildcard (#.Some [<tag> bound])) - (format <prefix> (signature (#$.Generic bound)))) - ([#$.Upper "+"] - [#$.Lower "-"])) + (#//.Wildcard (#.Some [<tag> bound])) + (format <prefix> (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 "")))) diff --git a/new-luxc/source/luxc/lang/synthesis/variable.lux b/new-luxc/source/luxc/lang/synthesis/variable.lux index b1988018d..4a3317d9f 100644 --- a/new-luxc/source/luxc/lang/synthesis/variable.lux +++ b/new-luxc/source/luxc/lang/synthesis/variable.lux @@ -11,7 +11,7 @@ (-> ls.Path (List Variable)) (case path (#ls.BindP register) - (list (nat-to-int register)) + (list (.int register)) (^or (#ls.SeqP pre post) (#ls.AltP pre post)) (list/compose (bound-vars pre) (bound-vars post)) @@ -37,7 +37,7 @@ (def: (non-arg? arity var) (-> ls.Arity Variable Bool) (and (variableL.local? var) - (n/> arity (int-to-nat var)))) + (n/> arity (.nat var)))) (type: Tracker (s.Set Variable)) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp.lux b/new-luxc/source/luxc/lang/translation/common-lisp.lux index 1ae046d33..36926833c 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp.lux @@ -94,14 +94,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "f___" (%i (nat-to-int old-sub)))] + new-name (format old-name "f___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux index eef9a985f..cb6f03d17 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/eval.jvm.lux @@ -81,7 +81,7 @@ (#e.Error error) (#e.Success lux-value) - (recur (n/inc idx) (array.write idx (:! Any lux-value) output))) + (recur (inc idx) (array.write idx (:! Any lux-value) output))) (#e.Success output))))) (def: (variant tag flag value) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux index 543cbe899..54834b65c 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/function.jvm.lux @@ -26,7 +26,7 @@ (def: $missing (_.var "missing")) (def: input-declaration - (|>> n/inc referenceT.variable)) + (|>> inc referenceT.variable)) (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Expression (Meta Expression)) @@ -55,7 +55,7 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [arityO (|> arity nat-to-int _.int) + #let [arityO (|> arity .int _.int) $num_args (_.var "num_args") $function (_.var function-name)]] (with-closure function-name closureO+ @@ -63,7 +63,7 @@ (_.let (list [$num_args (_.length (@@ $curried))]) (<| (_.if (|> (@@ $num_args) (_.= arityO)) (_.let (list [(referenceT.variable +0) (_.function (@@ $function))]) - (_.destructuring-bind [(|> (list.n/range +0 (n/dec arity)) + (_.destructuring-bind [(|> (list.n/range +0 (dec arity)) (list/map input-declaration) _.poly) (@@ $curried)] diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/loop.jvm.lux index ecaf12c7c..c64973d8f 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/loop.jvm.lux @@ -23,7 +23,7 @@ #let [$loop-name (r.var loop-name) @loop-name (@@ $loop-name)] _ (//.save (r.set! $loop-name - (r.function (|> (list.n/range +0 (n/dec (list.size initsS+))) + (r.function (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable))) bodyO)))] (wrap (r.apply initsO+ @loop-name)))) diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux index 100e99ef8..7387c0dda 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/procedure/common.jvm.lux @@ -58,8 +58,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux index 9de2121a1..9fd2f42ea 100644 --- a/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/common-lisp/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register SVar) - (_.var (format <prefix> (%i (nat-to-int register))))) + (_.var (format <prefix> (%i (.int register))))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,13 +25,13 @@ (-> Variable SVar) (if (variableL.captured? var) (closure (variableL.captured-register var)) - (variable (int-to-nat var)))) + (variable (.nat var)))) (def: #export (translate-variable var) (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident SVar) diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux index edca93d10..d38409b10 100644 --- a/new-luxc/source/luxc/lang/translation/js.lux +++ b/new-luxc/source/luxc/lang/translation/js.lux @@ -104,14 +104,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "$" (%i (nat-to-int old-sub)))] + new-name (format old-name "$" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) @@ -206,7 +206,7 @@ (:! Object (js-object (Arrays::copyOfRange [value (|> args (array.read +0) maybe.assume (:! Int)) - (nat-to-int (array.size value))])))) + (.int (array.size value))])))) )) (def: #export int-high-field Text "H") @@ -222,7 +222,7 @@ (def: low-mask Nat - (|> +1 (bit.left-shift +32) n/dec)) + (|> +1 (bit.left-shift +32) dec)) (def: #export high (-> Nat Nat) (bit.logical-right-shift +32)) (def: #export low (-> Nat Nat) (bit.and low-mask)) @@ -241,10 +241,10 @@ (:! Long value)) (AbstractJSObject (getMember [member String]) Object (cond (text/= int-high-field member) - (|> value int-to-nat high jvm-int) + (|> value .nat high jvm-int) (text/= int-low-field member) - (|> value int-to-nat low jvm-int) + (|> value .nat low jvm-int) ## else (error! (ex.construct Unknown-Member diff --git a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux index 82a8bb5c9..3abd8c55c 100644 --- a/new-luxc/source/luxc/lang/translation/js/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/case.jvm.lux @@ -31,7 +31,7 @@ [valueJS (translate valueS)] (wrap (list/fold (function (_ [idx tail?] source) (let [method (if tail? runtimeT.product//right runtimeT.product//left)] - (format method "(" source "," (|> idx nat-to-int %i) ")"))) + (format method "(" source "," (|> idx .int %i) ")"))) (format "(" valueJS ")") path)))) @@ -111,13 +111,13 @@ (^template [<pm> <getter>] (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx nat-to-int %i) ")")))) + (meta/wrap (push-cursor (format <getter> "(" peek-cursor "," (|> idx .int %i) ")")))) (["lux case tuple left" runtimeT.product//left] ["lux case tuple right" runtimeT.product//right]) (^template [<pm> <flag>] (^code (<pm> (~ [_ (#.Nat idx)]))) - (meta/wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx nat-to-int %i) "," <flag> ");" + (meta/wrap (format "temp = " runtimeT.sum//get "(" peek-cursor "," (|> idx .int %i) "," <flag> ");" "if(temp == null) {" fail-pattern-matching "}" diff --git a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux index 04121b944..94136f356 100644 --- a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux @@ -64,10 +64,10 @@ [[(Number::longValue [] (:! Number high)) (Number::longValue [] (:! Number low))] [high low]]) - (#.Some (nat-to-int (n/+ (|> high (:! Nat) (bit.left-shift +32)) - (if (i/< 0 (:! Int low)) - (|> low (:! Nat) (bit.left-shift +32) (bit.logical-right-shift +32)) - (|> low (:! Nat)))))) + (#.Some (.int (n/+ (|> high (:! Nat) (bit.left-shift +32)) + (if (i/< 0 (:! Int low)) + (|> low (:! Nat) (bit.left-shift +32) (bit.logical-right-shift +32)) + (|> low (:! Nat)))))) _ #.None)) @@ -90,24 +90,24 @@ (def: (array lux-object js-object) (-> (-> Object (Error Any)) ScriptObjectMirror (Maybe (Array Object))) (if (JSObject::isArray [] js-object) - (let [init-num-keys (int-to-nat (ScriptObjectMirror::size [] js-object))] + (let [init-num-keys (.nat (ScriptObjectMirror::size [] js-object))] (loop [num-keys init-num-keys idx +0 output (: (Array Object) (array.new init-num-keys))] (if (n/< num-keys idx) - (let [idx-key (|> idx nat-to-int %i)] + (let [idx-key (|> idx .int %i)] (case (JSObject::getMember idx-key js-object) (#.Some member) (case (lux-object member) (#e.Success parsed-member) - (recur num-keys (n/inc idx) (array.write idx (:! Object parsed-member) output)) + (recur num-keys (inc idx) (array.write idx (:! Object parsed-member) output)) (#e.Error error) #.None) #.None - (recur num-keys (n/inc idx) output))) + (recur num-keys (inc idx) output))) (#.Some output)))) #.None)) diff --git a/new-luxc/source/luxc/lang/translation/js/function.jvm.lux b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux index b3c6761cd..ef5ea668e 100644 --- a/new-luxc/source/luxc/lang/translation/js/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/function.jvm.lux @@ -21,7 +21,7 @@ (wrap (format functionJS "(" (text.join-with "," argsJS+) ")")))) (def: (input-declaration register) - (format "var " (referenceT.variable (n/inc register)) " = arguments[" (|> register nat-to-int %i) "];")) + (format "var " (referenceT.variable (inc register)) " = arguments[" (|> register .int %i) "];")) (def: (with-closure inits function) (-> (List Expression) Expression Expression) @@ -30,7 +30,7 @@ (list) _ - (|> (list.n/range +0 (n/dec (list.size inits))) + (|> (list.n/range +0 (dec (list.size inits))) (list/map referenceT.closure)))] (format "(function(" (text.join-with "," closure) ") {" "return " function @@ -47,11 +47,11 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureJS+ (monad.map @ referenceT.translate-variable env) - #let [args-initsJS+ (|> (list.n/range +0 (n/dec arity)) + #let [args-initsJS+ (|> (list.n/range +0 (dec arity)) (list/map input-declaration) (text.join-with "")) selfJS (format "var " (referenceT.variable +0) " = " function-name ";") - arityJS (|> arity nat-to-int %i)]] + arityJS (|> arity .int %i)]] (wrap (<| (with-closure closureJS+) (format "(function " function-name "() {" "\"use strict\";" diff --git a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux index 657982556..c63cb2d32 100644 --- a/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/loop.jvm.lux @@ -20,7 +20,7 @@ initsJS+ (monad.map @ translate initsS+) bodyJS (//.with-anchor [loop-name offset] (translate bodyS)) - #let [registersJS+ (|> (list.n/range +0 (n/dec (list.size initsS+))) + #let [registersJS+ (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable)))]] (wrap (format "(function " loop-name "(" (text.join-with "," registersJS+) ") {" "return " bodyJS ";" diff --git a/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux index 270fa510d..305f46adf 100644 --- a/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/primitive.jvm.lux @@ -13,21 +13,21 @@ (-> Bool (Meta Expression)) (|>> %b meta/wrap)) -(def: low-mask Nat (n/dec (bit.left-shift +32 +1))) +(def: low-mask Nat (dec (bit.left-shift +32 +1))) (def: #export (translate-nat value) (-> Nat (Meta Expression)) (let [high (|> value (bit.logical-right-shift +32) - nat-to-int %i) + .int %i) low (|> value (bit.and low-mask) - nat-to-int %i)] + .int %i)] (meta/wrap (format runtimeT.int//new "(" high "," low ")")))) (def: #export translate-int (-> Int (Meta Expression)) - (|>> int-to-nat translate-nat)) + (|>> .nat translate-nat)) (def: deg-to-nat (-> Deg Nat) diff --git a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux index 54a557ec9..fede43875 100644 --- a/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/procedure/common.jvm.lux @@ -57,8 +57,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux index 0c5cc3a44..e4231ba6b 100644 --- a/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register Expression) - (format <prefix> (%i (nat-to-int register)))) + (format <prefix> (%i (.int register)))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,7 +25,7 @@ (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident Expression) diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux index 2c7303c31..6039a33c7 100644 --- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux @@ -27,7 +27,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Expression) - (variant' (%i (nat-to-int tag)) (flag last?) value)) + (variant' (%i (.int tag)) (flag last?) value)) (def: none Expression @@ -69,9 +69,9 @@ (def: #export (int value) (-> Int Expression) (format "({" - //.int-high-field " : " (|> value int-to-nat //.high nat-to-int %i) + //.int-high-field " : " (|> value .nat //.high .int %i) ", " - //.int-low-field " : " (|> value int-to-nat //.low nat-to-int %i) + //.int-low-field " : " (|> value .nat //.low .int %i) "})")) (def: #export frac diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux index 782639b25..28560854d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -121,7 +121,7 @@ _ (|>> peekI ($i.CHECKCAST ($t.descriptor //runtime.$Tuple)) - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) ($i.INVOKESTATIC hostL.runtime-class <method> ($t.method (list //runtime.$Tuple $t.int) @@ -138,7 +138,7 @@ $i.with-label (function (_ @fail)) (|>> peekI ($i.CHECKCAST ($t.descriptor //runtime.$Variant)) - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) <flag> ($i.INVOKESTATIC hostL.runtime-class "pm_variant" ($t.method (list //runtime.$Variant //runtime.$Tag //runtime.$Flag) @@ -166,7 +166,7 @@ (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftP rightP))]) (do macro.Monad<Meta> [@alt-else $i.make-label - leftI (translate-path' translate (n/inc stack-depth) @alt-else @end leftP) + leftI (translate-path' translate (inc stack-depth) @alt-else @end leftP) rightI (translate-path' translate stack-depth @else @end rightP)] (wrap (|>> $i.DUP leftI diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux index 1d8da2893..b678677ce 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -11,10 +11,11 @@ [macro] [host] (world [blob #+ Blob] - [file #+ File])) + [file #+ File]) + ["//" lang] + (lang ["//." reference #+ Register])) (luxc [lang] - (lang [".L" variable #+ Register] - (host ["$" jvm] + (lang (host ["$" jvm] (jvm ["$t" type] ["$d" def] ["$i" inst]))))) @@ -131,10 +132,10 @@ (wrap def-value) (#e.Success #.None) - (lang.throw Invalid-Definition-Value (%ident def-ident)) + (//.throw Invalid-Definition-Value (%ident def-ident)) (#e.Error error) - (lang.throw Cannot-Load-Definition - (format "Definition: " (%ident def-ident) "\n" - "Error:\n" - error)))))))) + (//.throw Cannot-Load-Definition + (format "Definition: " (%ident def-ident) "\n" + "Error:\n" + error)))))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux index 42b4f3358..a587d2e5b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -6,12 +6,12 @@ (data ["e" error] text/format) [macro] - (macro ["s" syntax])) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - [".L" extension] - (host ["$" jvm]) - ["ls" synthesis])) + (macro ["s" syntax]) + ["//" lang] + (lang ["//." reference #+ Register] + ["//." synthesis #+ Synthesis] + ["//." extension])) + (luxc (lang (host ["$" jvm]))) (// [".T" common] [".T" primitive] [".T" structure] @@ -30,23 +30,19 @@ ) (def: #export (translate synthesis) - (-> ls.Synthesis (Meta $.Inst)) + (-> Synthesis (Meta $.Inst)) (case synthesis - (^code []) - primitiveT.translate-unit - - (^code [(~ singleton)]) - (translate singleton) - - (^template [<tag> <generator>] - [_ (<tag> value)] - (<generator> value)) - ([#.Bool primitiveT.translate-bool] - [#.Nat primitiveT.translate-nat] - [#.Int primitiveT.translate-int] - [#.Deg primitiveT.translate-deg] - [#.Frac primitiveT.translate-frac] - [#.Text primitiveT.translate-text]) + (^ (//synthesis.bool value)) + (primitiveT.translate-bool value) + + (^ (//synthesis.i64 value)) + (primitiveT.translate-i64 value) + + (^ (//synthesis.f64 value)) + (primitiveT.translate-f64 value) + + (^ (//synthesis.text value)) + (primitiveT.translate-text value) (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS))) (structureT.translate-variant translate tag last? valueS) @@ -74,7 +70,7 @@ (functionT.translate-function translate environment arity bodyS) _ - (&.throw Invalid-Function-Syntax (%code synthesis))) + (//.throw Invalid-Function-Syntax (%code synthesis))) (^code ("lux call" (~ functionS) (~+ argsS))) (functionT.translate-call translate functionS argsS) @@ -86,5 +82,5 @@ ## (translation argsS)) _ - (&.throw Unrecognized-Synthesis (%code synthesis)) + (//.throw Unrecognized-Synthesis (%code synthesis)) )) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index f5799e572..70eedf738 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -39,7 +39,7 @@ (if (poly-arg? arity) ($t.method (list.concat (list (captured-args env) (list $t.int) - (list.repeat (n/dec arity) $Object))) + (list.repeat (dec arity) $Object))) #.None (list)) ($t.method (captured-args env) #.None (list)))) @@ -59,7 +59,7 @@ (def: (inputsI start amount) (-> $.Register Nat $.Inst) - (|> (list.n/range start (n/+ start (n/dec amount))) + (|> (list.n/range start (n/+ start (dec amount))) (list/map $i.ALOAD) $i.fuse)) @@ -76,7 +76,7 @@ (def: (inc-intI by) (-> Nat $.Inst) - (|>> ($i.int (nat-to-int by)) + (|>> ($i.int (.int by)) $i.IADD)) (def: (nullsI amount) @@ -106,7 +106,7 @@ (do macro.Monad<Meta> [captureI+ (monad.map @ referenceT.translate-variable env) #let [argsI (if (poly-arg? arity) - (|> (nullsI (n/dec arity)) + (|> (nullsI (dec arity)) (list ($i.int 0)) $i.fuse) id)]] @@ -123,12 +123,12 @@ (let [env-size (list.size env) captureI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (function (_ source) (|>> ($i.ALOAD +0) ($i.GETFIELD class (referenceT.captured source) $Object)))) $i.fuse) - argsI (|> (nullsI (n/dec arity)) + argsI (|> (nullsI (dec arity)) (list ($i.int 0)) $i.fuse)] (|>> ($i.NEW class) @@ -156,20 +156,20 @@ (if (n/= +1 arity) (|>> ($i.int 0) ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false)) - (|>> ($i.ILOAD (n/inc env-size)) + (|>> ($i.ILOAD (inc env-size)) ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false)))) (def: (with-init class env arity) (-> Text (List Variable) ls.Arity $.Def) (let [env-size (list.size env) offset-partial (: (-> Nat Nat) - (|>> n/inc (n/+ env-size))) + (|>> inc (n/+ env-size))) store-capturedI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (function (_ register) (|>> ($i.ALOAD +0) - ($i.ALOAD (n/inc register)) + ($i.ALOAD (inc register)) ($i.PUTFIELD class (referenceT.captured register) $Object)))) $i.fuse) store-partialI (if (poly-arg? arity) @@ -177,7 +177,7 @@ (list/map (function (_ idx) (let [register (offset-partial idx)] (|>> ($i.ALOAD +0) - ($i.ALOAD (n/inc register)) + ($i.ALOAD (inc register)) ($i.PUTFIELD class (referenceT.partial idx) $Object))))) $i.fuse) id)] @@ -191,19 +191,19 @@ (def: (with-apply class env function-arity @begin bodyI apply-arity) (-> Text (List Variable) ls.Arity $.Label $.Inst ls.Arity $.Def) - (let [num-partials (n/dec function-arity) + (let [num-partials (dec function-arity) @default ($.new-label []) @labels (list/map $.new-label (list.repeat num-partials [])) - arity-over-extent (|> (nat-to-int function-arity) (i/- (nat-to-int apply-arity))) + arity-over-extent (|> (.int function-arity) (i/- (.int apply-arity))) casesI (|> (list/compose @labels (list @default)) (list.zip2 (list.n/range +0 num-partials)) (list/map (function (_ [stage @label]) (let [load-partialsI (if (n/> +0 stage) - (|> (list.n/range +0 (n/dec stage)) + (|> (list.n/range +0 (dec stage)) (list/map (|>> referenceT.partial (load-fieldI class))) $i.fuse) id)] - (cond (i/= arity-over-extent (nat-to-int stage)) + (cond (i/= arity-over-extent (.int stage)) (|>> ($i.label @label) ($i.ALOAD +0) (when (n/> +0 stage) @@ -213,7 +213,7 @@ ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false) $i.ARETURN) - (i/> arity-over-extent (nat-to-int stage)) + (i/> arity-over-extent (.int stage)) (let [args-to-completion (|> function-arity (n/- stage)) args-left (|> apply-arity (n/- args-to-completion))] (|>> ($i.label @label) @@ -222,14 +222,14 @@ load-partialsI (inputsI +1 args-to-completion) ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false) - (applysI (n/inc args-to-completion) args-left) + (applysI (inc args-to-completion) args-left) $i.ARETURN)) - ## (i/< arity-over-extent (nat-to-int stage)) + ## (i/< arity-over-extent (.int stage)) (let [env-size (list.size env) load-capturedI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (|>> referenceT.captured (load-fieldI class))) $i.fuse)] (|>> ($i.label @label) @@ -247,7 +247,7 @@ $i.fuse)] ($d.method #$.Public $.noneM runtimeT.apply-method (runtimeT.apply-signature apply-arity) (|>> get-amount-of-partialsI - ($i.TABLESWITCH 0 (|> num-partials n/dec nat-to-int) + ($i.TABLESWITCH 0 (|> num-partials dec .int) @default @labels) casesI ($i.INVOKESTATIC hostL.runtime-class "apply_fail" ($t.method (list) #.None (list)) false) @@ -271,7 +271,7 @@ bodyI $i.ARETURN)))) functionD (: $.Def - (|>> ($d.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (nat-to-int arity)) + (|>> ($d.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity)) (with-captured env) (with-partial arity) (with-init class env arity) diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux index fab4a7efe..f48ab149a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -35,7 +35,7 @@ (Meta $.Inst)) (do macro.Monad<Meta> [[@begin offset] hostL.anchor - #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) n/dec (n/+ offset))) + #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) dec (n/+ offset))) argsS)] ## It may look weird that first I compile the values separately, ## and then I compile the stores/allocations. diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux index f92c7025a..80a243852 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux @@ -12,10 +12,6 @@ ["ls" synthesis])) (// [".T" common])) -(def: #export translate-unit - (Meta $.Inst) - (macro/wrap ($i.string hostL.unit))) - (def: #export (translate-bool value) (-> Bool (Meta $.Inst)) (macro/wrap ($i.GETSTATIC "java.lang.Boolean" @@ -27,9 +23,7 @@ (-> <type> (Meta $.Inst)) (macro/wrap (|>> (<load> value) <wrap>)))] - [translate-nat Nat (|>> (:! Int) $i.long) ($i.wrap #$.Long)] - [translate-int Int $i.long ($i.wrap #$.Long)] - [translate-deg Deg (|>> (:! Int) $i.long) ($i.wrap #$.Long)] - [translate-frac Frac $i.double ($i.wrap #$.Double)] + [translate-i64 Int $i.long ($i.wrap #$.Long)] + [translate-f64 Frac $i.double ($i.wrap #$.Double)] [translate-text Text $i.string id] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 5cb4d52ec..689724bae 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -11,15 +11,16 @@ [macro #+ with-gensyms] (macro [code] ["s" syntax #+ syntax:]) - [host]) - (luxc ["&" lang] - (lang [".L" host] + [host] + ["//" lang] + (lang ["//." reference #+ Register] + ["//." synthesis #+ Synthesis] + ["//." extension])) + (luxc (lang [".L" host] (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) - ["la" analysis] - ["ls" synthesis])) + ["$i" inst])))) (/// [".T" runtime] [".T" case] [".T" function] @@ -38,10 +39,10 @@ ## [Types] (type: #export Translator - (-> ls.Synthesis (Meta $.Inst))) + (-> Synthesis (Meta $.Inst))) (type: #export Proc - (-> Translator (List ls.Synthesis) (Meta $.Inst))) + (-> Translator (List Synthesis) (Meta $.Inst))) (type: #export Bundle (Dict Text Proc)) @@ -78,8 +79,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] @@ -171,7 +172,7 @@ message) (def: #export (wrong-syntax procedure args) - (-> Text (List ls.Synthesis) Text) + (-> Text (List Synthesis) Text) (format "Procedure: " procedure "\n" "Arguments: " (%code (code.tuple args)))) @@ -184,7 +185,7 @@ (loopT.translate-loop translate offset initsS+ bodyS) (#e.Error error) - (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) + (//.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) ))) (def: lux//recur diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux index 6776092c9..9271efe8f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -16,7 +16,7 @@ (do-template [<name> <prefix>] [(def: #export (<name> idx) (-> Nat Text) - (|> idx nat-to-int %i (format <prefix>)))] + (|> idx .int %i (format <prefix>)))] [captured "c"] [partial "p"] @@ -30,12 +30,12 @@ #let [function-class (format (text.replace-all "/" "." this-module) "." function-class)]] (wrap (|>> ($i.ALOAD +0) ($i.GETFIELD function-class - (|> variable i/inc (i/* -1) int-to-nat captured) + (|> variable inc (i/* -1) .nat captured) commonT.$Object))))) (def: #export (translate-local variable) (-> Variable (Meta $.Inst)) - (macro/wrap ($i.ALOAD (int-to-nat variable)))) + (macro/wrap ($i.ALOAD (.nat variable)))) (def: #export (translate-variable variable) (-> Variable (Meta $.Inst)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 456974ccd..c22199864 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -247,7 +247,7 @@ $i.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat $.Inst) (function (_ idx) - (|>> ($i.int (nat-to-int idx)) $i.AALOAD))) + (|>> ($i.int (.int idx)) $i.AALOAD))) tagI (: $.Inst (|>> (variant-partI +0) ($i.unwrap #$.Int))) flagI (variant-partI +1) @@ -445,11 +445,11 @@ #let [applyI (|> (list.n/range +2 num-apply-variants) (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) - (let [preI (|> (list.n/range +0 (n/dec arity)) + (let [preI (|> (list.n/range +0 (dec arity)) (list/map $i.ALOAD) $i.fuse)] (|>> preI - ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (n/dec arity)) false) + ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (dec arity)) false) ($i.CHECKCAST hostL.function-class) ($i.ALOAD arity) ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false) diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux index 4a98d346d..fce1c6790 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -33,11 +33,11 @@ (do @ [memberI (translate member)] (wrap (|>> $i.DUP - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) memberI $i.AASTORE))))) (:: @ map $i.fuse))] - (wrap (|>> ($i.int (nat-to-int size)) + (wrap (|>> ($i.int (.int size)) ($i.array $Object) membersI)))) @@ -51,7 +51,7 @@ (-> (-> ls.Synthesis (Meta $.Inst)) Nat Bool ls.Synthesis (Meta $.Inst)) (do macro.Monad<Meta> [memberI (translate member)] - (wrap (|>> ($i.int (nat-to-int tag)) + (wrap (|>> ($i.int (.int tag)) (flagI tail?) memberI ($i.INVOKESTATIC hostL.runtime-class diff --git a/new-luxc/source/luxc/lang/translation/lua.lux b/new-luxc/source/luxc/lang/translation/lua.lux index 94a703300..d09746351 100644 --- a/new-luxc/source/luxc/lang/translation/lua.lux +++ b/new-luxc/source/luxc/lang/translation/lua.lux @@ -118,14 +118,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (nat-to-int old-sub)))] + new-name (format old-name "___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux index 68b41e6d7..0e413e7ad 100644 --- a/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/eval.jvm.lux @@ -60,17 +60,17 @@ output (: (Array Object) (array.new init-num-keys))] (if (n/< num-keys idx) - (case (Table::get-idx (:! Long (n/inc idx)) host-object) + (case (Table::get-idx (:! Long (inc idx)) host-object) (#.Some member) (case (lux-object member) (#e.Success parsed-member) - (recur num-keys (n/inc idx) (array.write idx (:! Object parsed-member) output)) + (recur num-keys (inc idx) (array.write idx (:! Object parsed-member) output)) (#e.Error error) #.None) #.None - (recur num-keys (n/inc idx) output)) + (recur num-keys (inc idx) output)) (#.Some output))))) (def: (lux-object host-object) diff --git a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux index 042ddd824..02b322de6 100644 --- a/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/function.jvm.lux @@ -23,8 +23,8 @@ (wrap (lua.apply functionO argsO+)))) (def: (input-declaration register) - (lua.local! (referenceT.variable (n/inc register)) - (#.Some (lua.nth (|> register n/inc nat-to-int %i) "curried")))) + (lua.local! (referenceT.variable (inc register)) + (#.Some (lua.nth (|> register inc .int %i) "curried")))) (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Statement (Meta Expression)) @@ -55,10 +55,10 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-initsO+ (|> (list.n/range +0 (n/dec arity)) + #let [args-initsO+ (|> (list.n/range +0 (dec arity)) (list/map input-declaration)) selfO (lua.local! (referenceT.variable +0) (#.Some function-name)) - arityO (|> arity nat-to-int %i) + arityO (|> arity .int %i) pack (|>> (list) (lua.apply "table.pack"))]] (with-closure function-name closureO+ (lua.function! function-name (list "...") diff --git a/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux index d00f6910d..4bad74069 100644 --- a/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/loop.jvm.lux @@ -20,7 +20,7 @@ initsO+ (monad.map @ translate initsS+) bodyO (//.with-anchor [loop-name offset] (translate bodyS)) - #let [registersO+ (|> (list.n/range +0 (n/dec (list.size initsS+))) + #let [registersO+ (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable)))] _ (//.save (lua.function! loop-name registersO+ (lua.return! bodyO)))] diff --git a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux index f3b437444..50fe74f58 100644 --- a/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/procedure/common.jvm.lux @@ -57,8 +57,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux index 0760e700a..b491c9dd4 100644 --- a/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register Expression) - (format <prefix> (%i (nat-to-int register)))) + (format <prefix> (%i (.int register)))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,7 +25,7 @@ (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident Expression) diff --git a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux index ace528429..5a0d62225 100644 --- a/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/lua/runtime.jvm.lux @@ -30,7 +30,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Expression) - (variant' (%i (nat-to-int tag)) (flag last?) value)) + (variant' (%i (.int tag)) (flag last?) value)) (def: none Expression diff --git a/new-luxc/source/luxc/lang/translation/php.lux b/new-luxc/source/luxc/lang/translation/php.lux index 50bfd5289..8ee0f9c14 100644 --- a/new-luxc/source/luxc/lang/translation/php.lux +++ b/new-luxc/source/luxc/lang/translation/php.lux @@ -91,14 +91,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (nat-to-int old-sub)))] + new-name (format old-name "___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/php/case.jvm.lux b/new-luxc/source/luxc/lang/translation/php/case.jvm.lux index 0cfd66729..3a5eff053 100644 --- a/new-luxc/source/luxc/lang/translation/php/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/case.jvm.lux @@ -185,7 +185,7 @@ (let [outer recur] (case pathP (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (update@ #bindings (set.add (nat-to-int register)) + (update@ #bindings (set.add (.int register)) outer-variables) (^or (^code ("lux case seq" (~ leftP) (~ rightP))) @@ -218,7 +218,7 @@ (list/fold inner inner-variables)) (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS))) - (list/fold inner (update@ #bindings (set.add (nat-to-int register)) + (list/fold inner (update@ #bindings (set.add (.int register)) inner-variables) (list inputS exprS)) diff --git a/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux index 48c09c6c0..54ec6abc2 100644 --- a/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux @@ -69,11 +69,11 @@ (ArrayMemory::get [(LongMemory::new [idx])]) (:! ReferenceMemory) (ReferenceMemory::getValue []))] (if (host.instance? php/runtime/memory/NullMemory value) - (recur (i/inc idx) + (recur (inc idx) (array.write (:! Nat idx) (host.null) output)) (do e.Monad<Error> [lux-value (lux-object value)] - (recur (i/inc idx) + (recur (inc idx) (array.write (:! Nat idx) lux-value output))))) (ex.return output))))) diff --git a/new-luxc/source/luxc/lang/translation/php/function.jvm.lux b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux index 9a283439f..27a265566 100644 --- a/new-luxc/source/luxc/lang/translation/php/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/function.jvm.lux @@ -25,8 +25,8 @@ (def: (input-declaration! register) (-> Register Statement) - (_.set! (referenceT.variable (n/inc register)) - (_.nth (|> register nat-to-int _.int) + (_.set! (referenceT.variable (inc register)) + (_.nth (|> register .int _.int) @curried))) (def: (with-closure function-name inits function-definition!) @@ -61,10 +61,10 @@ closureO+ (monad.map @ referenceT.translate-variable env) #let [@function (_.var function-name) self-init! (_.set! (referenceT.variable +0) @function) - args-inits! (|> (list.n/range +0 (n/dec arity)) + args-inits! (|> (list.n/range +0 (dec arity)) (list/map input-declaration!) (list/fold _.then! self-init!)) - arityO (|> arity nat-to-int _.int) + arityO (|> arity .int _.int) @num_args (_.var "num_args")]] (with-closure function-name closureO+ (function (_ captured) diff --git a/new-luxc/source/luxc/lang/translation/php/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/php/loop.jvm.lux index 8a5b40261..ddc4f67ab 100644 --- a/new-luxc/source/luxc/lang/translation/php/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/loop.jvm.lux @@ -22,7 +22,7 @@ ## (translate bodyS)) ## #let [$loop-name (python.var loop-name) ## @loop-name (@@ $loop-name)] -## _ (//.save (python.def! $loop-name (|> (list.n/range +0 (n/dec (list.size initsS+))) +## _ (//.save (python.def! $loop-name (|> (list.n/range +0 (dec (list.size initsS+))) ## (list/map (|>> (n/+ offset) referenceT.variable))) ## (python.return! bodyO)))] ## (wrap (python.apply initsO+ @loop-name)))) diff --git a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux index b4e9737ee..be1a87761 100644 --- a/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/procedure/common.jvm.lux @@ -58,8 +58,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux index 5f9745845..aeffe45e5 100644 --- a/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/php/runtime.jvm.lux @@ -30,7 +30,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Computation) - (variant' (_.int (nat-to-int tag)) + (variant' (_.int (.int tag)) (flag last?) value)) diff --git a/new-luxc/source/luxc/lang/translation/python.lux b/new-luxc/source/luxc/lang/translation/python.lux index 604f06019..3dde69d2a 100644 --- a/new-luxc/source/luxc/lang/translation/python.lux +++ b/new-luxc/source/luxc/lang/translation/python.lux @@ -88,14 +88,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (nat-to-int old-sub)))] + new-name (format old-name "___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux b/new-luxc/source/luxc/lang/translation/python/case.jvm.lux index 2c32b26a6..f51acc402 100644 --- a/new-luxc/source/luxc/lang/translation/python/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/case.jvm.lux @@ -191,7 +191,7 @@ (let [outer recur] (case pathP (^code ("lux case bind" (~ [_ (#.Nat register)]))) - (update@ #bindings (set.add (nat-to-int register)) + (update@ #bindings (set.add (.int register)) outer-variables) (^or (^code ("lux case seq" (~ leftP) (~ rightP))) @@ -224,7 +224,7 @@ (list/fold inner inner-variables)) (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS))) - (list/fold inner (update@ #bindings (set.add (nat-to-int register)) + (list/fold inner (update@ #bindings (set.add (.int register)) inner-variables) (list inputS exprS)) diff --git a/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux index 6f4e43f9d..df1e7004c 100644 --- a/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/eval.jvm.lux @@ -60,7 +60,7 @@ (#e.Error error) (#e.Success lux-value) - (recur (n/inc idx) (array.write idx lux-value output)))) + (recur (inc idx) (array.write idx lux-value output)))) (#e.Success output))))) (def: python-type diff --git a/new-luxc/source/luxc/lang/translation/python/function.jvm.lux b/new-luxc/source/luxc/lang/translation/python/function.jvm.lux index 97b936fc4..32522d1c0 100644 --- a/new-luxc/source/luxc/lang/translation/python/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/function.jvm.lux @@ -24,8 +24,8 @@ (def: $curried (python.var "curried")) (def: (input-declaration register) - (python.set! (list (referenceT.variable (n/inc register))) - (python.nth (|> register nat-to-int python.int) + (python.set! (list (referenceT.variable (inc register))) + (python.nth (|> register .int python.int) (@@ $curried)))) (def: (with-closure function-name inits function-definition) @@ -58,14 +58,14 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-initsO+ (|> (list.n/range +0 (n/dec arity)) + #let [args-initsO+ (|> (list.n/range +0 (dec arity)) (list/map input-declaration) (case> #.Nil python.no-op! (#.Cons head tail) (list/fold python.then! head tail))) - arityO (|> arity nat-to-int python.int) + arityO (|> arity .int python.int) @curried (@@ $curried) $num_args (python.var "num_args") @num_args (@@ $num_args) diff --git a/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux index e490033bf..f6e3ca4c3 100644 --- a/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/loop.jvm.lux @@ -22,7 +22,7 @@ (translate bodyS)) #let [$loop-name (python.var loop-name) @loop-name (@@ $loop-name)] - _ (//.save (python.def! $loop-name (|> (list.n/range +0 (n/dec (list.size initsS+))) + _ (//.save (python.def! $loop-name (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable))) (python.return! bodyO)))] (wrap (python.apply initsO+ @loop-name)))) diff --git a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux index e76b369fc..6cd163210 100644 --- a/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/procedure/common.jvm.lux @@ -58,8 +58,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux index 1f29da34a..7cb3390f5 100644 --- a/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register SVar) - (python.var (format <prefix> (%i (nat-to-int register))))) + (python.var (format <prefix> (%i (.int register))))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,13 +25,13 @@ (-> Variable SVar) (if (variableL.captured? var) (closure (variableL.captured-register var)) - (variable (int-to-nat var)))) + (variable (.nat var)))) (def: #export (translate-variable var) (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident SVar) diff --git a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux index 282d7536e..fbd599c77 100644 --- a/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/python/runtime.jvm.lux @@ -30,7 +30,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Expression) - (variant' (python.int (nat-to-int tag)) + (variant' (python.int (.int tag)) (flag last?) value)) diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux index 0eba35760..4864cc286 100644 --- a/new-luxc/source/luxc/lang/translation/r.lux +++ b/new-luxc/source/luxc/lang/translation/r.lux @@ -96,14 +96,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "f___" (%i (nat-to-int old-sub)))] + new-name (format old-name "f___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux index 66e157e40..e3a255e41 100644 --- a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux @@ -65,7 +65,7 @@ (#e.Error error) (#e.Success lux-value) - (recur (n/inc idx) (array.write idx (:! Any lux-value) output)))) + (recur (inc idx) (array.write idx (:! Any lux-value) output)))) (#e.Success output))))) (def: (parse-variant lux-object host-object) diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux index 565a44909..5ecf21c3c 100644 --- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux @@ -24,8 +24,8 @@ (def: $curried (r.var "curried")) (def: (input-declaration register) - (r.set! (referenceT.variable (n/inc register)) - (|> (@@ $curried) (r.nth (|> register n/inc nat-to-int r.int))))) + (r.set! (referenceT.variable (inc register)) + (|> (@@ $curried) (r.nth (|> register inc .int r.int))))) (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Expression (Meta Expression)) @@ -57,7 +57,7 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [arityO (|> arity nat-to-int r.int) + #let [arityO (|> arity .int r.int) $num_args (r.var "num_args") $function (r.var function-name) var-args (r.code (format "list" (r.expression (@@ r.var-args)))) @@ -72,7 +72,7 @@ (r.cond (list [(|> (@@ $num_args) (r.= arityO)) ($_ r.then (r.set! (referenceT.variable +0) (@@ $function)) - (|> (list.n/range +0 (n/dec arity)) + (|> (list.n/range +0 (dec arity)) (list/map input-declaration) (list/fold r.then bodyO)))] [(|> (@@ $num_args) (r.> arityO)) diff --git a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux index ecaf12c7c..c64973d8f 100644 --- a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux @@ -23,7 +23,7 @@ #let [$loop-name (r.var loop-name) @loop-name (@@ $loop-name)] _ (//.save (r.set! $loop-name - (r.function (|> (list.n/range +0 (n/dec (list.size initsS+))) + (r.function (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable))) bodyO)))] (wrap (r.apply initsO+ @loop-name)))) diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux index 582cda4c6..03cc802fc 100644 --- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux @@ -58,8 +58,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux index e63066959..a7a788094 100644 --- a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register SVar) - (r.var (format <prefix> (%i (nat-to-int register))))) + (r.var (format <prefix> (%i (.int register))))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,13 +25,13 @@ (-> Variable SVar) (if (variableL.captured? var) (closure (variableL.captured-register var)) - (variable (int-to-nat var)))) + (variable (.nat var)))) (def: #export (translate-variable var) (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident SVar) diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux index 7cdc82064..7267494d5 100644 --- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux @@ -28,17 +28,17 @@ (|> input (bit.and full-32) cap-32) (n/> half-32 input) - (|> post-32 (n/- input) nat-to-int (i/* -1)) + (|> post-32 (n/- input) .int (i/* -1)) ## else - (nat-to-int input))) + (.int input))) (def: high-32 (bit.logical-right-shift +32)) (def: low-32 (|>> (bit.and (hex "+FFFFFFFF")))) (def: #export (int value) (-> Int Expression) - (let [value (int-to-nat value) + (let [value (.nat value) high (|> value ..high-32 cap-32) low (|> value ..low-32 cap-32)] (r.named-list (list [//.int-high-field (r.int high)] @@ -58,7 +58,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Expression) - (variant' (r.int (nat-to-int tag)) + (variant' (r.int (.int tag)) (flag last?) value)) diff --git a/new-luxc/source/luxc/lang/translation/ruby.lux b/new-luxc/source/luxc/lang/translation/ruby.lux index c8cce4caf..808d8105c 100644 --- a/new-luxc/source/luxc/lang/translation/ruby.lux +++ b/new-luxc/source/luxc/lang/translation/ruby.lux @@ -82,14 +82,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "___" (%i (nat-to-int old-sub)))] + new-name (format old-name "___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux index 49bf7f1da..7d43e5460 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/eval.jvm.lux @@ -43,7 +43,7 @@ (if (n/< size idx) (case (RubyArray::get [(:! Int idx)] host-object) #.None - (recur (n/inc idx) output) + (recur (inc idx) output) (#.Some value) (case (lux-object value) @@ -51,7 +51,7 @@ (#e.Error error) (#e.Success lux-value) - (recur (n/inc idx) (array.write idx lux-value output)))) + (recur (inc idx) (array.write idx lux-value output)))) (#e.Success output))))) (def: (variant lux-object host-object) diff --git a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux index f5d64459d..aecabc914 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/function.jvm.lux @@ -23,7 +23,7 @@ (def: (input-declaration registers) (-> (List Register) Statement) - (ruby.set! (list.concat (list (list/map (|>> n/inc referenceT.variable) registers) + (ruby.set! (list.concat (list (list/map (|>> inc referenceT.variable) registers) (list "_"))) "curried")) @@ -51,10 +51,10 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [args-initsO+ (input-declaration (list.n/range +0 (n/dec arity))) + #let [args-initsO+ (input-declaration (list.n/range +0 (dec arity))) selfO (ruby.set! (list (referenceT.variable +0)) function-name) - arityO (|> arity nat-to-int %i) - limitO (|> arity n/dec nat-to-int %i)]] + arityO (|> arity .int %i) + limitO (|> arity dec .int %i)]] (wrap (with-closure closureO+ (ruby.lambda (#.Some function-name) (list (ruby.splat "curried")) diff --git a/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux index e4da02c2a..3c2124565 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/loop.jvm.lux @@ -20,7 +20,7 @@ initsO+ (monad.map @ translate initsS+) bodyO (//.with-anchor [loop-name offset] (translate bodyS)) - #let [registersO+ (|> (list.n/range +0 (n/dec (list.size initsS+))) + #let [registersO+ (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable)))] _ (//.save (ruby.function! loop-name registersO+ (ruby.return! bodyO)))] diff --git a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux index a8d4efc4a..7fb521751 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/procedure/common.jvm.lux @@ -57,8 +57,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux index 9612cdb7a..b778d090a 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register Expression) - (format <prefix> (%i (nat-to-int register)))) + (format <prefix> (%i (.int register)))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,7 +25,7 @@ (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident Expression) diff --git a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux index bb0549259..7e94101ff 100644 --- a/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/ruby/runtime.jvm.lux @@ -30,7 +30,7 @@ (def: #export (variant tag last? value) (-> Nat Bool Expression Expression) - (variant' (%i (nat-to-int tag)) (flag last?) value)) + (variant' (%i (.int tag)) (flag last?) value)) (def: #export none Expression diff --git a/new-luxc/source/luxc/lang/translation/scheme.lux b/new-luxc/source/luxc/lang/translation/scheme.lux index 22cd7151e..a117899fa 100644 --- a/new-luxc/source/luxc/lang/translation/scheme.lux +++ b/new-luxc/source/luxc/lang/translation/scheme.lux @@ -96,14 +96,14 @@ (function (_ compiler) (let [old (:! Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) - new-name (format old-name "f___" (%i (nat-to-int old-sub)))] + new-name (format old-name "f___" (%i (.int old-sub)))] (case (expr (set@ #.host (:! Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:! Host) - (set@ #context [old-name (n/inc old-sub)]) + (set@ #context [old-name (inc old-sub)]) (:! Nothing)) compiler') [new-name output]]) diff --git a/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux index 056bf7599..362deee4a 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux @@ -69,7 +69,7 @@ (#e.Error error) (#e.Success lux-value) - (recur (n/inc idx) (array.write idx (:! Any lux-value) output))) + (recur (inc idx) (array.write idx (:! Any lux-value) output))) (#e.Success output))))) (def: (variant tag flag value) diff --git a/new-luxc/source/luxc/lang/translation/scheme/function.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/function.jvm.lux index 0d03b31a3..87821f2a0 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/function.jvm.lux @@ -26,7 +26,7 @@ (def: $missing (_.var "missing")) (def: input-declaration - (|>> n/inc referenceT.variable)) + (|>> inc referenceT.variable)) (def: (with-closure function-name inits function-definition) (-> Text (List Expression) Expression (Meta Expression)) @@ -56,7 +56,7 @@ (//.with-anchor [function-name +1] (translate bodyS)))) closureO+ (monad.map @ referenceT.translate-variable env) - #let [arityO (|> arity nat-to-int _.int) + #let [arityO (|> arity .int _.int) $num_args (_.var "num_args") $function (_.var function-name) apply-poly (function (_ args func) @@ -66,7 +66,7 @@ (_.let (list [$num_args (_.length (@@ $curried))]) (<| (_.if (|> (@@ $num_args) (_.= arityO)) (_.let (list [(referenceT.variable +0) (@@ $function)]) - (_.let-values (list [(|> (list.n/range +0 (n/dec arity)) + (_.let-values (list [(|> (list.n/range +0 (dec arity)) (list/map input-declaration) _.poly) (_.apply (_.global "apply") (list (_.global "values") (@@ $curried)))]) diff --git a/new-luxc/source/luxc/lang/translation/scheme/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/loop.jvm.lux index ecaf12c7c..c64973d8f 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/loop.jvm.lux @@ -23,7 +23,7 @@ #let [$loop-name (r.var loop-name) @loop-name (@@ $loop-name)] _ (//.save (r.set! $loop-name - (r.function (|> (list.n/range +0 (n/dec (list.size initsS+))) + (r.function (|> (list.n/range +0 (dec (list.size initsS+))) (list/map (|>> (n/+ offset) referenceT.variable))) bodyO)))] (wrap (r.apply initsO+ @loop-name)))) diff --git a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux index e4b6ccde5..a7e9f0814 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/procedure/common.jvm.lux @@ -58,8 +58,8 @@ (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" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] diff --git a/new-luxc/source/luxc/lang/translation/scheme/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/reference.jvm.lux index 3ee8e472a..1552f52af 100644 --- a/new-luxc/source/luxc/lang/translation/scheme/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/scheme/reference.jvm.lux @@ -12,7 +12,7 @@ (do-template [<register> <translation> <prefix>] [(def: #export (<register> register) (-> Register SVar) - (_.var (format <prefix> (%i (nat-to-int register))))) + (_.var (format <prefix> (%i (.int register))))) (def: #export (<translation> register) (-> Register (Meta Expression)) @@ -25,13 +25,13 @@ (-> Variable SVar) (if (variableL.captured? var) (closure (variableL.captured-register var)) - (variable (int-to-nat var)))) + (variable (.nat var)))) (def: #export (translate-variable var) (-> Variable (Meta Expression)) (if (variableL.captured? var) (translate-captured (variableL.captured-register var)) - (translate-local (int-to-nat var)))) + (translate-local (.nat var)))) (def: #export global (-> Ident SVar) diff --git a/new-luxc/source/luxc/repl.lux b/new-luxc/source/luxc/repl.lux index b1efa5c20..987cc2472 100644 --- a/new-luxc/source/luxc/repl.lux +++ b/new-luxc/source/luxc/repl.lux @@ -180,7 +180,7 @@ (n/= num-tags (list.size casesR+)))] (wrap (function (_ variantV) (loop [cases-left (list.zip3 tags - (list.n/range +0 (n/dec num-tags)) + (list.n/range +0 (dec num-tags)) casesR+) variantV variantV] (case cases-left diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 1fd647ba9..44bd85fd9 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -4,12 +4,12 @@ [io #+ IO] (data ["e" error]) [macro] - (macro [code])) - (luxc [lang] - (lang ["&." host] - [".L" init] - [".L" module] - [synthesis #+ Synthesis] + (macro [code]) + ["//" lang] + (lang ["//." init] + ["//." module] + ["//." synthesis #+ Synthesis])) + (luxc (lang ["&." host] (translation (jvm [".T_jvm" expression] [".T_jvm" eval] [".T_jvm" runtime] @@ -64,7 +64,7 @@ (IO Lux) (do io.Monad<IO> [host <host>] - (wrap (initL.compiler host))))] + (wrap (//init.compiler host))))] [init-jvm &host.init-host] ## [init-js js.init] @@ -85,7 +85,7 @@ [_ translate-runtime sampleO (translate-expression synthesis)] (eval sampleO)) - (lang.with-current-module "") + (//.with-current-module "") (macro.run (io.run init))))) (def: (definer translate-runtime translate-expression eval init translate-def) @@ -96,11 +96,11 @@ (|> (do macro.Monad<Meta> [_ translate-runtime valueO (translate-expression synthesis) - _ (moduleL.with-module +0 module-name + _ (//module.with-module +0 module-name (translate-def def-name Any valueO (' {}))) sampleO (translate-expression (code.symbol [module-name def-name]))] (eval sampleO)) - (lang.with-current-module "") + (//.with-current-module "") (macro.run (io.run init))))) (def: #export run-jvm (runner runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm)) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index 44df51014..f7df17c42 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -6,12 +6,9 @@ (data ["e" error] text/format (coll [list])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) + ["r" math/random] + (lang ["//." synthesis #+ Path Synthesis]) test) - (luxc [lang] - (lang ["ls" synthesis])) (test/luxc common)) (def: struct-limit Nat +10) @@ -20,26 +17,24 @@ (-> Nat Nat Bool) (n/= (n/dec size) idx)) -(def: upper-alpha-ascii - (r.Random Nat) - (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) - (def: gen-case - (r.Random [ls.Synthesis ls.Path]) + (r.Random [Synthesis Path]) (<| r.rec (function (_ gen-case)) (`` ($_ r.either - (r/wrap [(' []) (' ("lux case pop"))]) - (~~ (do-template [<gen> <synth>] + (do r.Monad<Random> + [value r.int] + (wrap [(//synthesis.path/i64 value) + //synthesis.path/pop])) + (~~ (do-template [<gen> <synth> <path>] [(do r.Monad<Random> [value <gen>] - (wrap [(<synth> value) (<synth> value)]))] - - [r.bool code.bool] - [r.nat code.nat] - [r.int code.int] - [r.deg code.deg] - [r.frac code.frac] - [(r.text' upper-alpha-ascii +5) code.text])) + (wrap [(<synth> value) + (<path> value)]))] + + [r.bool //synthesis.bool //synthesis.path/bool] + [r.int //synthesis.i64 //synthesis.path/i64] + [r.frac //synthesis.f64 //synthesis.path/f64] + [(r.unicode +5) //synthesis.text //synthesis.path/text])) (do r.Monad<Random> [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) idx (|> r.nat (:: @ map (n/% size))) @@ -47,11 +42,10 @@ #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' [])) (list subS) (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) - caseP (` ("lux case seq" - (~ (if (tail? size idx) - (` ("lux case tuple right" (~ (code.nat idx)))) - (` ("lux case tuple left" (~ (code.nat idx)))))) - (~ subP)))]] + caseP (//synthesis.path/seq [(if (tail? size idx) + (` ("lux case tuple right" (~ (code.nat idx)))) + (` ("lux case tuple left" (~ (code.nat idx))))) + subP])]] (wrap [caseS caseP])) (do r.Monad<Random> [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) @@ -101,34 +95,34 @@ (<| (times +100) (pattern-matching-spec run-jvm))) -(context: "[JS] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-js))) +## (context: "[JS] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-js))) -(context: "[Lua] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-lua))) +## (context: "[Lua] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-lua))) -(context: "[Ruby] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-ruby))) +## (context: "[Ruby] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-ruby))) -(context: "[Python] Function." - (<| (times +100) - (pattern-matching-spec run-python))) +## (context: "[Python] Function." +## (<| (times +100) +## (pattern-matching-spec run-python))) -(context: "[R] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-r))) +## (context: "[R] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-r))) -(context: "[Scheme] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-scheme))) +## (context: "[Scheme] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-scheme))) -(context: "[Common Lisp] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-common-lisp))) +## (context: "[Common Lisp] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-common-lisp))) -(context: "[PHP] Pattern-matching." - (<| (times +100) - (pattern-matching-spec run-php))) +## (context: "[PHP] Pattern-matching." +## (<| (times +100) +## (pattern-matching-spec run-php))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index e69590975..42d78f646 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -8,18 +8,11 @@ [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>]) ["r" math/random] - [macro] - (macro [code]) + (lang ["//." synthesis]) test) - (luxc [lang] - (lang [".L" host] - [synthesis #+ Synthesis])) + (luxc (lang [".L" host])) (test/luxc common)) -(def: upper-alpha-ascii - (r.Random Nat) - (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) - (def: (spec run) (-> Runner Test) (do r.Monad<Random> @@ -28,16 +21,8 @@ %int% r.int %deg% r.deg %frac% r.frac - %text% (r.text' upper-alpha-ascii +5)] + %text% (r.ascii +5)] (`` ($_ seq - (test "Can translate unit." - (|> (run (' [])) - (case> (#e.Success valueT) - (text/= hostL.unit (:! Text valueT)) - - (#e.Error error) - (exec (log! error) - false)))) (~~ (do-template [<desc> <type> <synthesis> <sample> <test>] [(test (format "Can translate " <desc> ".") (|> (run (<synthesis> <sample>)) @@ -48,46 +33,44 @@ (exec (log! error) false))))] - ["bool" Bool code.bool %bool% bool/=] - ["nat" Nat code.nat %nat% n/=] - ["int" Int code.int %int% i/=] - ["deg" Deg code.deg %deg% d/=] - ["frac" Frac code.frac %frac% f/=] - ["text" Text code.text %text% text/=])) + ["bool" Bool //synthesis.bool %bool% bool/=] + ["int" Int //synthesis.i64 %int% i/=] + ["frac" Frac //synthesis.f64 %frac% f/=] + ["text" Text //synthesis.text %text% text/=])) )))) (context: "[JVM] Primitives." (<| (times +100) (spec run-jvm))) -(context: "[JS] Primitives." - (<| (times +100) - (spec run-js))) +## (context: "[JS] Primitives." +## (<| (times +100) +## (spec run-js))) -(context: "[Lua] Primitives." - (<| (times +100) - (spec run-lua))) +## (context: "[Lua] Primitives." +## (<| (times +100) +## (spec run-lua))) -(context: "[Ruby] Primitives." - (<| (times +100) - (spec run-ruby))) +## (context: "[Ruby] Primitives." +## (<| (times +100) +## (spec run-ruby))) -(context: "[Python] Primitives." - (<| (times +100) - (spec run-python))) +## (context: "[Python] Primitives." +## (<| (times +100) +## (spec run-python))) -(context: "[R] Primitives." - (<| (times +100) - (spec run-r))) +## (context: "[R] Primitives." +## (<| (times +100) +## (spec run-r))) -(context: "[Scheme] Primitives." - (<| (times +100) - (spec run-scheme))) +## (context: "[Scheme] Primitives." +## (<| (times +100) +## (spec run-scheme))) -(context: "[Common Lisp] Primitives." - (<| (times +100) - (spec run-common-lisp))) +## (context: "[Common Lisp] Primitives." +## (<| (times +100) +## (spec run-common-lisp))) -(context: "[PHP] Primitives." - (<| (times +100) - (spec run-php))) +## (context: "[PHP] Primitives." +## (<| (times +100) +## (spec run-php))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index d6c848c27..41032f0c7 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -1,18 +1,13 @@ (.module: lux - (lux [io #+ IO] - (control [monad #+ do] + (lux (control [monad #+ do] pipe) (data ["e" error] [text]) + (lang ["//." synthesis]) ["r" math/random] - [macro] - (macro [code]) test) - (luxc [lang] - (lang ["_." module] - ["ls" synthesis] - (translation (jvm [".T_jvm" statement]) + (luxc (lang (translation (jvm [".T_jvm" statement]) ## (js [".T_js" statement]) ## (lua [".T_lua" statement]) ## (ruby [".T_ruby" statement]) @@ -20,17 +15,13 @@ ## (r [".T_r" statement]) ## (scheme [".T_scheme" statement]) ## (common-lisp [".T_common-lisp" statement]) - (php [".T_php" statement]) + ## (php [".T_php" statement]) ))) (test/luxc common)) -(def: upper-alpha-ascii - (r.Random Nat) - (|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +65))))) - (def: ident-part (r.Random Text) - (|> (r.text' upper-alpha-ascii +5) + (|> (r.ascii +5) (r.filter (function (_ sample) (not (or (text.contains? "/" sample) (text.contains? "[" sample) @@ -42,7 +33,7 @@ [def-name (r.seq ident-part ident-part) def-value r.int] (test "Can refer to definitions." - (|> (define def-name (code.int def-value)) + (|> (define def-name (//synthesis.i64 def-value)) (case> (#e.Success valueT) (i/= def-value (:! Int valueT)) @@ -56,8 +47,9 @@ [register (|> r.nat (:: @ map (n/% +100))) value r.int] (test "Can refer to local variables/registers." - (|> (run (` ("lux let" (~ (code.nat register)) (~ (code.int value)) - ((~ (code.int (nat-to-int register))))))) + (|> (run (//synthesis.branch/let [(//synthesis.i64 value) + register + (//synthesis.variable/local register)])) (case> (#e.Success outputT) (i/= value (:! Int outputT)) @@ -74,34 +66,34 @@ (<| (times +100) (references-spec run-jvm def-jvm))) -(context: "[JS] References." - (<| (times +100) - (references-spec run-js def-js))) +## (context: "[JS] References." +## (<| (times +100) +## (references-spec run-js def-js))) -(context: "[Lua] References." - (<| (times +100) - (references-spec run-lua def-lua))) +## (context: "[Lua] References." +## (<| (times +100) +## (references-spec run-lua def-lua))) -(context: "[Ruby] References." - (<| (times +100) - (references-spec run-ruby def-ruby))) +## (context: "[Ruby] References." +## (<| (times +100) +## (references-spec run-ruby def-ruby))) -(context: "[Python] References." - (<| (times +100) - (references-spec run-python def-python))) +## (context: "[Python] References." +## (<| (times +100) +## (references-spec run-python def-python))) -(context: "[R] References." - (<| (times +100) - (references-spec run-r def-r))) +## (context: "[R] References." +## (<| (times +100) +## (references-spec run-r def-r))) -(context: "[Scheme] References." - (<| (times +100) - (references-spec run-scheme def-scheme))) +## (context: "[Scheme] References." +## (<| (times +100) +## (references-spec run-scheme def-scheme))) -(context: "[Common Lisp] References." - (<| (times +100) - (references-spec run-common-lisp def-common-lisp))) +## (context: "[Common Lisp] References." +## (<| (times +100) +## (references-spec run-common-lisp def-common-lisp))) -(context: "[PHP] References." - (<| (times +100) - (references-spec run-php def-php))) +## (context: "[PHP] References." +## (<| (times +100) +## (references-spec run-php def-php))) |