From b88027c19181f24584d5ad1c46fb2443d65edece Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 14 Nov 2017 20:03:14 -0400
Subject: - Fixed some bugs. - new-luxc can now fully compile lux.lux!
---
.../source/luxc/lang/analysis/procedure/common.lux | 2 +-
new-luxc/source/luxc/lang/translation/loop.jvm.lux | 4 +-
.../luxc/lang/translation/procedure/common.jvm.lux | 5 +-
.../source/luxc/lang/translation/runtime.jvm.lux | 23 +++++++++
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
[[@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
[@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 [ ]
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
[#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)
--
cgit v1.2.3