aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/proc/common.clj129
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj40
-rw-r--r--stdlib/source/lux/compiler/default/syntax.lux102
3 files changed, 168 insertions, 103 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 90db8a2cd..7ce4974f7 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -6,7 +6,7 @@
[type :as &type])
(lux.analyser [base :as &&])))
-(defn ^:private analyse-lux-is [analyse exo-type ?values]
+(defn- analyse-lux-is [analyse exo-type ?values]
(&type/with-var
(fn [$var]
(|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values]
@@ -17,7 +17,7 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["lux" "is"]) (&/|list =left =right) (&/|list)))))))))
-(defn ^:private analyse-lux-try [analyse exo-type ?values]
+(defn- analyse-lux-try [analyse exo-type ?values]
(&type/with-var
(fn [$var]
(|do [:let [(&/$Cons op (&/$Nil)) ?values]
@@ -30,7 +30,7 @@
(&&/$proc (&/T ["lux" "try"]) (&/|list =op) (&/|list)))))))))
(do-template [<name> <proc> <input-type> <output-type>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
=x (&&/analyse-1 analyse <input-type> x)
=y (&&/analyse-1 analyse <input-type> y)
@@ -39,13 +39,13 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))
- ^:private analyse-text-eq ["text" "="] &type/Text &type/Bit
- ^:private analyse-text-lt ["text" "<"] &type/Text &type/Bit
- ^:private analyse-text-concat ["text" "concat"] &type/Text &type/Text
+ analyse-text-eq ["text" "="] &type/Text &type/Bit
+ analyse-text-lt ["text" "<"] &type/Text &type/Bit
+ analyse-text-concat ["text" "concat"] &type/Text &type/Text
)
(do-template [<name> <proc-name> <output-type>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons text (&/$Cons part (&/$Cons start (&/$Nil)))) ?values]
=text (&&/analyse-1 analyse &type/Text text)
=part (&&/analyse-1 analyse &type/Text part)
@@ -57,10 +57,10 @@
(&/|list =text =part =start)
(&/|list)))))))
- ^:private analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe)
+ analyse-text-index "index" (&/$Apply &type/Nat &type/Maybe)
)
-(defn ^:private analyse-text-clip [analyse exo-type ?values]
+(defn- analyse-text-clip [analyse exo-type ?values]
(|do [:let [(&/$Cons text (&/$Cons from (&/$Cons to (&/$Nil)))) ?values]
=text (&&/analyse-1 analyse &type/Text text)
=from (&&/analyse-1 analyse &type/Nat from)
@@ -73,7 +73,7 @@
(&/|list)))))))
(do-template [<name> <proc>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons text (&/$Nil)) ?values]
=text (&&/analyse-1 analyse &type/Text text)
_ (&type/check exo-type &type/Nat)
@@ -83,10 +83,10 @@
(&/|list =text)
(&/|list)))))))
- ^:private analyse-text-size "size"
+ analyse-text-size "size"
)
-(defn ^:private analyse-text-char [analyse exo-type ?values]
+(defn- analyse-text-char [analyse exo-type ?values]
(|do [:let [(&/$Cons text (&/$Cons idx (&/$Nil))) ?values]
=text (&&/analyse-1 analyse &type/Text text)
=idx (&&/analyse-1 analyse &type/Nat idx)
@@ -100,7 +100,7 @@
(do-template [<name> <op>]
(let [inputT (&/$Apply &type/Any &type/I64)
outputT &type/I64]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons mask (&/$Cons input (&/$Nil))) ?values]
=mask (&&/analyse-1 analyse inputT mask)
=input (&&/analyse-1 analyse inputT input)
@@ -109,15 +109,15 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["i64" <op>]) (&/|list =input =mask) (&/|list))))))))
- ^:private analyse-i64-and "and"
- ^:private analyse-i64-or "or"
- ^:private analyse-i64-xor "xor"
+ analyse-i64-and "and"
+ analyse-i64-or "or"
+ analyse-i64-xor "xor"
)
(do-template [<name> <op>]
(let [inputT (&/$Apply &type/Any &type/I64)
outputT &type/I64]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons shift (&/$Cons input (&/$Nil))) ?values]
=shift (&&/analyse-1 analyse &type/Nat shift)
=input (&&/analyse-1 analyse inputT input)
@@ -126,15 +126,15 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["i64" <op>]) (&/|list =input =shift) (&/|list))))))))
- ^:private analyse-i64-left-shift "left-shift"
- ^:private analyse-i64-arithmetic-right-shift "arithmetic-right-shift"
- ^:private analyse-i64-logical-right-shift "logical-right-shift"
+ analyse-i64-left-shift "left-shift"
+ analyse-i64-arithmetic-right-shift "arithmetic-right-shift"
+ analyse-i64-logical-right-shift "logical-right-shift"
)
(do-template [<name> <proc> <input-type> <output-type>]
(let [inputT <input-type>
outputT <output-type>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons subjectC (&/$Cons paramC (&/$Nil))) ?values]
subjectA (&&/analyse-1 analyse <input-type> subjectC)
paramA (&&/analyse-1 analyse <input-type> paramC)
@@ -143,15 +143,15 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <proc>) (&/|list subjectA paramA) (&/|list))))))))
- ^:private analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit
- ^:private analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64
- ^:private analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64
+ analyse-i64-eq ["i64" "="] (&/$Apply &type/Any &type/I64) &type/Bit
+ analyse-i64-add ["i64" "+"] (&/$Apply &type/Any &type/I64) &type/I64
+ analyse-i64-sub ["i64" "-"] (&/$Apply &type/Any &type/I64) &type/I64
)
(do-template [<name> <proc> <input-type> <output-type>]
(let [inputT <input-type>
outputT <output-type>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
=x (&&/analyse-1 analyse <input-type> x)
=y (&&/analyse-1 analyse <input-type> y)
@@ -160,22 +160,22 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list))))))))
- ^:private analyse-int-mul ["int" "*"] &type/Int &type/Int
- ^:private analyse-int-div ["int" "/"] &type/Int &type/Int
- ^:private analyse-int-rem ["int" "%"] &type/Int &type/Int
- ^:private analyse-int-lt ["int" "<"] &type/Int &type/Bit
-
- ^:private analyse-frac-add ["frac" "+"] &type/Frac &type/Frac
- ^:private analyse-frac-sub ["frac" "-"] &type/Frac &type/Frac
- ^:private analyse-frac-mul ["frac" "*"] &type/Frac &type/Frac
- ^:private analyse-frac-div ["frac" "/"] &type/Frac &type/Frac
- ^:private analyse-frac-rem ["frac" "%"] &type/Frac &type/Frac
- ^:private analyse-frac-eq ["frac" "="] &type/Frac &type/Bit
- ^:private analyse-frac-lt ["frac" "<"] &type/Frac &type/Bit
+ analyse-int-mul ["int" "*"] &type/Int &type/Int
+ analyse-int-div ["int" "/"] &type/Int &type/Int
+ analyse-int-rem ["int" "%"] &type/Int &type/Int
+ analyse-int-lt ["int" "<"] &type/Int &type/Bit
+
+ analyse-frac-add ["frac" "+"] &type/Frac &type/Frac
+ analyse-frac-sub ["frac" "-"] &type/Frac &type/Frac
+ analyse-frac-mul ["frac" "*"] &type/Frac &type/Frac
+ analyse-frac-div ["frac" "/"] &type/Frac &type/Frac
+ analyse-frac-rem ["frac" "%"] &type/Frac &type/Frac
+ analyse-frac-eq ["frac" "="] &type/Frac &type/Bit
+ analyse-frac-lt ["frac" "<"] &type/Frac &type/Bit
)
(do-template [<encode> <encode-op> <decode> <decode-op> <type>]
- (do (defn <encode> [analyse exo-type ?values]
+ (do (defn- <encode> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Nil)) ?values]
=x (&&/analyse-1 analyse <type> x)
_ (&type/check exo-type &type/Text)
@@ -184,7 +184,7 @@
(&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list)))))))
(let [decode-type (&/$Apply <type> &type/Maybe)]
- (defn <decode> [analyse exo-type ?values]
+ (defn- <decode> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Nil)) ?values]
=x (&&/analyse-1 analyse &type/Text x)
_ (&type/check exo-type decode-type)
@@ -192,24 +192,24 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list)))))))))
- ^:private analyse-frac-encode ["frac" "encode"] ^:private analyse-frac-decode ["frac" "decode"] &type/Frac
+ analyse-frac-encode ["frac" "encode"] analyse-frac-decode ["frac" "decode"] &type/Frac
)
(do-template [<name> <type> <op>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Nil) ?values]
_ (&type/check exo-type <type>)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <op>) (&/|list) (&/|list)))))))
- ^:private analyse-frac-smallest &type/Frac ["frac" "smallest"]
- ^:private analyse-frac-min &type/Frac ["frac" "min"]
- ^:private analyse-frac-max &type/Frac ["frac" "max"]
+ analyse-frac-smallest &type/Frac ["frac" "smallest"]
+ analyse-frac-min &type/Frac ["frac" "min"]
+ analyse-frac-max &type/Frac ["frac" "max"]
)
(do-template [<name> <from-type> <to-type> <op>]
- (defn <name> [analyse exo-type ?values]
+ (defn- <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons x (&/$Nil)) ?values]
=x (&&/analyse-1 analyse <from-type> x)
_ (&type/check exo-type <to-type>)
@@ -217,22 +217,43 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))
- ^:private analyse-int-char &type/Int &type/Text ["int" "char"]
- ^:private analyse-int-frac &type/Int &type/Frac ["int" "frac"]
- ^:private analyse-frac-int &type/Frac &type/Int ["frac" "int"]
+ analyse-int-char &type/Int &type/Text ["int" "char"]
+ analyse-int-frac &type/Int &type/Frac ["int" "frac"]
+ analyse-frac-int &type/Frac &type/Int ["frac" "int"]
- ^:private analyse-io-log &type/Text &type/Any ["io" "log"]
- ^:private analyse-io-error &type/Text &type/Nothing ["io" "error"]
- ^:private analyse-io-exit &type/Int &type/Nothing ["io" "exit"]
+ analyse-io-log &type/Text &type/Any ["io" "log"]
+ analyse-io-error &type/Text &type/Nothing ["io" "error"]
+ analyse-io-exit &type/Int &type/Nothing ["io" "exit"]
)
-(defn ^:private analyse-io-current-time [analyse exo-type ?values]
+(defn- analyse-io-current-time [analyse exo-type ?values]
(|do [:let [(&/$Nil) ?values]
_ (&type/check exo-type &type/Int)
_cursor &/cursor]
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["io" "current-time"]) (&/|list) (&/|list)))))))
+(defn- analyse-syntax-char-case! [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?input (&/$Cons [_ (&/$Tuple ?pairs)] (&/$Cons ?else (&/$Nil)))) ?values]
+ _cursor &/cursor
+ =input (&&/analyse-1 analyse &type/Nat ?input)
+ _ (assert! (even? (&/|length ?pairs)) "The number of matches must be even!")
+ =pairs (&/map% (fn [?pair]
+ (|let [[?pattern ?match] ?pair]
+ (|case ?pattern
+ [_ (&/$Text ^String ?pattern-char)]
+ (|do [=match (&&/analyse-1 analyse exo-type ?match)]
+ (return (&/T [(int (.charAt ?pattern-char 0))
+ =match]))))))
+ (&/|as-pairs ?pairs))
+ =else (&&/analyse-1 analyse exo-type ?else)]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["lux" "syntax char case!"])
+ (&/|list =input
+ (&&/|meta exo-type _cursor (&&/$tuple (&/|map &/|second =pairs)))
+ =else)
+ (&/|map &/|first =pairs)))))))
+
(defn analyse-proc [analyse exo-type proc ?values]
(try (case proc
"lux is" (analyse-lux-is analyse exo-type ?values)
@@ -281,6 +302,10 @@
"lux frac min" (analyse-frac-min analyse exo-type ?values)
"lux frac max" (analyse-frac-max analyse exo-type ?values)
"lux frac int" (analyse-frac-int analyse exo-type ?values)
+
+ ;; Special extensions for performance reasons
+ ;; Will be replaced by custom extensions in the future.
+ "lux syntax char case!" (analyse-syntax-char-case! analyse exo-type ?values)
;; else
(&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " proc)))
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index b5d0ea475..dafcb64ef 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -371,12 +371,50 @@
&&/wrap-long)]]
(return nil)))
+(defn ^:private compile-syntax-char-case! [compile ?values ?patterns]
+ (|do [:let [(&/$Cons ?input (&/$Cons [_ (&a/$tuple ?matches)] (&/$Cons ?else (&/$Nil)))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ :let [?patterns+?matches* (->> (&/zip2 ?patterns ?matches)
+ &/->seq
+ (sort-by &/|first <)
+ &/->list)
+ ?patterns* (&/|map &/|first ?patterns+?matches*)
+ ?matches* (&/|map &/|second ?patterns+?matches*)
+ end-label (new Label)
+ else-label (new Label)
+ pattern-labels (&/|map (fn [_] (new Label)) ?patterns*)]
+ _ (compile ?input)
+ :let [_ (doto *writer*
+ &&/unwrap-long
+ (.visitInsn Opcodes/L2I)
+ (.visitLookupSwitchInsn else-label
+ (int-array (&/->seq ?patterns*))
+ (into-array (&/->seq pattern-labels))))]
+ _ (&/map% (fn [?label+?match]
+ (|let [[?label ?match] ?label+?match]
+ (|do [:let [_ (doto *writer*
+ (.visitLabel ?label))]
+ _ (compile ?match)
+ :let [_ (doto *writer*
+ (.visitJumpInsn Opcodes/GOTO end-label))]]
+ (return nil))))
+ (&/zip2 pattern-labels ?matches*))
+ :let [_ (doto *writer*
+ (.visitLabel else-label))]
+ _ (compile ?else)
+ :let [_ (doto *writer*
+ (.visitLabel end-label))]]
+ (return nil)))
+
(defn compile-proc [compile category proc ?values special-args]
(case category
"lux"
(case proc
"is" (compile-lux-is compile ?values special-args)
- "try" (compile-lux-try compile ?values special-args))
+ "try" (compile-lux-try compile ?values special-args)
+ ;; Special extensions for performance reasons
+ ;; Will be replaced by custom extensions in the future.
+ "syntax char case!" (compile-syntax-char-case! compile ?values special-args))
"io"
(case proc
diff --git a/stdlib/source/lux/compiler/default/syntax.lux b/stdlib/source/lux/compiler/default/syntax.lux
index d724a150b..1584321e5 100644
--- a/stdlib/source/lux/compiler/default/syntax.lux
+++ b/stdlib/source/lux/compiler/default/syntax.lux
@@ -410,7 +410,10 @@
(#error.Error error)
(#error.Error error)))
- (with-expansions [<parse> (as-is (parse current-module aliases source-code//size))]
+ (with-expansions [<parse> (as-is (parse current-module aliases source-code//size))
+ <horizontal-move> (as-is (recur [(update@ #.column inc where)
+ (!inc offset/0)
+ source-code]))]
(def: #export (parse current-module aliases source-code//size)
(-> Text Aliases Nat (-> Source (Error [Source Code])))
## The "exec []" is only there to avoid function fusion.
@@ -418,51 +421,50 @@
(exec []
(function (recur [where offset/0 source-code])
(<| (!with-char+ source-code//size source-code offset/0 char/0 <end>)
- (`` (case char/0
- ## White-space
- (^template [<char> <direction>]
- (^ (char <char>))
- (recur [(update@ <direction> inc where)
- (!inc offset/0)
- source-code]))
- ([(~~ (static ..space)) #.column]
- [(~~ (static text.carriage-return)) #.column])
-
- (^ (char (~~ (static text.new-line))))
+ (`` ("lux syntax char case!" char/0
+ [## White-space
+ (~~ (static ..space))
+ <horizontal-move>
+
+ (~~ (static text.carriage-return))
+ <horizontal-move>
+
+ (~~ (static text.new-line))
(recur [(!new-line where) (!inc offset/0) source-code])
## Form
- (^ (char (~~ (static ..open-form))))
+ (~~ (static ..open-form))
(parse-form <parse> <consume-1>)
## Tuple
- (^ (char (~~ (static ..open-tuple))))
+ (~~ (static ..open-tuple))
(parse-tuple <parse> <consume-1>)
## Record
- (^ (char (~~ (static ..open-record))))
+ (~~ (static ..open-record))
(parse-record <parse> <consume-1>)
## Text
- (^ (char (~~ (static ..text-delimiter))))
+ (~~ (static ..text-delimiter))
(read-text <consume-1>)
## Special code
- (^ (char (~~ (static ..sigil))))
+ (~~ (static ..sigil))
(let [offset/1 (!inc offset/0)]
(<| (!with-char+ source-code//size source-code offset/1 char/1 <end>)
- (case char/1
- (^template [<char> <bit>]
- (^ (char <char>))
- (#error.Success [[(update@ #.column (|>> !inc/2) where)
- (!inc offset/1)
- source-code]
- [where (#.Bit <bit>)]]))
- (["0" #0]
- ["1" #1])
+ ("lux syntax char case!" char/1
+ [(~~ (do-template [<char> <bit>]
+ [<char>
+ (#error.Success [[(update@ #.column (|>> !inc/2) where)
+ (!inc offset/1)
+ source-code]
+ [where (#.Bit <bit>)]])]
+
+ ["0" #0]
+ ["1" #1]))
## Single-line comment
- (^ (char (~~ (static ..sigil))))
+ (~~ (static ..sigil))
(case ("lux text index" source-code (static text.new-line) offset/1)
(#.Some end)
(recur [(!new-line where) (!inc end) source-code])
@@ -470,36 +472,36 @@
_
<end>)
- (^ (char (~~ (static ..name-separator))))
- (!parse-short-name current-module <consume-2> where #.Identifier)
+ (~~ (static ..name-separator))
+ (!parse-short-name current-module <consume-2> where #.Identifier)]
- _
- (cond (!name-char?|head char/1) ## Tag
- (!parse-full-name offset/1 <consume-2> where #.Tag)
+ ## else
+ (cond (!name-char?|head char/1) ## Tag
+ (!parse-full-name offset/1 <consume-2> where #.Tag)
- ## else
- <failure>))))
+ ## else
+ <failure>))))
- (^ (char (~~ (static ..name-separator))))
+ (~~ (static ..name-separator))
(let [offset/1 (!inc offset/0)]
(<| (!with-char+ source-code//size source-code offset/1 char/1 <end>)
(if (!digit? char/1)
(parse-rev offset/0 [where (!inc offset/1) source-code])
(!parse-short-name current-module <consume-1> where #.Identifier))))
- (^template [<sign>]
- (^ (char <sign>))
- (!parse-int source-code//size offset/0 where source-code <end>))
- ([(~~ (static ..positive-sign))]
- [(~~ (static ..negative-sign))])
+ (~~ (static ..positive-sign))
+ (!parse-int source-code//size offset/0 where source-code <end>)
- _
- (cond (!digit? char/0) ## Natural number
- (parse-nat offset/0 <consume-1>)
-
- ## Identifier
- (!name-char?|head char/0)
- (!parse-full-name offset/0 <consume-1> where #.Identifier)
-
- ## else
- <failure>)))))))))
+ (~~ (static ..negative-sign))
+ (!parse-int source-code//size offset/0 where source-code <end>)]
+
+ ## else
+ (cond (!digit? char/0) ## Natural number
+ (parse-nat offset/0 <consume-1>)
+
+ ## Identifier
+ (!name-char?|head char/0)
+ (!parse-full-name offset/0 <consume-1> where #.Identifier)
+
+ ## else
+ <failure>)))))))))