From c79621772c862e9b94e1fc43e11996cbac54fed1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jul 2015 20:20:26 -0400 Subject: - lux;using no longer prefixes variables. - Fixed several bugs with host (JVM) interop. - Now packaging everything in a .jar file ("program.jar"). --- source/lux.lux | 4 +- source/lux/control/comonad.lux | 4 +- source/lux/control/monad.lux | 2 +- source/lux/data/list.lux | 2 +- source/lux/data/number.lux | 4 +- source/lux/data/text.lux | 4 +- source/lux/host/jvm.lux | 108 +++++++++++++++-------------------------- source/lux/math.lux | 5 +- source/lux/meta/lux.lux | 16 +++--- source/lux/meta/syntax.lux | 4 +- source/program.lux | 10 ++-- 11 files changed, 67 insertions(+), 96 deletions(-) (limited to 'source') diff --git a/source/lux.lux b/source/lux.lux index c51929635..8861bc241 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -2524,8 +2524,8 @@ (let [pattern (record$ (map (: (-> (, Text Type) (, Syntax Syntax)) (lambda [slot] (let [[sname stype] slot - full-name (split-slot sname)] - [(tag$ full-name) (symbol$ full-name)]))) + [module name] (split-slot sname)] + [(tag$ [module name]) (symbol$ ["" name])]))) slots))] (return (list (` (_lux_case (~ struct) (~ pattern) (~ body)))))) diff --git a/source/lux/control/comonad.lux b/source/lux/control/comonad.lux index 1830ff44f..ce9a7e7de 100644 --- a/source/lux/control/comonad.lux +++ b/source/lux/control/comonad.lux @@ -27,8 +27,8 @@ (All [w a b] (-> (CoMonad w) (-> (w a) b) (w a) (w b))) (using w - (using ;;_functor - (F;map f (;;split ma))))) + (using _functor + (map f (split ma))))) ## Syntax (defmacro #export (be tokens state) diff --git a/source/lux/control/monad.lux b/source/lux/control/monad.lux index b5552f987..a03c1499a 100644 --- a/source/lux/control/monad.lux +++ b/source/lux/control/monad.lux @@ -82,7 +82,7 @@ (All [m a b] (-> (Monad m) (-> a (m b)) (m a) (m b))) (using m - (;;join (:: ;;_functor (F;map f ma))))) + (join (:: _functor (F;map f ma))))) (def #export (map% m f xs) (All [m a b] diff --git a/source/lux/data/list.lux b/source/lux/data/list.lux index 450dee275..8fd5c2951 100644 --- a/source/lux/data/list.lux +++ b/source/lux/data/list.lux @@ -247,4 +247,4 @@ (def (M;join mma) (using List/Monoid - (foldL m;++ m;unit mma)))) + (foldL ++ unit mma)))) diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux index 453c30a13..8771ef06e 100644 --- a/source/lux/data/number.lux +++ b/source/lux/data/number.lux @@ -68,11 +68,11 @@ (def O;< ) (def (O;<= x y) (or ( x y) - (using (E;= x y)))) + (:: (E;= x y)))) (def O;> ) (def (O;>= x y) (or ( x y) - (using (E;= x y)))))] + (:: (E;= x y)))))] [ Int/Ord Int Int/Eq i< i>] [Real/Ord Real Real/Eq r< r>]) diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index f7f1a86c0..6ad9cfd63 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -46,8 +46,8 @@ (if (and (i< from to) (i>= from 0) (i<= to (size x))) - (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] - x [(_jvm_l2i from) (_jvm_l2i to)]) + (#;Some (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] + x [(_jvm_l2i from) (_jvm_l2i to)])) #;None)) (def #export (sub from x) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index a3a74d608..7af043969 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -22,8 +22,7 @@ (Parser Syntax) (form^ (do Parser/Monad [_ (symbol?^ ["" "finally"]) - expr id^ - _ end^] + expr id^] (M;wrap expr)))) (def catch^ @@ -32,8 +31,7 @@ [_ (symbol?^ ["" "catch"]) ex-class local-symbol^ ex symbol^ - expr id^ - _ end^] + expr id^] (M;wrap [ex-class ex expr])))) (def method-decl^ @@ -42,8 +40,7 @@ [modifiers (*^ local-tag^) name local-symbol^ inputs (tuple^ (*^ local-symbol^)) - output local-symbol^ - _ end^] + output local-symbol^] (M;wrap [modifiers name inputs output])))) (def field-decl^ @@ -51,16 +48,14 @@ (form^ (do Parser/Monad [modifiers (*^ local-tag^) name local-symbol^ - class local-symbol^ - _ end^] + class local-symbol^] (M;wrap [modifiers name class])))) (def arg-decl^ (Parser (, Text Text)) (form^ (do Parser/Monad [arg-name local-symbol^ - arg-class local-symbol^ - _ end^] + arg-class local-symbol^] (M;wrap [arg-name arg-class])))) (def method-def^ @@ -70,8 +65,7 @@ name local-symbol^ inputs (tuple^ (*^ arg-decl^)) output local-symbol^ - body id^ - _ end^] + body id^] (M;wrap [modifiers name inputs output body])))) (def method-call^ @@ -80,7 +74,6 @@ [method local-symbol^ arity-classes (tuple^ (*^ local-symbol^)) arity-args (tuple^ (*^ id^)) - _ end^ _ (: (Parser (,)) (if (i= (size arity-classes) (size arity-args)) @@ -108,47 +101,41 @@ (list (` (_jvm_finally (~ finally))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) - (do Lux/Monad - [current-module get-module-name - #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) - name))]] - (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) - (lambda [member] - (let [[modifiers name inputs output] member] - (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) - members)] - (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))] - (~@ members')))))))) + (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) + (lambda [member] + (let [[modifiers name inputs output] member] + (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) + members)] + (emit (list (` (_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] + (~@ members'))))))) (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] [fields (*^ field-decl^)] [methods (*^ method-def^)]) (do Lux/Monad [current-module get-module-name - #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) - name)) - fields' (map (: (-> (, (List Text) Text Text) Syntax) + #let [fields' (map (: (-> (, (List Text) Text Text) Syntax) (lambda [field] (let [[modifiers name class] field] - (` ((~ (symbol$ ["" name])) + (` ((~ (text$ name)) (~ (text$ class)) [(~@ (map text$ modifiers))]))))) fields) methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) (lambda [methods] (let [[modifiers name inputs output body] methods] - (` ((~ (symbol$ ["" name])) + (` ((~ (text$ name)) [(~@ (map (: (-> (, Text Text) Syntax) (lambda [in] (let [[left right] in] - (form$ (list (text$ left) + (form$ (list (symbol$ ["" left]) (text$ right)))))) inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))] (~ body)))))) methods)]] - (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super)) + (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super)) [(~@ (map text$ interfaces))] [(~@ fields')] [(~@ methods')])))))) @@ -166,9 +153,9 @@ [g!lock (gensym "") g!body (gensym "")] (emit (list (` (;let [(~ g!lock) (~ lock) - _ (_jvm_monitor-enter (~ g!lock)) + _ (_jvm_monitorenter (~ g!lock)) (~ g!body) (~ body) - _ (_jvm_monitor-exit (~ g!lock))] + _ (_jvm_monitorexit (~ g!lock))] (~ g!body))))) )) @@ -216,24 +203,27 @@ (.= (~ (text$ field)) (~ value) (~ g!obj))))))))) (defsyntax #export (.! [call method-call^] obj) - (case obj - (#;Meta [_ (#;SymbolS obj-name)]) - (do Lux/Monad - [obj-type (find-var-type obj-name)] - (case obj-type - (#;DataT class) - (let [[m-name ?m-classes m-args] call] + (let [[m-name ?m-classes m-args] call] + (case obj + (#;Meta [_ (#;SymbolS obj-name)]) + (do Lux/Monad + [obj-type (find-var-type obj-name)] + (case obj-type + (#;DataT class) (emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] - (~ obj) [(~@ m-args)]))))) + (~ obj) [(~@ m-args)])))) - _ - (fail "Can only call method on object."))) + _ + (fail "Can only call method on object."))) - _ - (do Lux/Monad - [g!obj (gensym "")] - (emit (list (` (;let [(~ g!obj) (~ obj)] - (.! (~@ *tokens*))))))))) + _ + (do Lux/Monad + [g!obj (gensym "")] + (emit (list (` (;let [(~ g!obj) (~ obj)] + (.! ((~ (symbol$ ["" m-name])) + [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] + [(~@ m-args)]) + (~ g!obj)))))))))) (defsyntax #export (..? [field local-symbol^] [class local-symbol^]) (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) @@ -246,25 +236,3 @@ (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ m-classes))] [(~@ m-args)])))))) - -## (definterface Function [] -## (#public #abstract apply [java.lang.Object] java.lang.Object)) - -## (_jvm_interface "Function" [] -## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) - -## (defclass MyFunction [Function] -## (#public #static foo java.lang.Object) -## (#public [] void -## (_jvm_invokespecial java.lang.Object [] this [])) -## (#public apply [(arg java.lang.Object)] java.lang.Object -## "YOLO")) - -## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"] -## [(foo "java.lang.Object" ["public" "static"])] -## ( [] "void" -## ["public"] -## (_jvm_invokespecial java.lang.Object [] this [])) -## (apply [(arg "java.lang.Object")] "java.lang.Object" -## ["public"] -## "YOLO")) diff --git a/source/lux/math.lux b/source/lux/math.lux index 8a9432261..a495d130c 100644 --- a/source/lux/math.lux +++ b/source/lux/math.lux @@ -38,7 +38,6 @@ [ceil "ceil"] [floor "floor"] - [round "round"] [exp "exp"] [log "log"] @@ -50,6 +49,10 @@ [->radians "toRadians"] ) +(def #export (round n) + (-> Real Int) + (_jvm_invokestatic "java.lang.Math" "round" ["double"] [n])) + (do-template [ ] [(def #export ( x y) (-> Real Real Real) diff --git a/source/lux/meta/lux.lux b/source/lux/meta/lux.lux index 99ca200cf..19b7dd9df 100644 --- a/source/lux/meta/lux.lux +++ b/source/lux/meta/lux.lux @@ -187,14 +187,14 @@ (case (get module (get@ #;modules state)) (#;Some =module) (using List/Monad - (#;Right [state (M;join (:: M;_functor (F;map (: (-> (, Text (, Bool (DefData' Macro))) - (List Text)) - (lambda [gdef] - (let [[name [export? _]] gdef] - (if export? - (list name) - (list))))) - (get@ #;defs =module))))])) + (#;Right [state (join (:: _functor (F;map (: (-> (, Text (, Bool (DefData' Macro))) + (List Text)) + (lambda [gdef] + (let [[name [export? _]] gdef] + (if export? + (list name) + (list))))) + (get@ #;defs =module))))])) #;None (#;Left ($ text:++ "Unknown module: " module)))) diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index fcee80b8f..63ab81475 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -235,7 +235,7 @@ _ (l;fail "Syntax pattern expects 2-tuples or symbols.")))) args) - #let [g!tokens (m;symbol$ ["" "*tokens*"])] + g!tokens (gensym "tokens") g!_ (gensym "_") #let [names (:: List/Functor (F;map first names+parsers)) error-msg (text$ (text:++ "Wrong syntax for " name)) @@ -249,7 +249,7 @@ (~ g!_) (l;fail (~ error-msg))))))) body - (reverse names+parsers)) + (: (List (, Syntax Syntax)) (list& [(symbol$ ["" ""]) (` end^)] (reverse names+parsers)))) macro-def (: Syntax (` (m;defmacro ((~ (symbol$ ["" name])) (~ g!tokens)) (~ body'))))]] diff --git a/source/program.lux b/source/program.lux index 37391eda9..086506725 100644 --- a/source/program.lux +++ b/source/program.lux @@ -41,8 +41,8 @@ (program args (case args - #;Nil - (println "Hello, world!") - - (#;Cons [name _]) - (println ($ text:++ "Hello, " name "!")))) + (\ (list name)) + (println ($ text:++ "Hello, " name "!")) + + _ + (println "Hello, world!"))) -- cgit v1.2.3