aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/host/python.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/js/case.lux70
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/python/case.lux80
-rw-r--r--stdlib/source/lux/tool/compiler/synthesis.lux30
4 files changed, 122 insertions, 67 deletions
diff --git a/stdlib/source/lux/host/python.lux b/stdlib/source/lux/host/python.lux
index 322ac261e..ce9a2e504 100644
--- a/stdlib/source/lux/host/python.lux
+++ b/stdlib/source/lux/host/python.lux
@@ -328,14 +328,13 @@
(format "for " (:representation var) " in " (:representation inputs) ":"
(..nest (:representation body!)))))
- (def: #export (statement expression)
+ (def: #export statement
(-> (Expression Any) (Statement Any))
- (:abstraction
- (format (:representation expression) ";")))
+ (|>> :transmutation))
- (def: #export no-op!
+ (def: #export pass
(Statement Any)
- (:abstraction text.new-line))
+ (:abstraction "pass"))
(type: #export Except
{#classes (List SVar)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
index 4a28ccb3f..4561e5e84 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -104,6 +104,32 @@
(_.statement (|> @cursor (_.do "splice" (list (|> @cursor ..length (_.- popsJS))
popsJS))))))
+(template [<name> <flag> <prep>]
+ [(def: (<name> simple? idx)
+ (-> Bit Nat Statement)
+ ($_ _.then
+ (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
+ (_.if (_.= _.null @temp)
+ fail-pm!
+ (.if simple?
+ (_.statement _.null)
+ (push-cursor! @temp)))))]
+
+ [left-choice _.null (<|)]
+ [right-choice (_.string "") inc]
+ )
+
+(def: (alternation pre! post!)
+ (-> Statement Statement Statement)
+ ($_ _.then
+ (_.do-while _.false
+ ($_ _.then
+ ..save-cursor!
+ pre!))
+ ($_ _.then
+ ..restore-cursor!
+ post!)))
+
(def: (pattern-matching' generate pathP)
(-> Phase Path (Operation Statement))
(.case pathP
@@ -127,15 +153,16 @@
[/////synthesis.path/f64 //primitive.f64 _.=]
[/////synthesis.path/text //primitive.text _.=])
- (^template [<pm> <flag> <prep>]
- (^ (<pm> idx))
- (////@wrap ($_ _.then
- (_.set @temp (|> idx <prep> .int _.i32 (//runtime.sum//get ..peek-cursor <flag>)))
- (_.if (_.= _.null @temp)
- fail-pm!
- (push-cursor! @temp)))))
- ([/////synthesis.side/left _.null (<|)]
- [/////synthesis.side/right (_.string "") inc])
+ (^template [<complex> <simple> <choice>]
+ (^ (<complex> idx))
+ (////@wrap (<choice> false idx))
+
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate)
+ (:: ////.monad map (_.then (<choice> true idx)))))
+ ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
+ [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
(^template [<pm> <getter> <prep>]
(^ (<pm> idx))
@@ -143,20 +170,14 @@
([/////synthesis.member/left //runtime.product//left (<|)]
[/////synthesis.member/right //runtime.product//right inc])
- (^ ($_ /////synthesis.path/seq
- (#/////synthesis.Bind register)
- #/////synthesis.Pop
- thenP))
+ (^ (/////synthesis.!bind-top register thenP))
(do ////.monad
[then! (pattern-matching' generate thenP)]
(////@wrap ($_ _.then
(_.define (..register register) ..peek-and-pop-cursor)
then!)))
- (^ ($_ /////synthesis.path/seq
- #/////synthesis.Pop
- #/////synthesis.Pop
- nextP))
+ (^ (/////synthesis.!multi-pop nextP))
(.let [[extra-pops nextP'] (case.count-pops nextP)]
(do ////.monad
[next! (pattern-matching' generate nextP')]
@@ -164,21 +185,14 @@
(multi-pop-cursor! (n/+ 2 extra-pops))
next!))))
- (^template [<tag> <computation>]
+ (^template [<tag> <combinator>]
(^ (<tag> leftP rightP))
(do ////.monad
[left! (pattern-matching' generate leftP)
right! (pattern-matching' generate rightP)]
- (wrap <computation>)))
- ([/////synthesis.path/seq (_.then left! right!)]
- [/////synthesis.path/alt ($_ _.then
- (_.do-while _.false
- ($_ _.then
- ..save-cursor!
- left!))
- ($_ _.then
- ..restore-cursor!
- right!))])
+ (wrap (<combinator> left! right!))))
+ ([/////synthesis.path/seq _.then]
+ [/////synthesis.path/alt alternation])
_
(////.throw unrecognized-path [])))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
index 82a96836d..b1f53a8b2 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/python/case.lux
@@ -100,13 +100,37 @@
(-> Nat (Statement Any))
(_.delete (_.slice-from (_.int (i/* -1 (.int pops))) @cursor)))
+(template [<name> <flag> <prep>]
+ [(def: (<name> simple? idx)
+ (-> Bit Nat (Statement Any))
+ ($_ _.then
+ (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>)))
+ (_.if (_.= _.none @temp)
+ fail-pm!
+ (.if simple?
+ _.pass
+ (push-cursor! @temp)))))]
+
+ [left-choice _.none (<|)]
+ [right-choice (_.string "") inc]
+ )
+
+(def: (alternation pre! post!)
+ (-> (Statement Any) (Statement Any) (Statement Any))
+ ($_ _.then
+ (_.while (_.bool true)
+ ($_ _.then
+ ..save-cursor!
+ pre!))
+ ($_ _.then
+ ..restore-cursor!
+ post!)))
+
(def: (pattern-matching' generate pathP)
(-> Phase Path (Operation (Statement Any)))
(.case pathP
(^ (/////synthesis.path/then bodyS))
- (do ////.monad
- [body! (generate bodyS)]
- (wrap (_.return body!)))
+ (:: ////.monad map _.return (generate bodyS))
#/////synthesis.Pop
(////@wrap pop-cursor!)
@@ -123,15 +147,16 @@
[/////synthesis.path/f64 //primitive.f64]
[/////synthesis.path/text //primitive.text])
- (^template [<pm> <flag> <prep>]
- (^ (<pm> idx))
- (////@wrap ($_ _.then
- (_.set (list @temp) (|> idx <prep> .int _.int (//runtime.sum//get ..peek-cursor <flag>)))
- (_.if (_.= _.none @temp)
- fail-pm!
- (push-cursor! @temp)))))
- ([/////synthesis.side/left _.none (<|)]
- [/////synthesis.side/right (_.string "") inc])
+ (^template [<complex> <simple> <choice>]
+ (^ (<complex> idx))
+ (////@wrap (<choice> false idx))
+
+ (^ (<simple> idx nextP))
+ (|> nextP
+ (pattern-matching' generate)
+ (:: ////.monad map (_.then (<choice> true idx)))))
+ ([/////synthesis.side/left /////synthesis.simple-left-side ..left-choice]
+ [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
(^template [<pm> <getter> <prep>]
(^ (<pm> idx))
@@ -139,20 +164,14 @@
([/////synthesis.member/left //runtime.product//left (<|)]
[/////synthesis.member/right //runtime.product//right inc])
- (^ ($_ /////synthesis.path/seq
- (#/////synthesis.Bind register)
- #/////synthesis.Pop
- thenP))
+ (^ (/////synthesis.!bind-top register thenP))
(do ////.monad
[then! (pattern-matching' generate thenP)]
(////@wrap ($_ _.then
(_.set (list (..register register)) ..peek-and-pop-cursor)
then!)))
- (^ ($_ /////synthesis.path/seq
- #/////synthesis.Pop
- #/////synthesis.Pop
- nextP))
+ (^ (/////synthesis.!multi-pop nextP))
(.let [[extra-pops nextP'] (case.count-pops nextP)]
(do ////.monad
[next! (pattern-matching' generate nextP')]
@@ -160,21 +179,14 @@
(multi-pop-cursor! (n/+ 2 extra-pops))
next!))))
- (^template [<tag> <computation>]
- (^ (<tag> leftP rightP))
+ (^template [<tag> <combinator>]
+ (^ (<tag> preP postP))
(do ////.monad
- [left! (pattern-matching' generate leftP)
- right! (pattern-matching' generate rightP)]
- (wrap <computation>)))
- ([/////synthesis.path/seq (_.then left! right!)]
- [/////synthesis.path/alt ($_ _.then
- (_.while (_.bool true)
- ($_ _.then
- ..save-cursor!
- left!))
- ($_ _.then
- ..restore-cursor!
- right!))])
+ [pre! (pattern-matching' generate preP)
+ post! (pattern-matching' generate postP)]
+ (wrap (<combinator> pre! post!))))
+ ([/////synthesis.path/seq _.then]
+ [/////synthesis.path/alt ..alternation])
_
(////.throw unrecognized-path [])))
diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux
index 6b147ffae..39b62ac88 100644
--- a/stdlib/source/lux/tool/compiler/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/synthesis.lux
@@ -466,3 +466,33 @@
(def: #export path-equivalence
(Equivalence Path)
(path'-equivalence equivalence))
+
+(template: #export (!bind-top register thenP)
+ ($_ ..path/seq
+ (#..Bind register)
+ #..Pop
+ thenP))
+
+(template: #export (!multi-pop nextP)
+ ($_ ..path/seq
+ #..Pop
+ #..Pop
+ nextP))
+
+## TODO: There are sister patterns to the simple side checks for tuples.
+## These correspond to the situation where tuple members are accessed
+## and bound to variables, but those variables are never used, so they
+## become POPs.
+## After re-implementing unused-variable-elimination, must add those
+## pattern-optimizations again, since a lot of BINDs will become POPs
+## and thus will result in useless code being generated.
+(template [<name> <side>]
+ [(template: #export (<name> idx nextP)
+ ($_ ..path/seq
+ (<side> idx)
+ #..Pop
+ nextP))]
+
+ [simple-left-side ..side/left]
+ [simple-right-side ..side/right]
+ )