implement parenthesized groups in both
This commit is contained in:
parent
3251b4a4e1
commit
19643aa6c1
|
@ -119,14 +119,29 @@ takeOper s with takeCons opers s
|
||||||
-- ... | emit (just (Oper o)) rem₂ = emit↓ (Oper o) rem₂
|
-- ... | emit (just (Oper o)) rem₂ = emit↓ (Oper o) rem₂
|
||||||
-- ... | emit _ rem₂ = emit↑ rem
|
-- ... | emit _ rem₂ = emit↑ rem
|
||||||
|
|
||||||
|
takeAlt : { R : Set } → ( List Char → Result R ) → ( List Char → Result R ) → List Char → Result R
|
||||||
|
|
||||||
|
takeGroup : { G : Set } → ( List Char → Result G ) → List Char → Result G
|
||||||
|
|
||||||
takeBin : List Char → Result BinExpr
|
takeBin : List Char → Result BinExpr
|
||||||
takeBin s with takeNat (ignoreCons skips s)
|
takeBin s with (takeAlt takeNat (takeGroup takeNat)) (ignoreCons skips s)
|
||||||
... | emit nothing rem₁ = emit↑ s
|
... | emit nothing rem₁ = emit↑ s
|
||||||
... | emit (just res₁) rem₁ with takeOper (ignoreCons skips rem₁)
|
... | emit (just res₁) rem₁ with takeOper (ignoreCons skips rem₁)
|
||||||
... | emit nothing rem₂ = emit↑ rem₁
|
... | emit nothing rem₂ = emit↑ rem₁
|
||||||
... | emit (just oper) rem₂ with takeNat (ignoreCons skips rem₂)
|
... | emit (just oper) rem₂ with (takeAlt takeNat (takeGroup takeNat)) (ignoreCons skips rem₂)
|
||||||
... | emit nothing rem₃ = emit↑ rem₁
|
... | emit nothing rem₃ = emit↑ rem₁
|
||||||
... | emit (just res₃) rem₃ = emit↓ (bin oper (Digit res₁) (Digit res₃)) rem₃
|
... | emit (just res₃) rem₃ = emit↓ (bin oper (Digit res₁) (Digit res₃)) rem₃
|
||||||
|
|
||||||
|
takeGroup f s with takeCons ('(' ∷ []) s
|
||||||
|
... | emit _ rem with f rem
|
||||||
|
... | emit g rem₂ with takeCons (')' ∷ []) rem₂
|
||||||
|
... | emit _ rem₃ = emit g rem₃
|
||||||
|
|
||||||
|
takeAlt a b s with a s
|
||||||
|
... | emit (just r) rem = emit↓ r rem
|
||||||
|
... | emit nothing rem with b s
|
||||||
|
... | emit (just r) rem = emit↓ r rem
|
||||||
|
... | emit nothing rem = emit↑ s
|
||||||
|
|
||||||
takeLine : List Char → List (Result BinExpr)
|
takeLine : List Char → List (Result BinExpr)
|
||||||
takeLine s = map takeBin (map reverse (reverse (split (';' ∷ []) s)))
|
takeLine s = map (takeAlt takeBin (takeGroup takeBin)) (map reverse (reverse (split (';' ∷ []) s)))
|
||||||
|
|
|
@ -253,13 +253,16 @@ export function takeOper(s: ReadonlyArray<string>): Result<Token> {
|
||||||
* attempt to take a binary expression from a stream.
|
* attempt to take a binary expression from a stream.
|
||||||
*/
|
*/
|
||||||
export function takeBin(s: ReadonlyArray<string>): Result<BinExpr> {
|
export function takeBin(s: ReadonlyArray<string>): Result<BinExpr> {
|
||||||
const lhs = takeNat(ignoreCons(SKIPS, s));
|
const takeAltNatGroup: (s: ReadonlyArray<string>) => Result<number> =
|
||||||
|
(takeAlt<number>).bind(nothing(), takeNat, (takeGroup<number>).bind(nothing(), takeNat));
|
||||||
|
|
||||||
|
const lhs = takeAltNatGroup(ignoreCons(SKIPS, s));
|
||||||
|
|
||||||
if (isCont(lhs)) {
|
if (isCont(lhs)) {
|
||||||
const oper = takeOper(ignoreCons(SKIPS, remain(lhs)));
|
const oper = takeOper(ignoreCons(SKIPS, remain(lhs)));
|
||||||
|
|
||||||
if (isCont(oper)) {
|
if (isCont(oper)) {
|
||||||
const rhs = takeNat(ignoreCons(SKIPS, remain(oper)));
|
const rhs = takeAltNatGroup(ignoreCons(SKIPS, remain(oper)));
|
||||||
|
|
||||||
if (isCont(rhs)) {
|
if (isCont(rhs)) {
|
||||||
return emitCont(bin(result(oper), digit(result(lhs)), digit(result(rhs))), remain(rhs));
|
return emitCont(bin(result(oper), digit(result(lhs)), digit(result(rhs))), remain(rhs));
|
||||||
|
@ -270,9 +273,34 @@ export function takeBin(s: ReadonlyArray<string>): Result<BinExpr> {
|
||||||
return emitBack(s);
|
return emitBack(s);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
export function takeGroup<T>(f: (s: ReadonlyArray<string>) => Result<T>, s: ReadonlyArray<string>): Result<T> {
|
||||||
|
const a = takeCons(['('], s);
|
||||||
|
const b = f(remain(a));
|
||||||
|
const c = takeCons([')'], remain(b));
|
||||||
|
|
||||||
|
return emit(b.res, remain(c));
|
||||||
|
}
|
||||||
|
|
||||||
|
export function takeAlt<T>(a: (s: ReadonlyArray<string>) => Result<T>, b: (s: ReadonlyArray<string>) => Result<T>, s: ReadonlyArray<string>): Result<T> {
|
||||||
|
const ra = a(s);
|
||||||
|
if (isCont(ra)) {
|
||||||
|
return ra;
|
||||||
|
}
|
||||||
|
|
||||||
|
const rb = b(s);
|
||||||
|
if (isCont(rb)) {
|
||||||
|
return rb;
|
||||||
|
}
|
||||||
|
|
||||||
|
return emitBack(s);
|
||||||
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* split a string into expressions and parse them
|
* split a string into expressions and parse them
|
||||||
*/
|
*/
|
||||||
export function takeLine(c: ReadonlyArray<string>): ReadonlyArray<Result<BinExpr>> {
|
export function takeLine(c: ReadonlyArray<string>): ReadonlyArray<Result<BinExpr>> {
|
||||||
return map(takeBin, split([';'], c));
|
const takeAltBinGroup: (s: ReadonlyArray<string>) => Result<BinExpr> =
|
||||||
|
(takeAlt<BinExpr>).bind(nothing(), takeBin, (takeGroup<BinExpr>).bind(nothing(), takeBin));
|
||||||
|
|
||||||
|
return map(takeAltBinGroup, split([';'], c));
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue