[MLton-commit] r7005
Vesa Karvonen
vesak at mlton.org
Sat Dec 20 08:39:35 PST 2008
Renamed drop -> skipManySatisfy and take -> manySatisfy and added several
variants of those as in FParsec.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
U mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/mk-parsec.fun
U mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/parsec.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-12-16 10:21:30 UTC (rev 7004)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-12-20 16:39:32 UTC (rev 7005)
@@ -52,7 +52,9 @@
lp 0
end
- fun ignored 0 = drop Char.isSpace >> (L"(*" >> eta ignored 1 <|> return ())
+ val skipSpaces = skipManySatisfy Char.isSpace
+
+ fun ignored 0 = skipSpaces >> (L"(*" >> eta ignored 1 <|> return ())
| ignored n = L"*)" >> eta ignored (n-1) <|>
L"(*" >> eta ignored (n+1) <|>
elem >> eta ignored n
@@ -66,15 +68,14 @@
datatype radix = datatype StringCvt.radix
- fun id first rest =
- sat first >>= (fn c => take rest >>= (fn cs => return (implode (c::cs))))
+ fun id first rest = map implode (many1Satisfy2 first rest)
val alphaId = id Char.isAlpha
(fn c => Char.isAlpha c
orelse Char.isDigit c
orelse #"'" = c orelse #"_" = c)
val isSymbolic = Char.contains "!#$%&*+-/:<=>?@\\^`|~"
- val symbolicId = id isSymbolic isSymbolic
+ val symbolicId = map implode (many1Satisfy isSymbolic)
val shortId = alphaId <|> symbolicId
val longId = sepBy1 shortId (E#".")
@@ -304,7 +305,7 @@
<|> E#"u" >> satN Char.isHexDigit 4 >>= (fn ds => scan (#"u" :: ds) cs)
<|> E#"U" >> satN Char.isHexDigit 8 >>= (fn ds => scan (#"U" :: ds) cs)
<|> sat Char.isGraph >>= (fn c => scan [c] cs)
- <|> sat Char.isSpace >> drop Char.isSpace >> E#"\\" >>= (fn _ =>
+ <|> sat Char.isSpace >> skipSpaces >> E#"\\" >>= (fn _ =>
chars cs)
and scan c cs =
case Char.scan List.getItem (#"\\" :: c)
Modified: mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/mk-parsec.fun
===================================================================
--- mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/mk-parsec.fun 2008-12-16 10:21:30 UTC (rev 7004)
+++ mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/mk-parsec.fun 2008-12-20 16:39:32 UTC (rev 7005)
@@ -26,6 +26,7 @@
(* SML/NJ workaround --> *)
open Arg
+ open Sequence
type 'a etaexp_dom = Sequence.t * State.t
type msg = Sequence.Pos.t
datatype 'a reply =
@@ -110,16 +111,34 @@
of NONE => EMPTY (FAIL (pos s))
| SOME (c, s) => taste (OK (c, s, pos s))
- fun drop p s = let
- fun done f s = f (OK ((), s, pos s))
- fun some (c, s') s = if p c then lp s' else done taste s
- and body f s =
- case get s
- of NONE => done f s
- | SOME cs => some cs s
- and lp s = body taste s
+ local
+ fun mk isZero zero plus finish req1 q p s = let
+ fun ok v s = OK (finish v, s, pos s)
+ fun done v =
+ if isZero v
+ then EMPTY o (if req1 then FAIL o pos else ok v)
+ else taste o ok v
+ fun step p es s =
+ case get s
+ of NONE => done es s
+ | SOME (e, t) => if p e then body (plus (e, es)) t else done es s
+ and body es = step p es
+ in
+ case q
+ of NONE => body zero s
+ | SOME q => step q zero s
+ end
+ val mkMany = mk null [] op :: rev
+ val mkSkip = mk id true (const false) General.ignore
in
- body EMPTY s
+ val many1Satisfy = mkMany true NONE
+ val many1Satisfy2 = mkMany true o SOME
+ val manySatisfy = mkMany false NONE
+ val manySatisfy2 = mkMany false o SOME
+ val skipMany1Satisfy = mkSkip true NONE
+ val skipMany1Satisfy2 = mkSkip true o SOME
+ val skipManySatisfy = mkSkip false NONE
+ val skipManySatisfy2 = mkSkip false o SOME
end
fun sat p s =
@@ -128,21 +147,6 @@
| SOME (c, s') =>
if p c then taste (OK (c, s', pos s')) else EMPTY (FAIL (pos s))
- fun take p = let
- fun done s =
- fn [] => EMPTY (OK ([], s, pos s))
- | cs => taste (OK (rev cs, s, pos s))
- fun lp cs s =
- case get s
- of NONE => done s cs
- | SOME (c, s') =>
- if p c
- then lp (c::cs) s'
- else done s cs
- in
- lp []
- end
-
fun peek p s =
case p s
of EMPTY (OK (x, _, m)) => EMPTY (OK (x, s, m))
Modified: mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/parsec.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/parsec.sig 2008-12-16 10:21:30 UTC (rev 7004)
+++ mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/parsec.sig 2008-12-20 16:39:32 UTC (rev 7005)
@@ -12,6 +12,9 @@
signature PARSEC = sig
include MK_PARSEC_DOM
+ structure Elem : T
+ sharing Elem = Sequence.Elem
+
include ETAEXP'
include MONADP where type 'a monad = 'a etaexp
@@ -23,17 +26,26 @@
val getState : State.t t
val setState : State.t -> Unit.t t
- val fromScan : ((Sequence.Elem.t, Sequence.t) Reader.t
- -> ('a, Sequence.t) Reader.t) -> 'a t
+ val fromScan :
+ ((Elem.t, Sequence.t) Reader.t -> ('a, Sequence.t) Reader.t) -> 'a t
val fromReader : ('a, Sequence.t) Reader.t -> 'a t
val guess : 'a t UnOp.t
- val elem : Sequence.Elem.t t
- val drop : Sequence.Elem.t UnPr.t -> Unit.t t
- val sat : Sequence.Elem.t UnPr.t -> Sequence.Elem.t t
- val take : Sequence.Elem.t UnPr.t -> Sequence.Elem.t List.t t
+ val elem : Elem.t t
+ val sat : Elem.t UnPr.t -> Elem.t t
+
+ val manySatisfy : Elem.t UnPr.t -> Elem.t List.t t
+ val manySatisfy2 : Elem.t UnPr.t -> Elem.t UnPr.t -> Elem.t List.t t
+ val many1Satisfy : Elem.t UnPr.t -> Elem.t List.t t
+ val many1Satisfy2 : Elem.t UnPr.t -> Elem.t UnPr.t -> Elem.t List.t t
+
+ val skipManySatisfy : Elem.t UnPr.t -> Unit.t t
+ val skipManySatisfy2 : Elem.t UnPr.t -> Elem.t UnPr.t -> Unit.t t
+ val skipMany1Satisfy : Elem.t UnPr.t -> Unit.t t
+ val skipMany1Satisfy2 : Elem.t UnPr.t -> Elem.t UnPr.t -> Unit.t t
+
val ->> : 'a t * 'b t -> 'b t
val >>- : 'a t * 'b t -> 'a t
More information about the MLton-commit
mailing list