diff options
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang/analysis/procedure/common.lux | 2 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/loop.jvm.lux | 4 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux | 5 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/runtime.jvm.lux | 23 | ||||
-rw-r--r-- | stdlib/source/lux.lux | 57 |
5 files changed, 71 insertions, 20 deletions
diff --git a/new-luxc/source/luxc/lang/analysis/procedure/common.lux b/new-luxc/source/luxc/lang/analysis/procedure/common.lux index 3965e78ba..3688f990e 100644 --- a/new-luxc/source/luxc/lang/analysis/procedure/common.lux +++ b/new-luxc/source/luxc/lang/analysis/procedure/common.lux @@ -271,7 +271,7 @@ (install "hash" (unary Text Nat)) (install "replace-once" (trinary Text Text Text Text)) (install "replace-all" (trinary Text Text Text Text)) - (install "char" (binary Text Nat Nat)) + (install "char" (binary Text Nat (type (Maybe Nat)))) (install "clip" (trinary Text Nat Nat Text)) ))) diff --git a/new-luxc/source/luxc/lang/translation/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/loop.jvm.lux index d9216f1a7..6e51d7eed 100644 --- a/new-luxc/source/luxc/lang/translation/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/loop.jvm.lux @@ -25,7 +25,7 @@ (do meta;Monad<Meta> [[@begin offset] hostL;anchor argsI (monad;map @ (function [[register argS]] - (let [register' (n.+ offset register)] + (let [register' (|> register (n.+ offset))] (: (Meta $;Inst) (case argS (^multi (^code ((~ [_ (#;Int var)]))) @@ -50,7 +50,7 @@ (do meta;Monad<Meta> [@begin $i;make-label initsI+ (monad;map @ translate initsS+) - bodyI (hostL;with-anchor [@begin offset] + bodyI (hostL;with-anchor [@begin (n.inc offset)] (translate bodyS)) #let [initializationI (|> (list;enumerate initsI+) (list/map (function [[register initI]] diff --git a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux index e680c46e8..9fd2df62f 100644 --- a/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/procedure/common.jvm.lux @@ -58,6 +58,7 @@ ## [Utils] (def: $Object $;Type ($t;class "java.lang.Object" (list))) (def: $Object-Array $;Type ($t;array +1 $Object)) +(def: $Variant $;Type ($t;array +1 $Object)) (def: $String $;Type ($t;class "java.lang.String" (list))) (def: $CharSequence $;Type ($t;class "java.lang.CharSequence" (list))) (def: $Function $;Type ($t;class hostL;function-class (list))) @@ -408,8 +409,8 @@ ($i;INVOKEVIRTUAL "java.lang.String" "contains" ($t;method (list $CharSequence) (#;Some $t;boolean) (list)) false) ($i;wrap #$;Boolean)] [text//char ($i;CHECKCAST "java.lang.String") jvm-intI - ($i;INVOKESTATIC hostL;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $t;int) (list)) false) - lux-intI] + ($i;INVOKESTATIC hostL;runtime-class "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list)) false) + id] ) (do-template [<name> <pre-subject> <pre-param> <pre-extra> <op>] diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux index 0a330ab73..cc17014e1 100644 --- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux @@ -386,6 +386,28 @@ $i;DRETURN))) ))) +(def: text-methods + $;Def + (|>. ($d;method #$;Public $;staticM "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list)) + (let [get-charI (|>. ($i;ALOAD +0) + ($i;ILOAD +1) + ($i;INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t;method (list $t;int) (#;Some $t;int) (list)) false) + $i;I2L + ($i;wrap #$;Long))] + (<| $i;with-label (function [@from]) + $i;with-label (function [@to]) + $i;with-label (function [@handler]) + (|>. ($i;try @from @to @handler "java.lang.Exception") + ($i;label @from) + get-charI + someI + $i;ARETURN + ($i;label @to) + ($i;label @handler) + noneI + $i;ARETURN)))) + )) + (def: pm-methods $;Def (let [tuple-sizeI (|>. ($i;ALOAD +0) $i;ARRAYLENGTH) @@ -564,6 +586,7 @@ nat-methods frac-methods deg-methods + text-methods pm-methods io-methods))] _ (commonT;store-class hostL;runtime-class bytecode)] diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 70563181a..0da0a628a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -4281,30 +4281,57 @@ (#Some [def-type def-meta def-value]) (#Right [state [def-type def-value]]))))) +(def: (find-type-var idx bindings) + (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) + (case bindings + #;Nil + #;Nil + + (#;Cons [var bound] bindings') + (if (n.= idx var) + bound + (find-type-var idx bindings')))) + (def: (find-type ident) (-> Ident (Meta Type)) (do Monad<Meta> [#let [[module name] ident] current-module current-module-name] - (function [state] - (if (text/= "" module) - (case (find-in-env name state) - (#Some struct-type) - (#Right state struct-type) + (function [compiler] + (let [temp (if (text/= "" module) + (case (find-in-env name compiler) + (#Some struct-type) + (#Right [compiler struct-type]) - _ - (case (find-def-type [current-module name] state) - (#Some struct-type) - (#Right state struct-type) + _ + (case (find-def-type [current-module name] compiler) + (#Some struct-type) + (#Right [compiler struct-type]) - _ - (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) - (case (find-def-type ident state) - (#Some struct-type) - (#Right state struct-type) + _ + (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) + (case (find-def-type ident compiler) + (#Some struct-type) + (#Right [compiler struct-type]) + + _ + (#Left ($_ text/compose "Unknown var: " (ident/encode ident)))))] + (case temp + (#Right [compiler (#Var type-id)]) + (let [{#info _ #source _ #current-module _ #modules _ + #scopes _ #type-context type-context #host _ + #seed _ #expected _ #cursor _ + #scope-type-vars _} compiler + {#ex-counter _ #var-counter _ #var-bindings var-bindings} type-context] + (case (find-type-var type-id var-bindings) + #;None + temp + + (#;Some actualT) + (#Right [compiler actualT]))) _ - (#Left ($_ text/compose "Unknown var: " (ident/encode ident))))) + temp)) ))) (def: (zip2 xs ys) |