haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

simplify parenthesis matching 

Ignore-this: f21ca14b5d5c6f4018614dec0b6a9ca0

darcs-hash:20110728201850-c41ad-e2e19fee4dab290d7e8324380e1dc9f4c3522728
This commit is contained in:
Jeremie Dimino 2011-07-28 22:18:50 +02:00
parent 7965e3b3d2
commit 84c3a41052
1 changed files with 30 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
src/uTop_console.ml
View File

@ -159,41 +159,35 @@ object(self)
(* Parenthesis matching. *) (* Parenthesis matching. *)
if not last && Array.length styled > 0 then begin if not last && Array.length styled > 0 then begin
let rec rsearch idx top stack = let rec rsearch idx left right depth =
if idx >= Array.length styled then if idx >= Array.length styled then
None None
else else
let ch, _ = styled.(idx) in let ch, _ = styled.(idx) in
if ch = top then if ch = right then
match stack with if depth = 0 then
| top :: stack -> rsearch (idx + 1) top stack Some idx
| [] -> Some idx else
else if ch = lparen then rsearch (idx + 1) left right (depth - 1)
rsearch (idx + 1) rparen (top :: stack) else if ch = left then
else if ch = lbrace then rsearch (idx + 1) left right (depth + 1)
rsearch (idx + 1) rbrace (top :: stack)
else if ch = lbracket then
rsearch (idx + 1) rbracket (top :: stack)
else else
rsearch (idx + 1) top stack rsearch (idx + 1) left right depth
in in
let rec lsearch idx top stack = let rec lsearch idx left right depth =
if idx < 0 then if idx < 0 then
None None
else else
let ch, _ = styled.(idx) in let ch, _ = styled.(idx) in
if ch = top then if ch = left then
match stack with if depth = 0 then
| top :: stack -> lsearch (idx - 1) top stack Some idx
| [] -> Some idx else
else if ch = rparen then lsearch (idx - 1) left right (depth - 1)
lsearch (idx - 1) lparen (top :: stack) else if ch = right then
else if ch = rbrace then lsearch (idx - 1) left right (depth + 1)
lsearch (idx - 1) lbrace (top :: stack)
else if ch = rbracket then
lsearch (idx - 1) lbracket (top :: stack)
else else
lsearch (idx - 1) top stack lsearch (idx - 1) left right depth
in in
let matched = let matched =
if position = Array.length styled then if position = Array.length styled then
@ -202,17 +196,17 @@ object(self)
let ch, _ = styled.(position) in let ch, _ = styled.(position) in
match match
if ch = lparen then if ch = lparen then
rsearch (position + 1) rparen [] rsearch (position + 1) lparen rparen 0
else if ch = lbrace then else if ch = lbrace then
rsearch (position + 1) rbrace [] rsearch (position + 1) lbrace rbrace 0
else if ch = lbracket then else if ch = lbracket then
rsearch (position + 1) rbracket [] rsearch (position + 1) lbracket rbracket 0
else if ch = rparen then else if ch = rparen then
lsearch (position - 1) lparen [] lsearch (position - 1) lparen rparen 0
else if ch = rbrace then else if ch = rbrace then
lsearch (position - 1) lbrace [] lsearch (position - 1) lbrace rbrace 0
else if ch = rbracket then else if ch = rbracket then
lsearch (position - 1) lbracket [] lsearch (position - 1) lbracket rbracket 0
else else
None None
with with
@ -227,17 +221,17 @@ object(self)
let ch, style = styled.(position - 1) in let ch, style = styled.(position - 1) in
match match
if ch = lparen then if ch = lparen then
rsearch (position + 1) rparen [] rsearch (position + 1) lparen rparen 0
else if ch = lbrace then else if ch = lbrace then
rsearch (position + 1) rbrace [] rsearch (position + 1) lbrace rbrace 0
else if ch = lbracket then else if ch = lbracket then
rsearch (position + 1) rbracket [] rsearch (position + 1) lbracket rbracket 0
else if ch = rparen then else if ch = rparen then
lsearch (position - 2) lparen [] lsearch (position - 2) lparen rparen 0
else if ch = rbrace then else if ch = rbrace then
lsearch (position - 2) lbrace [] lsearch (position - 2) lbrace rbrace 0
else if ch = rbracket then else if ch = rbracket then
lsearch (position - 2) lbracket [] lsearch (position - 2) lbracket rbracket 0
else else
None None
with with