Commits

llibra committed 536044b

Implemented CHAINL1, CHAINL, CHAINR1 and CHAINR.

For #15.

Comments (0)

Files changed (4)

 `parser`を`end`が成功するまで0回以上適用するパーサを返します。成功するとパーサは
 `parser`の結果の値のリストを返します。
 
+#### Function: chainl1 parser op
+
+Returns a parser that expects one or more sequences of `parser` separated by
+`op`. The parser returns a value produced by a left-associative application of
+all functions returned by `op` to the result values of `parser` on success.
+
+`op`で区切られた`parser`の1回以上の繰り返しを期待するパーサを返します。 パーサが
+成功した場合、`parser`の結果の値に`op`が返す関数を左結合で適用した値を返します。
+
+#### Function: chainl parser op &optional x
+
+Returns a parser that expects zero or more sequences of `parser` separated by
+`op`. The parser returns a value produced by a left-associative application of
+all functions returned by `op` to the result values of `parser` on success. If
+the first `parser` fails without consuming any input, it returns `x` as a result
+value.
+
+`op`で区切られた`parser`の0回以上の繰り返しを期待するパーサを返します。 パーサが
+成功した場合、`parser`の結果の値に`op`が返す関数を左結合で適用した値を返します。
+最初の`parser`が入力を消費しないで失敗した場合、結果の値として`x`を返します。
+
+#### Function: chainr1 parser op
+
+Returns a parser that expects one or more sequences of `parser` separated by
+`op`. The parser returns a value produced by a right-associative application of
+all functions returned by `op` to the result values of `parser` on success.
+
+`op`で区切られた`parser`の1回以上の繰り返しを期待するパーサを返します。 パーサが
+成功した場合、`parser`の結果の値に`op`が返す関数を右結合で適用した値を返します。
+
+#### Function: chainr parser op &optional x
+
+Returns a parser that expects zero or more sequences of `parser` separated by
+`op`. The parser returns a value produced by a right-associative application of
+all functions returned by `op` to the result values of `parser` on success. If
+the first `parser` fails without consuming any input, it returns `x` as a result
+value.
+
+`op`で区切られた`parser`の0回以上の繰り返しを期待するパーサを返します。 パーサが
+成功した場合、`parser`の結果の値に`op`が返す関数を右結合で適用した値を返します。
+最初の`parser`が入力を消費しないで失敗した場合、結果の値として`x`を返します。
+
 #### Function: not-followed-by parser
 
 Returns a parser that succeeds when `parser` fails. The parser does not consume
 (defun many-till (parser end)
   (many (mlet1 _ (not-followed-by end) parser)))
 
+(defun chainl1 (parser op)
+  (labels ((rec (x)
+             (choice (mlet* ((f op) (y parser))
+                       (rec (funcall f x y)))
+                     (unit x))))
+    (mlet1 x parser (rec x))))
+
+(defun chainl (parser op &optional x)
+  (choice (chainl1 parser op)
+          (unit x)))
+
+(defun chainr1 (parser op)
+  (labels ((rec ()
+             (mlet1 x parser (rec-1 x)))
+           (rec-1 (x)
+             (choice (mlet* ((f op) (y (rec)))
+                       (unit (funcall f x y)))
+                     (unit x))))
+    (rec)))
+
+(defun chainr (parser op &optional x)
+  (choice (chainr1 parser op)
+          (unit x)))
+
 (defun not-followed-by (parser)
   (try (choice (mlet1 _ parser (fail nil))
                (unit nil))))
 (defpackage :aly.combinator
   (:use :cl :aly.core)
   (:export :sep-by :sep-by1 :many1 :skip-many1 :end-by :end-by1 :times :between
-           :many-till :not-followed-by))
+           :many-till :chainl1 :chainl :chainr1 :chainr :not-followed-by))
 
 (defpackage :aly
   (:use :cl :aly.condition :aly.core :aly.combinator)
            :try :expect :many :skip-many :eoi :parse
 
            :sep-by :sep-by1 :many1 :skip-many1 :end-by :end-by1 :times :between
-           :many-till :not-followed-by))
+           :many-till :chainl1 :chainl :chainr1 :chainr :not-followed-by))
 
 (defpackage :aly.char
   (:use :cl :aly.util :aly.core :aly.combinator)
     (5am:is (equal '(#\a) (mt "a.")))
     (5am:is (equal '(#\a #\b) (mt "ab.")))))
 
+(flet ((body (fn x)
+         (5am:is (eql x (parse (funcall fn #'any-char #'any-char x) nil)))))
+  (5am:test (chainl/default-value :compile-at :definition-time)
+    (body #'chainl :default))
+  (5am:test (chainr/default-value :compile-at :definition-time)
+    (body #'chainr :default)))
+
+(flet ((body (fn x src)
+         (let ((digit (mlet1 x (digit) (unit (digit-char-p x))))
+               (plus (seqn (specific-char #\+) (unit #'+)))
+               (minus (seqn (specific-char #\-) (unit #'-))))
+           (5am:is (= x (parse (funcall fn digit (choice plus minus)) src))))))
+  (5am:test (chainl/add-and-subtract :compile-at :definition-time)
+    (body #'chainl1 3 "1-2+3-4+5")
+    (body #'chainl 3 "1-2+3-4+5"))
+  (5am:test (chainr/add-and-subtract :compile-at :definition-time)
+    (body #'chainr1 5 "1-2+3-4+5")
+    (body #'chainr 5 "1-2+3-4+5")))
+
 (5am:test not-followed-by
   (flet ((nfb (x)
            (parse (not-followed-by (specific-char #\a)) x)))