From 86538182a50390e7882778cc02e69482e846edd5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 24 May 2021 11:23:40 -0400 Subject: Almost done with Scheme. But will have to postpone finishing it because Kawa is not up to snuff.--- lux-scheme/commands.md | 8 ++++++- lux-scheme/source/program.lux | 53 +++++++++++++++++++++++++++++++------------ 2 files changed, 46 insertions(+), 15 deletions(-) (limited to 'lux-scheme') diff --git a/lux-scheme/commands.md b/lux-scheme/commands.md index 055e90d8f..7c915200c 100644 --- a/lux-scheme/commands.md +++ b/lux-scheme/commands.md @@ -11,6 +11,7 @@ cd ~/lux/lux-scheme/ && lein clean && lein lux auto test ``` ## Develop +## NOTE: Must set lux/control/concurrency/thread.parallelism = 1 before compiling to make sure Kawa doesn't cause trouble. cd ~/lux/lux-scheme/ \ && lein clean \ && lein lux auto build @@ -19,6 +20,11 @@ cd ~/lux/lux-scheme/ \ ## Try ``` -cd ~/lux/lux-scheme/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +## Compile Lux's Standard Library's tests using a JVM-based compiler. +cd ~/lux/stdlib/ \ +&& lein clean \ +&& time java -jar ~/lux/lux-scheme/target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux + +clear && time kawa ~/lux/stdlib/target/program.scm ``` diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux index da9317961..e318c6abd 100644 --- a/lux-scheme/source/program.lux +++ b/lux-scheme/source/program.lux @@ -6,7 +6,7 @@ [abstract ["." monad (#+ do)]] [control - [pipe (#+ exec> case>)] + [pipe (#+ exec> case> new>)] ["." try (#+ Try)] ["." exception (#+ exception:)] ["." io (#+ IO io)] @@ -94,19 +94,30 @@ ["#::." (toString [] String)]) +(host.import: gnu/lists/IString + ["#::." + (toString [] String)]) + (host.import: gnu/lists/Pair ["#::." (getCar [] java/lang/Object) (getCdr [] java/lang/Object)]) +(host.import: gnu/lists/EmptyList + ["#::." + (#static emptyList gnu/lists/EmptyList)]) + (host.import: (gnu/lists/FVector E) ["#::." (getBufferLength [] int) (getRaw [int] E)]) +(host.import: gnu/lists/U8Vector) + (host.import: gnu/mapping/Procedure ["#::." - (apply2 [java/lang/Object java/lang/Object] #try java/lang/Object)]) + (apply2 [java/lang/Object java/lang/Object] #try java/lang/Object) + (applyN [[java/lang/Object]] #try java/lang/Object)]) (host.import: gnu/mapping/Environment) @@ -165,10 +176,10 @@ (if cdr? (case (array.read 1 value) (#.Some flag_is_set) - (:coerce java/lang/Object "") + true #.None - (host.null)) + false) (|> value (array.read 0) maybe.assume @@ -185,7 +196,7 @@ (def: (tuple_value lux_value value) (-> (-> java/lang/Object java/lang/Object) (Array java/lang/Object) gnu/lists/FVector) - (host.object [] gnu/lists/SimpleVector [program/TupleValue] + (host.object [] gnu/lists/SimpleVector [program/TupleValue gnu/lists/GVector] [] ## Methods (program/TupleValue @@ -255,12 +266,12 @@ (do try.monad [tag (read (gnu/lists/Pair::getCar host_object)) #let [host_object (:coerce gnu/lists/Pair (gnu/lists/Pair::getCdr host_object)) - flag (case (host.check java/lang/String (gnu/lists/Pair::getCar host_object)) - (#.Some _) - true + flag (case (host.check java/lang/Boolean (gnu/lists/Pair::getCar host_object)) + (#.Some flag) + (:coerce Bit flag) #.None - false)] + (undefined))] value (read (gnu/lists/Pair::getCdr host_object))] (wrap (..variant (:coerce Nat tag) flag value)))) @@ -287,17 +298,23 @@ (#try.Success host_object) #.None)] - [java/lang/Boolean] [java/lang/String] [gnu/mapping/Procedure] + [java/lang/Boolean] [java/lang/Long] [java/lang/Double] [java/lang/String] + [gnu/mapping/Procedure] [gnu/lists/U8Vector] )) - (~~ (template [ ] + (~~ (template [ ] [(case (host.check host_object) (#.Some host_object) - (#try.Success ( host_object)) + (#try.Success (<| host_object)) #.None)] + [java/lang/Integer java/lang/Integer::longValue] + + [gnu/lists/EmptyList (new> [] [])] [gnu/math/IntNum gnu/math/IntNum::longValue] [gnu/math/DFloNum gnu/math/DFloNum::doubleValue] [gnu/lists/FString gnu/lists/FString::toString] + [gnu/lists/IString gnu/lists/IString::toString] + [program/VariantValue program/VariantValue::getValue] [program/TupleValue program/TupleValue::getValue] )) @@ -318,7 +335,7 @@ (def: (expander macro inputs lux) Expander - (case (ensure_macro macro) + (case (..ensure_macro macro) (#.Some macro) (case (gnu/mapping/Procedure::apply2 (lux_value (:coerce java/lang/Object inputs)) (lux_value (:coerce java/lang/Object lux)) @@ -408,7 +425,15 @@ (:coerce Try) try.assume (:coerce Try) - (#try.Failure "YOLO"))) + (do try.monad + [handler (try.from_maybe (..ensure_macro (:coerce Macro handler))) + output (gnu/mapping/Procedure::applyN (array.from_list (list (lux_value (:coerce java/lang/Object name)) + (lux_value (:coerce java/lang/Object phase)) + (lux_value (:coerce java/lang/Object archive)) + (lux_value (:coerce java/lang/Object parameters)) + (lux_value (:coerce java/lang/Object state)))) + handler)] + (..read output)))) @.scheme (def: (extender handler) -- cgit v1.2.3