aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj64
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux8
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux75
-rw-r--r--stdlib/source/lux/data/text/regex.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux51
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux51
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux51
-rw-r--r--stdlib/source/test/lux.lux2
-rw-r--r--stdlib/source/test/lux/data/text/regex.lux40
10 files changed, 184 insertions, 175 deletions
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index f5fc85795..b64d7312b 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -73,44 +73,43 @@
tuple-size #(doto %
(.visitVarInsn Opcodes/ALOAD 0)
(.visitInsn Opcodes/ARRAYLENGTH))
- last-right-index #(doto %
- tuple-size
- (.visitLdcInsn (int 1))
- (.visitInsn Opcodes/ISUB))
+ last-right #(doto %
+ tuple-size
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB))
+ sub-lefts #(doto %
+ lefts
+ last-right
+ (.visitInsn Opcodes/ISUB))
sub-tuple #(doto %
(.visitVarInsn Opcodes/ALOAD 0)
- last-right-index
+ last-right
(.visitInsn Opcodes/AALOAD)
(.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))
+ recurI (fn [$begin]
+ #(doto %
+ sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
+ sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
+ (.visitJumpInsn Opcodes/GOTO $begin)))
_ (let [$begin (new Label)
- $not-rec (new Label)
+ $recursive (new Label)
left-index lefts
left-access #(doto %
(.visitVarInsn Opcodes/ALOAD 0)
left-index
- (.visitInsn Opcodes/AALOAD))
- sub-lefts #(doto %
- ;; last-right-index, lefts
- (.visitInsn Opcodes/SWAP)
- (.visitInsn Opcodes/ISUB))]
+ (.visitInsn Opcodes/AALOAD))]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
- last-right-index
- lefts
- (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $not-rec)
- sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
- sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
- (.visitJumpInsn Opcodes/GOTO $begin)
- (.visitLabel $not-rec)
- ;; last-right-index, lefts
- ;; (.visitInsn Opcodes/POP2) ;;
+ lefts last-right (.visitJumpInsn Opcodes/IF_ICMPGE $recursive)
left-access
(.visitInsn Opcodes/ARETURN)
+ (.visitLabel $recursive)
+ ((recurI $begin))
(.visitMaxs 0 0)
(.visitEnd)))
_ (let [$begin (new Label)
- $is-last (new Label)
+ $not-last (new Label)
$must-copy (new Label)
right-index #(doto %
lefts
@@ -124,30 +123,21 @@
(.visitVarInsn Opcodes/ALOAD 0)
right-index
tuple-size
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;"))
- sub-lefts #(doto %
- lefts
- last-right-index
- (.visitInsn Opcodes/ISUB))]
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;"))]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
(.visitCode)
(.visitLabel $begin)
- last-right-index
- right-index
- (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last)
+ last-right right-index
+ (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPNE $not-last)
+ right-access
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $not-last)
(.visitJumpInsn Opcodes/IF_ICMPGT $must-copy)
;; Must recurse
- sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
- sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
- (.visitJumpInsn Opcodes/GOTO $begin)
+ ((recurI $begin))
(.visitLabel $must-copy)
sub-right
(.visitInsn Opcodes/ARETURN)
- (.visitLabel $is-last)
- ;; last-right-index, right-index
- ;; (.visitInsn Opcodes/POP)
- right-access
- (.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
_ (let [$begin (new Label)
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index f1ae8abd2..d8360d4d7 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -54,7 +54,9 @@
SWAP))
## Jump
- (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT IF_ACMPEQ IFNULL
+ (~~ (declare IF_ICMPEQ IF_ICMPGT IF_ICMPLT
+ IF_ICMPNE IF_ICMPGE IF_ICMPLE
+ IF_ACMPEQ IFNULL
IFEQ IFNE IFLT IFLE IFGT IFGE
GOTO))
@@ -286,7 +288,9 @@
(do-to visitor
(MethodVisitor::visitJumpInsn (prefix <name>) @where))))]
- [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL]
+ [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT]
+ [IF_ICMPNE] [IF_ICMPGE] [IF_ICMPLE]
+ [IF_ACMPEQ] [IFNULL]
[IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE]
[GOTO]
)
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 973170d77..d21729d0e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -17,7 +17,7 @@
[luxc
[lang
[host
- ["$" jvm (#+ Inst Method Def Operation)
+ ["$" jvm (#+ Label Inst Method Def Operation)
["$t" type]
["$d" def]
["_" inst]]]]]
@@ -133,12 +133,18 @@
(def: pm-methods
Def
(let [tuple-sizeI (|>> (_.ALOAD 0) _.ARRAYLENGTH)
- last-right-indexI (|>> tuple-sizeI (_.int +1) _.ISUB)
+ last-rightI (|>> tuple-sizeI (_.int +1) _.ISUB)
leftsI (_.ILOAD 1)
left-indexI leftsI
- sub-tupleI (|>> (_.ALOAD 0) last-right-indexI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
-
- expected-last-sizeI (|>> (_.ILOAD 1) (_.int +1) _.IADD)]
+ sub-leftsI (|>> leftsI
+ last-rightI
+ _.ISUB)
+ sub-tupleI (|>> (_.ALOAD 0) last-rightI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
+ recurI (: (-> Label Inst)
+ (function (_ @loop)
+ (|>> sub-leftsI (_.ISTORE 1)
+ sub-tupleI (_.ASTORE 0)
+ (_.GOTO @loop))))]
(|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list))
(|>> (_.NEW "java.lang.IllegalStateException")
_.DUP
@@ -175,7 +181,7 @@
_.AALOAD
_.ARETURN))
($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list))
- (<| _.with-label (function (_ @begin))
+ (<| _.with-label (function (_ @loop))
_.with-label (function (_ @just-return))
_.with-label (function (_ @then))
_.with-label (function (_ @further))
@@ -198,7 +204,7 @@
update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE 0))
failureI (|>> _.NULL _.ARETURN)
return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)])
- (|>> (_.label @begin)
+ (|>> (_.label @loop)
(_.ILOAD 1) ## tag
(_.ALOAD 0) tagI ## tag, sumT
_.DUP2 (_.IF_ICMPEQ @then)
@@ -215,7 +221,7 @@
(_.IFNULL @wrong) ## tag, sumT
update-tagI
update-variantI
- (_.GOTO @begin)
+ (_.GOTO @loop)
(_.label @just-return) ## tag, sumT
## _.POP2
return-datumI
@@ -227,25 +233,19 @@
## _.POP2
failureI)))
($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
- (<| _.with-label (function (_ @begin))
- _.with-label (function (_ @not-recursive))
- (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)
- sub-leftsI (|>> _.SWAP _.ISUB)])
- (|>> (_.label @begin)
- last-right-indexI
- leftsI
- _.DUP2 (_.IF_ICMPGT @not-recursive)
- ## Recursive
- sub-leftsI (_.ISTORE 1)
- sub-tupleI (_.ASTORE 0)
- (_.GOTO @begin)
- (_.label @not-recursive)
- ## _.POP2
+ (<| _.with-label (function (_ @loop))
+ _.with-label (function (_ @recursive))
+ (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
+ (|>> (_.label @loop)
+ leftsI last-rightI (_.IF_ICMPGE @recursive)
left-accessI
- _.ARETURN)))
+ _.ARETURN
+ (_.label @recursive)
+ ## Recursive
+ (recurI @loop))))
($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
- (<| _.with-label (function (_ @begin))
- _.with-label (function (_ @tail))
+ (<| _.with-label (function (_ @loop))
+ _.with-label (function (_ @not-tail))
_.with-label (function (_ @slice))
(let [right-indexI (|>> leftsI
(_.int +1)
@@ -260,26 +260,21 @@
($t.method (list $Object-Array $t.int $t.int)
(#.Some $Object-Array)
(list))
- #0))
- sub-leftsI (|>> leftsI
- last-right-indexI
- _.ISUB)])
- (|>> (_.label @begin)
- last-right-indexI
- right-indexI
- _.DUP2 (_.IF_ICMPEQ @tail)
+ #0))])
+ (|>> (_.label @loop)
+ last-rightI right-indexI
+ _.DUP2 (_.IF_ICMPNE @not-tail)
+ ## _.POP
+ right-accessI
+ _.ARETURN
+ (_.label @not-tail)
(_.IF_ICMPGT @slice)
## Must recurse
- sub-tupleI (_.ASTORE 0)
- sub-leftsI (_.ISTORE 1)
- (_.GOTO @begin)
+ (recurI @loop)
(_.label @slice)
sub-rightI
_.ARETURN
- (_.label @tail)
- ## _.POP
- right-accessI
- _.ARETURN)))
+ )))
)))
(def: io-methods
diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux
index 5e867b9b6..73b6dab3b 100644
--- a/stdlib/source/lux/data/text/regex.lux
+++ b/stdlib/source/lux/data/text/regex.lux
@@ -360,17 +360,15 @@
(do p.monad
[#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)]
head sub^
- tail (p.some (p.after (l.this "|") sub^))
- #let [g!op (code.identifier ["" " alt "])]]
+ tail (p.some (p.after (l.this "|") sub^))]
(if (list.empty? tail)
(wrap head)
(wrap [(list@fold n/max (product.left head) (list@map product.left tail))
- (` (let [(~ g!op) (~ (if capturing?
- (` (~! |||^))
- (` (~! |||_^))))]
- ($_ (~ g!op)
- (~ (prep-alternative head))
- (~+ (list@map prep-alternative tail)))))]))))
+ (` ($_ ((~ (if capturing?
+ (` (~! |||^))
+ (` (~! |||_^)))))
+ (~ (prep-alternative head))
+ (~+ (list@map prep-alternative tail))))]))))
(def: (re-scoped^ current-module)
(-> Text (l.Lexer [Re-Group Code]))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
index f492479d4..8908c3335 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
@@ -177,30 +177,33 @@
@lux//program-args
))
-(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
- ($_ _.then
- (_.define last-index-right (..last-index tuple))
- (_.if (_.> lefts last-index-right)
- ## No need for recursion
- (_.return (_.at lefts tuple))
- ## Needs recursion
- (_.return (tuple//left (_.- last-index-right lefts)
- (_.at last-index-right tuple)))))))
-
-(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index]
- ($_ _.then
- (_.define last-index-right (..last-index tuple))
- (_.define right-index (_.+ (_.i32 +1) lefts))
- (_.cond (list [(_.= right-index last-index-right)
- (_.return (_.at right-index tuple))]
- [(_.> right-index last-index-right)
- ## Needs recursion.
- (_.return (tuple//right (_.- last-index-right lefts)
- (_.at last-index-right tuple)))])
- (_.return (_.do "slice" (list right-index) tuple)))
- )))
+(with-expansions [<recur> (as-is ($_ _.then
+ (_.set lefts (_.- last-index-right lefts))
+ (_.set tuple (_.at last-index-right tuple))))]
+ (runtime: (tuple//left lefts tuple)
+ (with-vars [last-index-right]
+ (<| (_.while (_.boolean true))
+ ($_ _.then
+ (_.define last-index-right (..last-index tuple))
+ (_.if (_.> lefts last-index-right)
+ ## No need for recursion
+ (_.return (_.at lefts tuple))
+ ## Needs recursion
+ <recur>)))))
+
+ (runtime: (tuple//right lefts tuple)
+ (with-vars [last-index-right right-index]
+ (<| (_.while (_.boolean true))
+ ($_ _.then
+ (_.define last-index-right (..last-index tuple))
+ (_.define right-index (_.+ (_.i32 +1) lefts))
+ (_.cond (list [(_.= right-index last-index-right)
+ (_.return (_.at right-index tuple))]
+ [(_.> right-index last-index-right)
+ ## Needs recursion.
+ <recur>])
+ (_.return (_.do "slice" (list right-index) tuple)))
+ )))))
(runtime: (sum//get sum wants-last wanted-tag)
(let [no-match! (_.return _.null)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux
index 5e45682d1..648d35d32 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/lua/runtime.lux
@@ -137,6 +137,9 @@
(def: last-index (|>> _.length (_.- (_.int +1))))
+## No need to turn tuple//left and tuple//right into loops, as Lua
+## does tail-call optimization.
+## https://www.lua.org/pil/6.3.html
(runtime: (tuple//left lefts tuple)
(with-vars [last-right]
($_ _.then
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
index bdb0a8d2b..896b9e18a 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/runtime.lux
@@ -183,30 +183,33 @@
(def: last-index
(|>> _.len/1 (_.- (_.int +1))))
-(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
- ($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.if (_.> lefts last-index-right)
- ## No need for recursion
- (_.return (_.nth lefts tuple))
- ## Needs recursion
- (_.return (tuple//left (_.- last-index-right lefts)
- (_.nth last-index-right tuple)))))))
-
-(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index]
- ($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.set (list right-index) (_.+ (_.int +1) lefts))
- (_.cond (list [(_.= right-index last-index-right)
- (_.return (_.nth right-index tuple))]
- [(_.> right-index last-index-right)
- ## Needs recursion.
- (_.return (tuple//right (_.- last-index-right lefts)
- (_.nth last-index-right tuple)))])
- (_.return (_.slice-from right-index tuple)))
- )))
+(with-expansions [<recur> (as-is ($_ _.then
+ (_.set (list lefts) (_.- last-index-right lefts))
+ (_.set (list tuple) (_.nth last-index-right tuple))))]
+ (runtime: (tuple//left lefts tuple)
+ (with-vars [last-index-right]
+ (<| (_.while (_.bool true))
+ ($_ _.then
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.if (_.> lefts last-index-right)
+ ## No need for recursion
+ (_.return (_.nth lefts tuple))
+ ## Needs recursion
+ <recur>)))))
+
+ (runtime: (tuple//right lefts tuple)
+ (with-vars [last-index-right right-index]
+ (<| (_.while (_.bool true))
+ ($_ _.then
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.set (list right-index) (_.+ (_.int +1) lefts))
+ (_.cond (list [(_.= right-index last-index-right)
+ (_.return (_.nth right-index tuple))]
+ [(_.> right-index last-index-right)
+ ## Needs recursion.
+ <recur>])
+ (_.return (_.slice-from right-index tuple)))
+ )))))
(runtime: (sum//get sum wantsLast wantedTag)
(let [no-match! (_.return _.none)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux
index e39e6af8e..71edc3e07 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/ruby/runtime.lux
@@ -135,30 +135,33 @@
(def: last-index
(|>> ..tuple-size (_.- (_.int +1))))
-(runtime: (tuple//left lefts tuple)
- (with-vars [last-index-right]
- ($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.if (_.> lefts last-index-right)
- ## No need for recursion
- (_.return (_.nth lefts tuple))
- ## Needs recursion
- (_.return (tuple//left (_.- last-index-right lefts)
- (_.nth last-index-right tuple)))))))
-
-(runtime: (tuple//right lefts tuple)
- (with-vars [last-index-right right-index]
- ($_ _.then
- (_.set (list last-index-right) (..last-index tuple))
- (_.set (list right-index) (_.+ (_.int +1) lefts))
- (_.cond (list [(_.= right-index last-index-right)
- (_.return (_.nth right-index tuple))]
- [(_.> right-index last-index-right)
- ## Needs recursion.
- (_.return (tuple//right (_.- last-index-right lefts)
- (_.nth last-index-right tuple)))])
- (_.return (_.array-range right-index (..tuple-size tuple) tuple)))
- )))
+(with-expansions [<recur> (as-is ($_ _.then
+ (_.set (list lefts) (_.- last-index-right lefts))
+ (_.set (list tuple) (_.nth last-index-right tuple))))]
+ (runtime: (tuple//left lefts tuple)
+ (with-vars [last-index-right]
+ (<| (_.while (_.bool true))
+ ($_ _.then
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.if (_.> lefts last-index-right)
+ ## No need for recursion
+ (_.return (_.nth lefts tuple))
+ ## Needs recursion
+ <recur>)))))
+
+ (runtime: (tuple//right lefts tuple)
+ (with-vars [last-index-right right-index]
+ (<| (_.while (_.bool true))
+ ($_ _.then
+ (_.set (list last-index-right) (..last-index tuple))
+ (_.set (list right-index) (_.+ (_.int +1) lefts))
+ (_.cond (list [(_.= right-index last-index-right)
+ (_.return (_.nth right-index tuple))]
+ [(_.> right-index last-index-right)
+ ## Needs recursion.
+ <recur>])
+ (_.return (_.array-range right-index (..tuple-size tuple) tuple)))
+ )))))
(runtime: (sum//get sum wantsLast wantedTag)
(let [no-match! (_.return _.nil)
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 21e529ecc..fa6a511d5 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -381,8 +381,6 @@
(<| io
_.run!
(_.times 100)
- ## (_.seed 16966479879996440699)
- ## (_.seed 16140950815046933697)
## (_.seed 8804587020128699091)
## (_.seed 9353282359333487462)
..test))
diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux
index 58ef21b8b..a683c446f 100644
--- a/stdlib/source/test/lux/data/text/regex.lux
+++ b/stdlib/source/test/lux/data/text/regex.lux
@@ -8,11 +8,12 @@
["p" parser]]
[data
[number (#+ hex)]
+ ["." error]
["." text ("#@." equivalence)
["." lexer (#+ Lexer)]]]
[math
["r" random]]
- [macro
+ ["." macro
["s" syntax (#+ syntax:)]]]
{1
["." /]})
@@ -20,7 +21,7 @@
(def: (should-pass regex input)
(-> (Lexer Text) Text Bit)
(|> (lexer.run input regex)
- (case> (#.Right parsed)
+ (case> (#error.Success parsed)
(text@= parsed input)
_
@@ -29,24 +30,34 @@
(def: (text-should-pass test regex input)
(-> Text (Lexer Text) Text Bit)
(|> (lexer.run input regex)
- (case> (#.Right parsed)
+ (case> (#error.Success parsed)
(text@= test parsed)
_
- #0)))
+ false)))
(def: (should-fail regex input)
(All [a] (-> (Lexer a) Text Bit))
(|> (lexer.run input regex)
- (case> (#.Left _) #1 _ #0)))
+ (case> (#error.Failure _)
+ true
+
+ _
+ false)))
(syntax: (should-check pattern regex input)
- (wrap (list (` (|> (lexer.run (~ input) (~ regex))
- (case> (^ (#.Right (~ pattern)))
- #1
+ (macro.with-gensyms [g!message g!_]
+ (wrap (list (` (|> (lexer.run (~ input) (~ regex))
+ (case> (^ (#error.Success (~ pattern)))
+ true
- (~' _)
- #0))))))
+ (#error.Failure (~ g!message))
+ (exec (log! (format "{{{Failure}}} " (~ g!message)))
+ false)
+
+ (~ g!_)
+ (exec (log! (format "{{{Success}}} " "OH NO"))
+ false))))))))
(def: basics
Test
@@ -177,7 +188,9 @@
Test
(let [number (/.regex "\d+")]
(_.test "Can build complex regexs by combining simpler ones."
- (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789"))))
+ (should-check ["809-345-6789" "809" "345" "6789"]
+ (/.regex "(\@<number>)-(\@<number>)-(\@<number>)")
+ "809-345-6789"))))
(def: fuzzy-quantifiers
Test
@@ -244,15 +257,14 @@
(and (should-check ["a" (0 [])] (/.regex "a|b") "a")
(should-check ["b" (1 [])] (/.regex "a|b") "b")
(should-fail (/.regex "a|b") "c")))
-
(_.test "Can have groups within alternations."
(and (should-check ["abc" (0 ["b" "c"])] (/.regex "a(.)(.)|b(.)(.)") "abc")
(should-check ["bcd" (1 ["c" "d"])] (/.regex "a(.)(.)|b(.)(.)") "bcd")
(should-fail (/.regex "a(.)(.)|b(.)(.)") "cde")
- (should-check ["809-345-6789" (0 ["809" "345-6789" "345" "6789"])]
+ (should-check ["123-456-7890" (0 ["123" "456-7890" "456" "7890"])]
(/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d")
- "809-345-6789")))
+ "123-456-7890")))
))
(def: pattern-matching
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 17:41:47 +0000