diff options
author | Eduardo Julian | 2015-07-19 23:43:37 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-07-19 23:43:37 -0400 |
commit | 3a760fa6c0f47f7621970b9747779f3edcc96286 (patch) | |
tree | de0e08366eae38ae4602862a39c2829bb5a8fab4 | |
parent | f5e3afe5a5337b5dc840ed0fd6a76244cf0aac6b (diff) |
- Added a few more modules.
- Added some type-tags to avoid reflection inside the compiler.
-rw-r--r-- | input/lux/data/bool.lux | 33 | ||||
-rw-r--r-- | input/lux/data/bounded.lux | 9 | ||||
-rw-r--r-- | input/lux/data/char.lux | 20 | ||||
-rw-r--r-- | input/lux/data/eq.lux | 12 | ||||
-rw-r--r-- | input/lux/data/number.lux | 53 | ||||
-rw-r--r-- | input/lux/data/ord.lux | 21 | ||||
-rw-r--r-- | input/lux/data/show.lux | 13 | ||||
-rw-r--r-- | input/lux/data/text.lux | 19 | ||||
-rw-r--r-- | input/lux/host/java.lux | 15 | ||||
-rw-r--r-- | input/lux/meta/lux.lux | 5 | ||||
-rw-r--r-- | input/lux/meta/syntax.lux | 18 | ||||
-rw-r--r-- | input/program.lux | 4 | ||||
-rw-r--r-- | src/lux/analyser/module.clj | 1 | ||||
-rw-r--r-- | src/lux/compiler/base.clj | 48 |
14 files changed, 170 insertions, 101 deletions
diff --git a/input/lux/data/bool.lux b/input/lux/data/bool.lux new file mode 100644 index 000000000..d4f223612 --- /dev/null +++ b/input/lux/data/bool.lux @@ -0,0 +1,33 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux + (lux/control (monoid #as m)) + (.. (eq #as E) + (show #as S))) + +## [Structures] +(defstruct #export Bool/Eq (E;Eq Bool) + (def (E;= x y) + (if x + y + (not y)))) + +(defstruct #export Bool/Show (S;Show Bool) + (def (S;show x) + (if x "true" "false"))) + +(do-template [<name> <unit> <op>] + [(defstruct #export <name> (m;Monoid Bool) + (def m;unit <unit>) + (def (m;++ x y) + (<op> x y)))] + + [ Or/Monoid false or] + [And/Monoid true and] + ) diff --git a/input/lux/data/bounded.lux b/input/lux/data/bounded.lux index 458fbc0df..9d2dabde1 100644 --- a/input/lux/data/bounded.lux +++ b/input/lux/data/bounded.lux @@ -15,12 +15,3 @@ (: a bottom)) - -## Structure -(do-template [<name> <type> <top> <bottom>] - [(defstruct #export <name> (Bounded <type>) - (def top <top>) - (def bottom <bottom>))] - - [ Int/Bounded Int (_jvm_getstatic java.lang.Long MAX_VALUE) (_jvm_getstatic java.lang.Long MIN_VALUE)] - [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)]) diff --git a/input/lux/data/char.lux b/input/lux/data/char.lux new file mode 100644 index 000000000..42e57509e --- /dev/null +++ b/input/lux/data/char.lux @@ -0,0 +1,20 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## The use and distribution terms for this software are covered by the +## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +## which can be found in the file epl-v10.html at the root of this distribution. +## By using this software in any fashion, you are agreeing to be bound by +## the terms of this license. +## You must not remove this notice, or any other, from this software. + +(;import lux + (.. (eq #as E) + (show #as S))) + +## [Structures] +(defstruct #export Char/Eq (E;Eq Char) + (def (E;= x y) + (_jvm_ceq x y))) + +(defstruct #export Char/Show (S;Show Char) + (def (S;show x) + ($ text:++ "#\"" (_jvm_invokevirtual java.lang.Object toString [] x []) "\""))) diff --git a/input/lux/data/eq.lux b/input/lux/data/eq.lux index 191e6a885..be3400208 100644 --- a/input/lux/data/eq.lux +++ b/input/lux/data/eq.lux @@ -8,17 +8,7 @@ (;import lux) -## Signatures +## [Signatures] (defsig #export (Eq a) (: (-> a a Bool) =)) - -## Structures -(defstruct #export Bool/Eq (Eq Bool) - (def (= x y) - (case (: (, Bool Bool) [x y]) - (\or [true true] [false false]) - true - - _ - false))) diff --git a/input/lux/data/number.lux b/input/lux/data/number.lux index e1c10d6b0..8da674d88 100644 --- a/input/lux/data/number.lux +++ b/input/lux/data/number.lux @@ -10,7 +10,8 @@ (lux/control (monoid #as m)) (lux/data (eq #as E) (ord #as O) - (bounded #as B))) + (bounded #as B) + (show #as S))) ## Signatures (defsig #export (Number n) @@ -61,11 +62,35 @@ (def E;= r=)) ## Ord -(def #export Int/Ord (O;Ord Int) - (O;ord$ Int/Eq i< i>)) +## (def #export Int/Ord (O;Ord Int) +## (O;ord$ Int/Eq i< i>)) -(def #export Real/Ord (O;Ord Real) - (O;ord$ Real/Eq r< r>)) +## (def #export Real/Ord (O;Ord Real) +## (O;ord$ Real/Eq r< r>)) + +(do-template [<name> <type> <eq> <lt> <gt>] + [(defstruct #export <name> (O;Ord <type>) + (def O;_eq <eq>) + (def O;< <lt>) + (def (O;<= x y) + (or (<lt> x y) + (using <eq> (E;= x y)))) + (def O;> <gt>) + (def (O;>= x y) + (or (<gt> x y) + (using <eq> (E;= x y)))))] + + [ Int/Ord Int Int/Eq i< i>] + [Real/Ord Real Real/Eq r< r>]) + +## Bounded +(do-template [<name> <type> <top> <bottom>] + [(defstruct #export <name> (B;Bounded <type>) + (def B;top <top>) + (def B;bottom <bottom>))] + + [ Int/Bounded Int (_jvm_getstatic java.lang.Long MAX_VALUE) (_jvm_getstatic java.lang.Long MIN_VALUE)] + [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)]) ## Monoid (do-template [<name> <type> <unit> <++>] @@ -77,8 +102,18 @@ [ IntMul/Monoid Int 1 i*] [RealAdd/Monoid Real 0.0 r+] [RealMul/Monoid Real 1.0 r*] - [ IntMax/Monoid Int (:: B;Int/Bounded B;bottom) (O;max Int/Ord)] - [ IntMin/Monoid Int (:: B;Int/Bounded B;top) (O;min Int/Ord)] - [RealMax/Monoid Real (:: B;Real/Bounded B;bottom) (O;max Real/Ord)] - [RealMin/Monoid Real (:: B;Real/Bounded B;top) (O;min Real/Ord)] + [ IntMax/Monoid Int (:: Int/Bounded B;bottom) (O;max Int/Ord)] + [ IntMin/Monoid Int (:: Int/Bounded B;top) (O;min Int/Ord)] + [RealMax/Monoid Real (:: Real/Bounded B;bottom) (O;max Real/Ord)] + [RealMin/Monoid Real (:: Real/Bounded B;top) (O;min Real/Ord)] + ) + +## Show +(do-template [<name> <type> <body>] + [(defstruct #export <name> (S;Show <type>) + (def (S;show x) + <body>))] + + [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])] + [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] ) diff --git a/input/lux/data/ord.lux b/input/lux/data/ord.lux index 60a6cc0a8..80f2e4fb5 100644 --- a/input/lux/data/ord.lux +++ b/input/lux/data/ord.lux @@ -9,20 +9,16 @@ (;import lux (../eq #as E)) -## Signatures +## [Signatures] (defsig #export (Ord a) (: (E;Eq a) _eq) - (: (-> a a Bool) - <) - (: (-> a a Bool) - <=) - (: (-> a a Bool) - >) - (: (-> a a Bool) - >=)) + (do-template [<name>] + [(: (-> a a Bool) <name>)] -## Constructors + [<] [<=] [>] [>=])) + +## [Constructors] (def #export (ord$ eq < >) (All [a] (-> (E;Eq a) (-> a a Bool) (-> a a Bool) (Ord a))) @@ -37,13 +33,12 @@ (or (> x y) (:: eq (E;= x y)))))) -## Functions +## [Functions] (do-template [<name> <op>] [(def #export (<name> ord x y) (All [a] (-> (Ord a) a a a)) - (using ord - (if (<op> x y) x y)))] + (if (:: ord (<op> x y)) x y))] [max ;;>] [min ;;<]) diff --git a/input/lux/data/show.lux b/input/lux/data/show.lux index e081b9239..f4e1cf762 100644 --- a/input/lux/data/show.lux +++ b/input/lux/data/show.lux @@ -12,16 +12,3 @@ (defsig #export (Show a) (: (-> a Text) show)) - -## Structures -(do-template [<name> <type> <body>] - [(defstruct #export <name> (Show <type>) - (def (show x) - <body>))] - - [Bool/Show Bool (_jvm_invokevirtual java.lang.Object toString [] x [])] - [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Char/Show Char (let [char (_jvm_invokevirtual java.lang.Object toString [] x [])] - ($ text:++ "#\"" char "\""))] - [Text/Show Text x]) diff --git a/input/lux/data/text.lux b/input/lux/data/text.lux index 5f2203376..a3192a1d5 100644 --- a/input/lux/data/text.lux +++ b/input/lux/data/text.lux @@ -7,8 +7,10 @@ ## You must not remove this notice, or any other, from this software. (;import lux + (lux/control (monoid #as m)) (lux/data (eq #as E) - (ord #as O))) + (ord #as O) + (show #as S))) ## [Functions] (def #export (size x) @@ -24,11 +26,6 @@ x [(_jvm_l2i idx)])) #;None)) -(def #export (++ x y) - (-> Text Text Text) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] - x [y])) - (def #export (contains? x y) (-> Text Text Bool) (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence] @@ -137,3 +134,13 @@ (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] x [y])) 0))) + +(defstruct #export Text/Show (S;Show Text) + (def (S;show x) + x)) + +(defstruct #export Text/Monoid (m;Monoid Text) + (def m;unit "") + (def (m;++ x y) + (_jvm_invokevirtual java.lang.String concat [java.lang.String] + x [y]))) diff --git a/input/lux/host/java.lux b/input/lux/host/java.lux index 52391201d..12525d3f2 100644 --- a/input/lux/host/java.lux +++ b/input/lux/host/java.lux @@ -7,10 +7,11 @@ ## You must not remove this notice, or any other, from this software. (;import lux - (lux (data list - (text #as text)) - (control (functor #as F) + (lux (control (monoid #as m) + (functor #as F) (monad #as M #refer (#only do))) + (data list + (text #as text)) (meta lux macro syntax))) @@ -124,8 +125,8 @@ (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;replace "/" "." current-module) - name)]] + #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name))]] (let [members' (:: List/Functor (F;map (: (-> (, (List Text) Text (List Text) Text) Syntax) (lambda [member] (let [[modifiers name inputs output] member] @@ -139,8 +140,8 @@ [methods (*^ method-def^)]) (do Lux/Monad [current-module get-module-name - #let [full-name (text;++ (text;replace "/" "." current-module) - name) + #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name)) fields' (:: List/Functor (F;map (: (-> (, (List Text) Text Text) Syntax) (lambda [field] (let [[modifiers name class] field] diff --git a/input/lux/meta/lux.lux b/input/lux/meta/lux.lux index 1fc739403..db3c700e6 100644 --- a/input/lux/meta/lux.lux +++ b/input/lux/meta/lux.lux @@ -13,7 +13,8 @@ (monad #as M #refer (#only do))) (lux/data list maybe - (show #as S))) + (show #as S) + (number #as N))) ## [Types] ## (deftype (Lux a) @@ -146,7 +147,7 @@ (def #export (gensym prefix state) (-> Text (Lux Syntax)) (#;Right [(update@ #;seed inc state) - (symbol$ ["__gensym__" (:: S;Int/Show (S;show (get@ #;seed state)))])])) + (symbol$ ["__gensym__" (:: N;Int/Show (S;show (get@ #;seed state)))])])) (def #export (emit datum) (All [a] diff --git a/input/lux/meta/syntax.lux b/input/lux/meta/syntax.lux index 3c9a9ce2e..1fe85c32f 100644 --- a/input/lux/meta/syntax.lux +++ b/input/lux/meta/syntax.lux @@ -11,7 +11,11 @@ (lux #as l #refer (#only Lux/Monad gensym))) (lux (control (functor #as F) (monad #as M #refer (#only do))) - (data list))) + (data (eq #as E) + (bool #as b) + (char #as c) + (text #as t) + list))) ## [Utils] (def (first xy) @@ -95,12 +99,6 @@ [ local-tag^ #;TagS] ) -(def (bool:= x y) - (-> Bool Bool Bool) - (if x - y - (not y))) - (def (ident:= x y) (-> Ident Ident Bool) (let [[x1 x2] x @@ -120,11 +118,11 @@ _ #;None))] - [ bool?^ Bool #;BoolS bool:=] + [ bool?^ Bool #;BoolS (:: b;Bool/Eq E;=)] [ int?^ Int #;IntS i=] [ real?^ Real #;RealS r=] - ## [ char?^ Char #;CharS char:=] - [ text?^ Text #;TextS text:=] + [ char?^ Char #;CharS (:: c;Char/Eq E;=)] + [ text?^ Text #;TextS (:: t;Text/Eq E;=)] [symbol?^ Ident #;SymbolS ident:=] [ tag?^ Ident #;TagS ident:=] ) diff --git a/input/program.lux b/input/program.lux index 1bdb237b1..984d8610f 100644 --- a/input/program.lux +++ b/input/program.lux @@ -13,7 +13,9 @@ monad lazy comonad) - (data bounded + (data bool + bounded + char ## cont dict (either #as e) diff --git a/src/lux/analyser/module.clj b/src/lux/analyser/module.clj index c13be61c4..9b68fb680 100644 --- a/src/lux/analyser/module.clj +++ b/src/lux/analyser/module.clj @@ -7,6 +7,7 @@ ;; You must not remove this notice, or any other, from this software. (ns lux.analyser.module + (:refer-clojure :exclude [alias]) (:require [clojure.string :as string] [clojure.core.match :as M :refer [matchv]] clojure.core.match.array diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj index 25451aae0..68c3b7d6c 100644 --- a/src/lux/compiler/base.clj +++ b/src/lux/compiler/base.clj @@ -18,31 +18,35 @@ (:import (org.objectweb.asm Opcodes Label ClassWriter - MethodVisitor))) + MethodVisitor) + (java.io File + BufferedOutputStream + FileOutputStream) + (java.lang.reflect Field))) ;; [Utils] (defn ^:private write-file [^String file ^bytes data] - (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. file))] + (with-open [stream (BufferedOutputStream. (FileOutputStream. file))] (.write stream data))) (defn ^:private write-output [module name data] (let [module* module] - (.mkdirs (java.io.File. (str "output/jvm/" module*))) + (.mkdirs (File. (str "output/jvm/" module*))) (write-file (str "output/jvm/" module* "/" name ".class") data))) (defn ^:private write-cache [module name data] (let [module* (string/replace module #"/" " ")] - (.mkdirs (java.io.File. (str "cache/jvm/" module*))) + (.mkdirs (File. (str "cache/jvm/" module*))) (write-file (str "cache/jvm/" module* "/" name ".class") data))) -(defn ^:private clean-file [^java.io.File file] +(defn ^:private clean-file [^File file] (if (.isDirectory file) (do (doseq [f (seq (.listFiles file))] (clean-file f)) (.delete file)) (.delete file))) -(defn ^:private read-file [file] +(defn ^:private read-file [^File file] (with-open [reader (io/input-stream file)] (let [length (.length file) buffer (byte-array length)] @@ -74,11 +78,11 @@ (return nil))) (defn cached? [module] - (.exists (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) + (.exists (File. (str "cache/jvm/" (string/replace module #"/" " ") "/_.class")))) (defn delete-cache [module] (fn [state] - (do (clean-file (java.io.File. (str "cache/jvm/" (string/replace module #"/" " ")))) + (do (clean-file (File. (str "cache/jvm/" (string/replace module #"/" " ")))) (return* state nil)))) (defn ^:private replace-several [content & replacements] @@ -90,7 +94,7 @@ (throw e))) content replacement-list))) -(defn ^:private replace-cache [cache-name] +(defn ^:private replace-cache [^String cache-name] (if (.startsWith cache-name "$") (replace-several cache-name #"_ASTER_" "*" @@ -118,16 +122,19 @@ #"_PIPE_" "|") cache-name)) +(defn ^:private get-field [^String field-name ^Class class] + (-> class ^Field (.getField field-name) (.get nil))) + (defn load-cache [module module-hash compile-module] (|do [loader &/loader !classes &/classes] (let [module-path (str "cache/jvm/" (string/replace module #"/" " ")) module* (string/replace module #"/" ".") class-name (str module* "._") - module-meta (do (swap! !classes assoc class-name (read-file (java.io.File. (str module-path "/_.class")))) - (load-class! loader class-name))] - (if (and (= module-hash (-> module-meta (.getField "_hash") (.get nil))) - (= version (-> module-meta (.getField "_compiler") (.get nil)))) + ^Class module-meta (do (swap! !classes assoc class-name (read-file (File. (str module-path "/_.class")))) + (load-class! loader class-name))] + (if (and (= module-hash (get-field "_hash" module-meta)) + (= version (get-field "_compiler" module-meta))) (let [imports (string/split (-> module-meta (.getField "_imports") (.get nil)) #"\t") ;; _ (prn module 'imports imports) ] @@ -137,9 +144,10 @@ (&/|list) (&/->list imports)))] (if (->> loads &/->seq (every? true?)) - (do (doseq [file (seq (.listFiles (java.io.File. module-path))) - :when (not= "_.class" (.getName file))] - (let [real-name (second (re-find #"^(.*)\.class$" (.getName file))) + (do (doseq [^File file (seq (.listFiles (File. module-path))) + :let [file-name (.getName file)] + :when (not= "_.class" file-name)] + (let [real-name (second (re-find #"^(.*)\.class$" file-name)) bytecode (read-file file) ;; _ (prn 'load-cache module real-name) ] @@ -149,18 +157,18 @@ ;; (swap! !classes assoc (-> (load-class! loader "__temp__") (.getField "_name") (.get nil)) bytecode) (write-output module real-name bytecode))) ;; (swap! !classes dissoc "__temp__") - (let [defs (string/split (-> module-meta (.getField "_defs") (.get nil)) #"\t")] + (let [defs (string/split (get-field "_defs" module-meta) #"\t")] (|do [_ (fn [state] (&/run-state (&/map% (fn [_def] (let [[_exported? _name _ann] (string/split _def #" ") ;; _ (prn '[_exported? _name _ann] [_exported? _name _ann]) def-class (load-class! loader (str module* ".$" (&/normalize-ident _name))) - def-name (-> def-class (.getField "_name") (.get nil))] + def-name (get-field "_name" def-class)] (|do [_ (case _ann "T" (&a-module/define module def-name (&/V "lux;TypeD" nil) &type/Type) "M" (|do [_ (&a-module/define module def-name (&/V "lux;ValueD" &type/Macro) &type/Macro)] (&a-module/declare-macro module def-name)) - "V" (let [def-type (-> def-class (.getField "_meta") (.get nil))] + "V" (let [def-type (get-field "_meta" def-class)] (matchv ::M/objects [def-type] [["lux;ValueD" _def-type]] (&a-module/define module def-name def-type _def-type))) @@ -168,7 +176,7 @@ (let [[_ __module __name] (re-find #"^A(.*);(.*)$" _ann)] (|do [__type (&a-module/def-type __module __name)] (do ;; (prn '__type [__module __name] (&type/show-type __type)) - (&a-module/def-alias module def-name __module __name __type)))))] + (&a-module/def-alias module def-name __module __name __type)))))] (if (= "1" _exported?) (&a-module/export module def-name) (return nil))) |