aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-05-28 18:43:43 -0400
committerEduardo Julian2019-05-28 18:43:43 -0400
commita420abd8ef1d5a008a5a0b6f75590cab2a9baac5 (patch)
treee94bc0a604113f1838d034fb36628dae27a20974 /stdlib
parent5635aa3482001fd137b9deee42514b803ba21f75 (diff)
Implemented machinery for "lux syntax char case!".
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux66
1 files changed, 63 insertions, 3 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
index e6a58e3b7..51402fad8 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/common.lux
@@ -3,12 +3,17 @@
[abstract
["." monad (#+ do)]]
[control
- [io (#+ IO)]]
+ [io (#+ IO)]
+ ["." exception (#+ exception:)]
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
[data
+ ["." maybe]
+ ["." error]
["." text
format]
[collection
- ["." list]
+ ["." list ("#@." functor)]
["." dictionary (#+ Dictionary)]]]
[type
["." check]]
@@ -23,7 +28,20 @@
["#/" //
[default
[evaluation (#+ Eval)]]
- ["#." analysis (#+ Analysis Handler Bundle)]]]])
+ ["#." analysis (#+ Analysis Operation Phase Handler Bundle)]]]])
+
+(def: #export (custom [syntax handler])
+ (All [s]
+ (-> [(Parser s)
+ (-> Text Phase s (Operation Analysis))]
+ Handler))
+ (function (_ extension-name analyse args)
+ (case (<c>.run syntax args)
+ (#error.Success inputs)
+ (handler extension-name analyse inputs)
+
+ (#error.Failure error)
+ (/////analysis.throw ///.invalid-syntax [extension-name %code args]))))
(def: (simple inputsT+ outputT)
(-> (List Type) Type Handler)
@@ -57,6 +75,47 @@
(-> Type Type Type Type Handler)
(simple (list subjectT param0T param1T) outputT))
+## TODO: Get rid of this ASAP
+(as-is
+ (exception: #export (char-text-must-be-size-1 {text Text})
+ (exception.report
+ ["Text" (%t text)]))
+
+ (def: text-char
+ (Parser text.Char)
+ (do <>.monad
+ [raw <c>.text]
+ (case (text.size raw)
+ 1 (wrap (|> raw (text.nth 0) maybe.assume))
+ _ (<>.fail (exception.construct ..char-text-must-be-size-1 [raw])))))
+
+ (def: lux::syntax-char-case!
+ (..custom [($_ <>.and
+ <c>.any
+ (<c>.tuple (<>.some (<>.and (<c>.tuple (<>.many ..text-char))
+ <c>.any)))
+ <c>.any)
+ (function (_ extension-name phase [input conditionals else])
+ (do ////.monad
+ [input (typeA.with-type text.Char
+ (phase input))
+ expectedT (///.lift macro.expected-type)
+ conditionals (monad.map @ (function (_ [cases branch])
+ (do @
+ [branch (typeA.with-type expectedT
+ (phase branch))]
+ (wrap [cases branch])))
+ conditionals)
+ else (typeA.with-type expectedT
+ (phase else))]
+ (wrap (|> conditionals
+ (list@map (function (_ [cases branch])
+ (/////analysis.tuple
+ (list (/////analysis.tuple (list@map (|>> /////analysis.nat) cases))
+ branch))))
+ (list& input else)
+ (#/////analysis.Extension extension-name)))))])))
+
## "lux is" represents reference/pointer equality.
(def: lux::is
Handler
@@ -143,6 +202,7 @@
(def: (bundle::lux eval)
(-> Eval Bundle)
(|> ///bundle.empty
+ (///bundle.install "syntax char case!" lux::syntax-char-case!)
(///bundle.install "is" lux::is)
(///bundle.install "try" lux::try)
(///bundle.install "check" (lux::check eval))