aboutsummaryrefslogtreecommitdiff
path: root/source
diff options
context:
space:
mode:
Diffstat (limited to 'source')
-rw-r--r--source/lux.lux41
-rw-r--r--source/lux/codata/function.lux2
-rw-r--r--source/lux/data/char.lux4
-rw-r--r--source/lux/data/list.lux6
-rw-r--r--source/lux/data/text.lux13
-rw-r--r--source/lux/host/jvm.lux28
-rw-r--r--source/lux/meta/lux.lux67
-rw-r--r--source/lux/meta/type.lux34
-rw-r--r--source/program.lux56
9 files changed, 162 insertions, 89 deletions
diff --git a/source/lux.lux b/source/lux.lux
index ddb3384cc..4d1c3fdef 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -5,7 +5,7 @@
## First things first, must define functions
(_jvm_interface "Function" [] []
- ("apply" ["public" "abstract"] [] [] ["java.lang.Object"] "java.lang.Object"))
+ ("apply" ["public" "abstract"] [] [] ["java.lang.Object"] "java.lang.Object"))
## Basic types
(_lux_def Bool (10 ["lux" "Bool"]
@@ -394,6 +394,11 @@
(_lux_export DefData)
(_lux_declare-tags [#ValueD #TypeD #MacroD #AliasD] DefData)
+(_lux_def Definition
+ (#NamedT ["lux" "Definition"]
+ (#AppT (#AppT Meta Bool) DefData)))
+(_lux_export Definition)
+
## Base functions & macros
## (def _cursor
## Cursor
@@ -1060,8 +1065,9 @@
## (-> Compiler (Either Text (, Compiler a))))
(def''' #export Lux
Type
- (All [a]
- (-> Compiler ($' Either Text (, Compiler a)))))
+ (#NamedT ["lux" "Lux"]
+ (All [a]
+ (-> Compiler ($' Either Text (, Compiler a))))))
## (defsig (Monad m)
## (: (All [a] (-> a (m a)))
@@ -1405,6 +1411,15 @@
_
#None))
+(def''' (get-tag x)
+ (-> AST ($' Maybe Ident))
+ (_lux_case x
+ [_ (#TagS sname)]
+ (#Some sname)
+
+ _
+ #None))
+
(def''' (get-name x)
(-> AST ($' Maybe Text))
(_lux_case x
@@ -1535,7 +1550,7 @@
[$module (get module modules)
gdef (let' [{#module-aliases _ #defs bindings #imports _ #tags tags #types types} (_lux_: ($' Module Compiler) $module)]
(get name bindings))]
- (_lux_case (_lux_: (, Bool DefData) gdef)
+ (_lux_case (_lux_: Definition gdef)
[exported? (#MacroD macro')]
(if exported?
(#Some macro')
@@ -2023,7 +2038,7 @@
(if (symbol? arg)
(` (;_lux_lambda (~ g!blank) (~ arg) (~ body')))
(` (;_lux_lambda (~ g!blank) (~ g!blank)
- (case (~ g!blank) (~ arg) (~ body')))))))
+ (case (~ g!blank) (~ arg) (~ body')))))))
body
(reverse tail))]
(return (@list (if (symbol? head)
@@ -2616,7 +2631,7 @@
#cursor cursor}
(case (get module modules)
(#Some =module)
- (let [to-alias (map (: (-> (, Text (, Bool DefData))
+ (let [to-alias (map (: (-> (, Text Definition)
(List Text))
(lambda [gdef]
(let [[name [export? _]] gdef]
@@ -3226,7 +3241,7 @@
(return (@list (` ((: (-> (~@ (map type->ast init-types))
(~ (type->ast expected)))
(lambda (~ (symbol$ ["" "recur"])) [(~@ vars)]
- (~ body)))
+ (~ body)))
(~@ inits))))))
(do Lux/Monad
[aliases (map% Lux/Monad
@@ -3250,8 +3265,8 @@
[slots (: (Lux (, Ident (List Ident)))
(case (: (Maybe (, Ident (List Ident)))
(do Maybe/Monad
- [hslot (get-ident hslot')
- tslots (map% Maybe/Monad get-ident tslots')]
+ [hslot (get-tag hslot')
+ tslots (map% Maybe/Monad get-tag tslots')]
(wrap [hslot tslots])))
(#Some slots)
(return slots)
@@ -3278,3 +3293,11 @@
_
(fail "Wrong syntax for \\slots")))
+
+(do-template [<name> <diff>]
+ [(def #export <name>
+ (-> Int Int)
+ (i+ <diff>))]
+
+ [inc 1]
+ [dec -1])
diff --git a/source/lux/codata/function.lux b/source/lux/codata/function.lux
index a23e969b3..1b7336049 100644
--- a/source/lux/codata/function.lux
+++ b/source/lux/codata/function.lux
@@ -14,7 +14,7 @@
(def #export (flip f)
(All [a b c]
(-> (-> a b c) (-> b a c)))
- (lambda [y x] (f x y)))
+ (lambda [x y] (f y x)))
(def #export (. f g)
(All [a b c]
diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux
index 4e0d41b22..b7b4c6bda 100644
--- a/source/lux/data/char.lux
+++ b/source/lux/data/char.lux
@@ -16,3 +16,7 @@
(defstruct #export Char/Show (S;Show Char)
(def (show x)
($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\"")))
+
+(def #export (->text c)
+ (-> Char Text)
+ (_jvm_invokevirtual "java.lang.Object" "toString" [] c []))
diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux
index 563282f32..6bf050228 100644
--- a/source/lux/data/list.lux
+++ b/source/lux/data/list.lux
@@ -336,3 +336,9 @@
(def #export zip2 (zip 2))
(def #export zip3 (zip 3))
+
+(def #export (empty? xs)
+ (All [a] (-> (List a) Bool))
+ (case xs
+ #;Nil true
+ _ false))
diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux
index 744a22f2e..af2de51ff 100644
--- a/source/lux/data/text.lux
+++ b/source/lux/data/text.lux
@@ -180,3 +180,16 @@
_
(#;Left "Wrong syntax for <>")))
+
+(def #export (split-lines text)
+ (-> Text (List Text))
+ (case (: (Maybe (List Text))
+ (do Maybe/Monad
+ [idx (index-of "\n" text)
+ [head post] (split (inc idx) text)]
+ (wrap (#;Cons head (split-lines post)))))
+ #;None
+ (#;Cons text #;Nil)
+
+ (#;Some xs)
+ xs))
diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux
index 573e181b5..737c1731d 100644
--- a/source/lux/host/jvm.lux
+++ b/source/lux/host/jvm.lux
@@ -93,6 +93,21 @@
arg-classes (map second args)]]
(wrap [vars var-types (list:join var-rebinds) arg-classes])))
+(def (class->type class)
+ (-> JvmType AST)
+ (case class
+ "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))
+ "void" (` ;Unit)
+ _
+ (` (^ (~ (symbol$ ["" class]))))))
+
## Parsers
(def annotation-params^
(Parser (List AnnotationParam))
@@ -227,7 +242,7 @@
(def (gen-expected-output [ex? opt? output] body)
(-> ExpectedOutput AST (, AST AST))
- (let [type (` (^ (~ (symbol$ ["" output]))))
+ (let [type (class->type output)
[body type] (if opt?
[(` (;;??? (~ body)))
(` (Maybe (~ type)))]
@@ -321,14 +336,15 @@
(defsyntax #export (null? obj)
(emit (@list (` (;_jvm_null? (~ obj))))))
-(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ exp-input^))] [ex? (tag?^ ["" "!"])])
+(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ exp-input^))] [unsafe? (tag?^ ["" "unsafe"])])
(do Lux/Monad
[[vars var-types var-rebinds arg-classes] (prepare-args args)
#let [new-expr (` (;_jvm_new (~ (text$ class)) [(~@ (map text$ arg-classes))] [(~@ vars)]))
- new-expr (if ex?
- (` (try (~ new-expr)))
- new-expr)]]
- (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class]))))
+ return-type (class->type class)
+ [new-expr return-type] (if unsafe?
+ [(` (try (~ new-expr))) (` (Either Text (~ return-type)))]
+ [new-expr return-type])]]
+ (wrap (@list (` (: (-> (, (~@ var-types)) (~ return-type))
(lambda [[(~@ vars)]]
(let [(~@ var-rebinds)]
(~ new-expr)))))))))
diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux
index 650e67133..b6ff09f59 100644
--- a/source/lux/meta/lux.lux
+++ b/source/lux/meta/lux.lux
@@ -9,9 +9,11 @@
(functor #as F)
(monad #as M #refer (#only do))
(show #as S))
- (lux/data (list #refer #all #open ("list:" List/Monoid))
+ (lux/data (list #refer #all #open ("list:" List/Monoid List/Functor))
(text #as T #open ("text:" Text/Monoid Text/Eq))
- (number/int #as I #open ("i" Int/Number))))
+ (number/int #as I #open ("i" Int/Number))
+ (tuple #as t)
+ ident))
## [Types]
## (deftype (Lux a)
@@ -77,7 +79,7 @@
(#;Some $module)
(case (|> (: (Module Compiler) $module) (get@ #;defs) (get name))
(#;Some gdef)
- (case (: (, Bool DefData) gdef)
+ (case (: Definition gdef)
[exported? (#;MacroD macro')]
(if (or exported? (text:= module current-module))
(#;Some macro')
@@ -210,7 +212,7 @@
(case (get module (get@ #;modules state))
(#;Some =module)
(using List/Monad
- (#;Right [state (join (map (: (-> (, Text (, Bool DefData))
+ (#;Right [state (join (map (: (-> (, Text Definition)
(List Text))
(lambda [gdef]
(let [[name [export? _]] gdef]
@@ -251,7 +253,7 @@
envs)))
(def (find-in-defs' name state)
- (-> Ident Compiler (Maybe DefData))
+ (-> Ident Compiler (Maybe Definition))
(let [[v-prefix v-name] name
{#;source source #;modules modules
#;envs envs #;type-vars types #;host host
@@ -266,17 +268,17 @@
#;None
#;None
- (#;Some [_ def-data])
- (case def-data
- (#;AliasD name') (find-in-defs' name' state)
- _ (#;Some def-data)
+ (#;Some def)
+ (case def
+ [_ (#;AliasD name')] (find-in-defs' name' state)
+ _ (#;Some def)
)))
))
(def #export (find-in-defs name state)
(-> Ident Compiler (Maybe Type))
(case (find-in-defs' name state)
- (#;Some def-data)
+ (#;Some [_ def-data])
(case def-data
(#;ValueD [type value]) (#;Some type)
(#;MacroD _) (#;Some Macro)
@@ -315,9 +317,50 @@
(case (find-in-defs' name' state)
(#;Some def-data)
(case def-data
- (#;TypeD type) (#;Right [state type])
- _ (#;Left ($ text:++ "Definition is not a type: " (ident->text name))))
+ [_ (#;TypeD type)] (#;Right [state type])
+ _ (#;Left ($ text:++ "Definition is not a type: " (ident->text name))))
_
(#;Left ($ text:++ "Unknown var: " (ident->text name))))))
))
+
+(def #export (defs module-name state)
+ (-> Text (Lux (List (, Text Definition))))
+ (case (get module-name (get@ #;modules state))
+ #;None (#;Left ($ text:++ "Unknown module: " module-name))
+ (#;Some module) (#;Right [state (get@ #;defs module)])
+ ))
+
+(def #export (exports module-name)
+ (-> Text (Lux (List (, Text Definition))))
+ (do Lux/Monad
+ [defs (defs module-name)]
+ (wrap (filter (lambda [[name [exported? data]]] exported?)
+ defs))))
+
+(def #export (modules state)
+ (Lux (List Text))
+ (|> state
+ (get@ #;modules)
+ (list:map t;first)
+ (#;Right state)))
+
+(def #export (find-module name state)
+ (-> Text (Lux (Module Compiler)))
+ (case (get name (get@ #;modules state))
+ (#;Some module)
+ (#;Right state module)
+
+ _
+ (#;Left ($ text:++ "Unknown module: " name))))
+
+(def #export (tags-for [module name])
+ (-> Ident (Lux (Maybe (List Ident))))
+ (do Lux/Monad
+ [module (find-module module)]
+ (case (get name (get@ #;types module))
+ (#;Some [tags _])
+ (wrap (#;Some tags))
+
+ _
+ (wrap #;None))))
diff --git a/source/lux/meta/type.lux b/source/lux/meta/type.lux
index a1c34b1ac..0938d104d 100644
--- a/source/lux/meta/type.lux
+++ b/source/lux/meta/type.lux
@@ -7,14 +7,36 @@
(lux (control show
eq
monad)
- (data (text #open ("text:" Text/Monoid Text/Eq))
- (number/int #open ("int:" Int/Eq Int/Show))
+ (data (char #as c)
+ (text #as t #open ("text:" Text/Monoid Text/Eq))
+ (number/int #open ("int:" Int/Number Int/Ord Int/Show))
maybe
- (list #refer #all #open ("list:" List/Monad List/Fold)))
+ (list #refer #all #open ("list:" List/Monad List/Monoid List/Fold)))
))
(open List/Fold)
+## [Utils]
+(def (unravel-fun type)
+ (-> Type (, Type (List Type)))
+ (case type
+ (#;LambdaT in out')
+ (let [[out ins] (unravel-fun out')]
+ [out (@list& in ins)])
+
+ _
+ [type (@list)]))
+
+(def (unravel-app type)
+ (-> Type (, Type (List Type)))
+ (case type
+ (#;AppT left' right)
+ (let [[left rights] (unravel-app left')]
+ [left (list:++ rights (@list right))])
+
+ _
+ [type (@list)]))
+
## [Structures]
(defstruct #export Type/Show (Show Type)
(def (show type)
@@ -44,7 +66,8 @@
($ text:++ "(| " (|> members (list:map show) (interpose " ") (foldL text:++ "")) ")"))
(#;LambdaT input output)
- ($ text:++ "(-> " (show input) " " (show output) ")")
+ (let [[out ins] (unravel-fun type)]
+ ($ text:++ "(-> " (|> ins (list:map show) (interpose " ") (foldL text:++ "")) " " (show out) ")"))
(#;VarT id)
($ text:++ "⌈" (int:show id) "⌋")
@@ -56,7 +79,8 @@
($ text:++ "⟨" (int:show id) "⟩")
(#;AppT fun param)
- ($ text:++ "(" (show fun) " " (show param) ")")
+ (let [[type-fun type-args] (unravel-app type)]
+ ($ text:++ "(" (show type-fun) " " (|> type-args (list:map show) (interpose " ") (foldL text:++ "")) ")"))
(#;UnivQ env body)
($ text:++ "(All " (show body) ")")
diff --git a/source/program.lux b/source/program.lux
deleted file mode 100644
index f013655bc..000000000
--- a/source/program.lux
+++ /dev/null
@@ -1,56 +0,0 @@
-## Copyright (c) Eduardo Julian. All rights reserved.
-## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
-## If a copy of the MPL was not distributed with this file,
-## You can obtain one at http://mozilla.org/MPL/2.0/.
-
-(;import lux
- (lux (control (monoid #as m)
- functor
- monad
- comonad
- bounded
- eq
- hash
- (ord #as O)
- (show #as S)
- number
- enum)
- (data bool
- char
- (either #as e)
- id
- list
- maybe
- (number (int #refer (#only) #open ("i:" Int/Show))
- (real #refer (#only)))
- (text #refer (#only <>) #open ("text:" Text/Monoid))
- (writer #refer (#only))
- (tuple #refer (#only))
- )
- (codata (stream #as s)
- (lazy #refer (#only))
- (function #refer (#only))
- (reader #as r)
- (state #refer (#only))
- io)
- (host jvm
- io)
- (meta ast
- lux
- syntax
- type)
- math
- ))
-
-(program args
- (case args
- (\ (@list name))
- (write-line (<> "Hello, #{name}!"))
-
- _
- (do IO/Monad
- [_ (write "Please, tell me your name: ")
- name' read-line
- #let [name (? "???" name')]]
- (write-line (<> "Hello, #{name}!")))
- ))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 10:47:27 +0000