From 1ff2c6ced65171a68ef761275a75ba4dc56caf7b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 30 Sep 2015 16:44:42 -0400 Subject: - Changed the license in the project.clj file (had forgotten until now). - Some minor updates to the standard library. - Some minor bug fixes & improvements. - program.lux has been removed. --- source/lux.lux | 41 ++++++++++++++++++++------ source/lux/codata/function.lux | 2 +- source/lux/data/char.lux | 4 +++ source/lux/data/list.lux | 6 ++++ source/lux/data/text.lux | 13 ++++++++ source/lux/host/jvm.lux | 28 ++++++++++++++---- source/lux/meta/lux.lux | 67 ++++++++++++++++++++++++++++++++++-------- source/lux/meta/type.lux | 34 +++++++++++++++++---- source/program.lux | 56 ----------------------------------- 9 files changed, 162 insertions(+), 89 deletions(-) delete mode 100644 source/program.lux (limited to 'source') 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 [ ] + [(def #export + (-> Int Int) + (i+ ))] + + [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}!"))) - )) -- cgit v1.2.3