aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--input/lux/data/bool.lux33
-rw-r--r--input/lux/data/bounded.lux9
-rw-r--r--input/lux/data/char.lux20
-rw-r--r--input/lux/data/eq.lux12
-rw-r--r--input/lux/data/number.lux53
-rw-r--r--input/lux/data/ord.lux21
-rw-r--r--input/lux/data/show.lux13
-rw-r--r--input/lux/data/text.lux19
-rw-r--r--input/lux/host/java.lux15
-rw-r--r--input/lux/meta/lux.lux5
-rw-r--r--input/lux/meta/syntax.lux18
-rw-r--r--input/program.lux4
-rw-r--r--src/lux/analyser/module.clj1
-rw-r--r--src/lux/compiler/base.clj48
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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 04:17:13 +0000