Commit 82bd5ba0 authored by John van Groningen's avatar John van Groningen
Browse files

refactor, reduce indentation of local functions want_list in want_LGraphExpr in module parse

parent 711effdf
...@@ -4232,50 +4232,49 @@ wantListPatternWithoutDefinitions pState ...@@ -4232,50 +4232,49 @@ wantListPatternWithoutDefinitions pState
_ _
-> want_LGraphExpr token [] head_strictness pState -> want_LGraphExpr token [] head_strictness pState
= want_LGraphExpr token [] head_strictness pState = want_LGraphExpr token [] head_strictness pState
where where
want_LGraphExpr token acc head_strictness pState want_LGraphExpr (CharListToken chars) acc head_strictness pState
= case token of = want_list (add_chars (fromString chars) acc) head_strictness pState
CharListToken chars want_LGraphExpr token acc head_strictness pState
-> want_list (add_chars (fromString chars) acc) pState # (exp, pState) = wantPatternWithoutDefinitionsT token pState
_ # (exp, pState) = wantPatternWithoutDefinitionsT token pState = want_list [exp: acc] head_strictness pState
-> want_list [exp: acc] pState
where want_list acc head_strictness pState
want_list acc pState # (token, pState) = nextToken FunctionContext pState
# (token, pState) = nextToken FunctionContext pState = case token of
= case token of SquareCloseToken
SquareCloseToken # nil_expr = makeNilExpression head_strictness cIsAPattern
# nil_expr = makeNilExpression head_strictness cIsAPattern -> (gen_pattern_cons_nodes acc nil_expr head_strictness,pState)
-> (gen_pattern_cons_nodes acc nil_expr head_strictness,pState) ExclamationToken
ExclamationToken | head_strictness<>HeadOverloaded
| head_strictness<>HeadOverloaded # (token, pState) = nextToken FunctionContext pState
# (token, pState) = nextToken FunctionContext pState | token=:SquareCloseToken
| token=:SquareCloseToken # nil_expr = makeTailStrictNilExpression head_strictness cIsAPattern
# nil_expr = makeTailStrictNilExpression head_strictness cIsAPattern -> (gen_pattern_tail_strict_cons_nodes acc nil_expr head_strictness,pState)
-> (gen_pattern_tail_strict_cons_nodes acc nil_expr head_strictness,pState) -> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState)
-> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState) CommaToken
CommaToken # (token, pState) = nextToken FunctionContext pState
# (token, pState) = nextToken FunctionContext pState -> want_LGraphExpr token acc head_strictness pState
-> want_LGraphExpr token acc head_strictness pState ColonToken
ColonToken # (exp, pState) = wantPatternWithoutDefinitions pState
# (exp, pState) = wantPatternWithoutDefinitions pState # (token,pState) = nextToken FunctionContext pState
# (token,pState) = nextToken FunctionContext pState | token=:SquareCloseToken
| token=:SquareCloseToken -> (gen_pattern_cons_nodes acc exp head_strictness,pState)
-> (gen_pattern_cons_nodes acc exp head_strictness,pState) | token=:ExclamationToken && head_strictness<>HeadOverloaded
| token=:ExclamationToken && head_strictness<>HeadOverloaded # pState = wantToken FunctionContext "list" SquareCloseToken pState
# pState = wantToken FunctionContext "list" SquareCloseToken pState -> (gen_pattern_tail_strict_cons_nodes acc exp head_strictness,pState)
-> (gen_pattern_tail_strict_cons_nodes acc exp head_strictness,pState) | token=:ColonToken // to allow [1:2:[]] etc.
| token=:ColonToken // to allow [1:2:[]] etc. -> want_list [exp:acc] head_strictness (tokenBack pState)
-> want_list [exp:acc] (tokenBack pState) # pState = parseError "list" (Yes token) "] or :" pState
# pState = parseError "list" (Yes token) "] or :" pState -> (gen_pattern_cons_nodes acc exp head_strictness,pState)
-> (gen_pattern_cons_nodes acc exp head_strictness,pState) DotDotToken
DotDotToken -> (PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState)
-> (PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState) DoubleBackSlashToken
DoubleBackSlashToken -> (PE_Empty, parseError "want list expression" No "No \\\\ expression in a pattern" pState)
-> (PE_Empty, parseError "want list expression" No "No \\\\ expression in a pattern" pState) _
_ # nil_expr = makeNilExpression head_strictness cIsAPattern
# nil_expr = makeNilExpression head_strictness cIsAPattern pState = parseError "list" (Yes token) "list element separator" pState
pState = parseError "list" (Yes token) "list element separator" pState -> (gen_pattern_cons_nodes acc nil_expr head_strictness,pState)
-> (gen_pattern_cons_nodes acc nil_expr head_strictness,pState)
gen_pattern_cons_nodes [] exp head_strictness gen_pattern_cons_nodes [] exp head_strictness
= exp = exp
...@@ -4338,90 +4337,108 @@ wantListExp is_pattern pState ...@@ -4338,90 +4337,108 @@ wantListExp is_pattern pState
_ _
-> want_LGraphExpr token [] head_strictness pState -> want_LGraphExpr token [] head_strictness pState
= want_LGraphExpr token [] head_strictness pState = want_LGraphExpr token [] head_strictness pState
where where
want_LGraphExpr token acc head_strictness pState want_LGraphExpr (CharListToken chars) acc head_strictness pState
= case token of = want_list (add_chars (fromString chars) acc) head_strictness pState
CharListToken chars want_LGraphExpr token acc head_strictness pState
-> want_list (add_chars (fromString chars) acc) pState # (exp, pState) = (if is_pattern (wantPatternT token) (wantExpressionT token)) pState
_ # (exp, pState) = (if is_pattern (wantPatternT token) (wantExpressionT token)) pState = want_list [exp: acc] head_strictness pState
-> want_list [exp: acc] pState
where want_list acc head_strictness pState
want_list acc pState # (token, pState) = nextToken FunctionContext pState
# (token, pState) = nextToken FunctionContext pState = case token of
= case token of SquareCloseToken
SquareCloseToken # nil_expr = makeNilExpression head_strictness is_pattern
# nil_expr = makeNilExpression head_strictness is_pattern -> (gen_cons_nodes acc nil_expr,pState)
-> (gen_cons_nodes acc nil_expr,pState) ExclamationToken
ExclamationToken | head_strictness<>HeadOverloaded
# (token, pState) = nextToken FunctionContext pState
| token=:SquareCloseToken
# nil_expr = makeTailStrictNilExpression head_strictness is_pattern
-> (gen_tail_strict_cons_nodes acc nil_expr,pState)
-> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState)
CommaToken
# (token, pState) = nextToken FunctionContext pState
-> want_LGraphExpr token acc head_strictness pState
ColonToken
# (exp, pState) = wantExpressionOrPattern is_pattern pState
# (token,pState) = nextToken FunctionContext pState
| token=:SquareCloseToken
-> (gen_cons_nodes acc exp,pState)
| token=:ExclamationToken && head_strictness<>HeadOverloaded
# pState = wantToken FunctionContext "list" SquareCloseToken pState
-> (gen_tail_strict_cons_nodes acc exp,pState)
| token=:ColonToken // to allow [1:2:[]] etc.
-> want_list [exp:acc] head_strictness (tokenBack pState)
# pState = parseError "list" (Yes token) "] or :" pState
-> (gen_cons_nodes acc exp,pState)
DotDotToken
| is_pattern
-> (PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState)
| length acc > 2 || isEmpty acc
# nil_expr = makeNilExpression head_strictness is_pattern
pState = parseError "list expression" No "one or two expressions before .." pState
-> (gen_cons_nodes acc nil_expr,pState)
# (token, pState) = nextToken FunctionContext pState
-> case token of
SquareCloseToken
-> case acc of
[e]
# pd_from_index =
if (head_strictness==HeadStrict) PD_FromS
(if (head_strictness==HeadUnboxed) PD_FromU
(if (head_strictness==HeadOverloaded) PD_FromO
PD_From))
-> (PE_Sequ (SQ_From pd_from_index e), pState)
[e2,e1]
# pd_from_then_index =
if (head_strictness==HeadStrict) PD_FromThenS
(if (head_strictness==HeadUnboxed) PD_FromThenU
(if (head_strictness==HeadOverloaded) PD_FromThenO
PD_FromThen))
-> (PE_Sequ (SQ_FromThen pd_from_then_index e1 e2), pState)
_ -> abort "Error 1 in WantListExp"
ExclamationToken
| head_strictness<>HeadOverloaded | head_strictness<>HeadOverloaded
# (token, pState) = nextToken FunctionContext pState # pState = wantToken FunctionContext "dot dot expression" SquareCloseToken pState
| token=:SquareCloseToken -> case acc of
# nil_expr = makeTailStrictNilExpression head_strictness is_pattern [e]
-> (gen_tail_strict_cons_nodes acc nil_expr,pState) # pd_from_index =
-> (PE_Empty,parseError "list" (Yes token) (toString SquareCloseToken) pState) if (head_strictness==HeadStrict) PD_FromSTS
CommaToken (if (head_strictness==HeadUnboxed) PD_FromUTS
# (token, pState) = nextToken FunctionContext pState PD_FromTS)
-> want_LGraphExpr token acc head_strictness pState -> (PE_Sequ (SQ_From pd_from_index e), pState)
ColonToken [e2,e1]
# (exp, pState) = wantExpressionOrPattern is_pattern pState # pd_from_then_index =
# (token,pState) = nextToken FunctionContext pState if (head_strictness==HeadStrict) PD_FromThenSTS
| token=:SquareCloseToken (if (head_strictness==HeadUnboxed) PD_FromThenUTS
-> (gen_cons_nodes acc exp,pState) PD_FromThenTS)
| token=:ExclamationToken && head_strictness<>HeadOverloaded -> (PE_Sequ (SQ_FromThen pd_from_then_index e1 e2), pState)
# pState = wantToken FunctionContext "list" SquareCloseToken pState _ -> abort "Error 2 in WantListExp"
-> (gen_tail_strict_cons_nodes acc exp,pState) _ # (exp, pState) = wantExpressionT token pState
| token=:ColonToken // to allow [1:2:[]] etc. # (token, pState) = nextToken FunctionContext pState
-> want_list [exp:acc] (tokenBack pState) -> case token of
# pState = parseError "list" (Yes token) "] or :" pState SquareCloseToken
-> (gen_cons_nodes acc exp,pState)
DotDotToken
| is_pattern
-> (PE_Empty, parseError "want list expression" No "No dot dot expression in a pattern" pState)
| length acc > 2 || isEmpty acc
# nil_expr = makeNilExpression head_strictness is_pattern
pState = parseError "list expression" No "one or two expressions before .." pState
-> (gen_cons_nodes acc nil_expr,pState)
# (token, pState) = nextToken FunctionContext pState
-> case token of
SquareCloseToken
-> case acc of -> case acc of
[e] [e]
# pd_from_index = # pd_from_to_index =
if (head_strictness==HeadStrict) PD_FromS if (head_strictness==HeadStrict) PD_FromToS
(if (head_strictness==HeadUnboxed) PD_FromU (if (head_strictness==HeadUnboxed) PD_FromToU
(if (head_strictness==HeadOverloaded) PD_FromO (if (head_strictness==HeadOverloaded) PD_FromToO
PD_From)) PD_FromTo))
-> (PE_Sequ (SQ_From pd_from_index e), pState) -> (PE_Sequ (SQ_FromTo pd_from_to_index e exp), pState)
[e2,e1] [e2,e1]
# pd_from_then_index = # pd_from_then_to_index =
if (head_strictness==HeadStrict) PD_FromThenS if (head_strictness==HeadStrict) PD_FromThenToS
(if (head_strictness==HeadUnboxed) PD_FromThenU (if (head_strictness==HeadUnboxed) PD_FromThenToU
(if (head_strictness==HeadOverloaded) PD_FromThenO (if (head_strictness==HeadOverloaded) PD_FromThenToO
PD_FromThen)) PD_FromThenTo))
-> (PE_Sequ (SQ_FromThen pd_from_then_index e1 e2), pState) -> (PE_Sequ (SQ_FromThenTo pd_from_then_to_index e1 e2 exp), pState)
_ -> abort "Error 1 in WantListExp" _ -> abort "Error 3 in WantListExp"
ExclamationToken ExclamationToken
| head_strictness<>HeadOverloaded | head_strictness<>HeadOverloaded
# pState = wantToken FunctionContext "dot dot expression" SquareCloseToken pState # pState = wantToken FunctionContext "dot dot expression" SquareCloseToken pState
-> case acc of -> case acc of
[e]
# pd_from_index =
if (head_strictness==HeadStrict) PD_FromSTS
(if (head_strictness==HeadUnboxed) PD_FromUTS
PD_FromTS)
-> (PE_Sequ (SQ_From pd_from_index e), pState)
[e2,e1]
# pd_from_then_index =
if (head_strictness==HeadStrict) PD_FromThenSTS
(if (head_strictness==HeadUnboxed) PD_FromThenUTS
PD_FromThenTS)
-> (PE_Sequ (SQ_FromThen pd_from_then_index e1 e2), pState)
_ -> abort "Error 2 in WantListExp"
_ # (exp, pState) = wantExpressionT token pState
# (token, pState) = nextToken FunctionContext pState
-> case token of
SquareCloseToken
-> case acc of
[e] [e]
# pd_from_to_index = # pd_from_to_index =
if (head_strictness==HeadStrict) PD_FromToS if (head_strictness==HeadStrict) PD_FromToS
...@@ -4431,67 +4448,49 @@ wantListExp is_pattern pState ...@@ -4431,67 +4448,49 @@ wantListExp is_pattern pState
-> (PE_Sequ (SQ_FromTo pd_from_to_index e exp), pState) -> (PE_Sequ (SQ_FromTo pd_from_to_index e exp), pState)
[e2,e1] [e2,e1]
# pd_from_then_to_index = # pd_from_then_to_index =
if (head_strictness==HeadStrict) PD_FromThenToS if (head_strictness==HeadStrict) PD_FromThenToSTS
(if (head_strictness==HeadUnboxed) PD_FromThenToU (if (head_strictness==HeadUnboxed) PD_FromThenToUTS
(if (head_strictness==HeadOverloaded) PD_FromThenToO PD_FromThenToTS)
PD_FromThenTo))
-> (PE_Sequ (SQ_FromThenTo pd_from_then_to_index e1 e2 exp), pState) -> (PE_Sequ (SQ_FromThenTo pd_from_then_to_index e1 e2 exp), pState)
_ -> abort "Error 3 in WantListExp" _ -> abort "Error 4 in WantListExp"
ExclamationToken _
| head_strictness<>HeadOverloaded -> (PE_Empty, parseError "dot dot expression" (Yes token) "] or !]" pState)
# pState = wantToken FunctionContext "dot dot expression" SquareCloseToken pState DoubleBackSlashToken
-> case acc of | is_pattern
[e] -> (PE_Empty, parseError "want list expression" No "No \\\\ expression in a pattern" pState)
# pd_from_to_index = | length acc == 1
if (head_strictness==HeadStrict) PD_FromToSTS -> wantListComprehension head_strictness (acc!!0) pState
(if (head_strictness==HeadUnboxed) PD_FromToUTS // otherwise // length acc <> 1
PD_FromToTS) # nil_expr = makeNilExpression head_strictness is_pattern
-> (PE_Sequ (SQ_FromTo pd_from_to_index e exp), pState) pState = parseError "list comprehension" No "one expressions before \\\\" pState
[e2,e1] -> (gen_cons_nodes acc nil_expr,pState)
# pd_from_then_to_index = _ # nil_expr = makeNilExpression head_strictness is_pattern
if (head_strictness==HeadStrict) PD_FromThenToSTS pState = parseError "list" (Yes token) "list element separator" pState
(if (head_strictness==HeadUnboxed) PD_FromThenToUTS -> (gen_cons_nodes acc nil_expr,pState)
PD_FromThenToTS) where
-> (PE_Sequ (SQ_FromThenTo pd_from_then_to_index e1 e2 exp), pState) gen_cons_nodes [] exp
_ -> abort "Error 4 in WantListExp" = exp
_ gen_cons_nodes l exp
-> (PE_Empty, parseError "dot dot expression" (Yes token) "] or !]" pState) = gen_cons_nodes l exp
DoubleBackSlashToken where
| is_pattern cons_ident_exp = makeConsIdentExpression head_strictness is_pattern
-> (PE_Empty, parseError "want list expression" No "No \\\\ expression in a pattern" pState)
| length acc == 1 gen_cons_nodes [e:r] exp
-> wantListComprehension head_strictness (acc!!0) pState = gen_cons_nodes r (PE_List [cons_ident_exp,e,exp])
// otherwise // length acc <> 1
# nil_expr = makeNilExpression head_strictness is_pattern
pState = parseError "list comprehension" No "one expressions before \\\\" pState
-> (gen_cons_nodes acc nil_expr,pState)
_ # nil_expr = makeNilExpression head_strictness is_pattern
pState = parseError "list" (Yes token) "list element separator" pState
-> (gen_cons_nodes acc nil_expr,pState)
gen_cons_nodes [] exp gen_cons_nodes [] exp
= exp = exp
gen_cons_nodes l exp
= gen_cons_nodes l exp
where
cons_ident_exp = makeConsIdentExpression head_strictness is_pattern
gen_cons_nodes [e:r] exp
= gen_cons_nodes r (PE_List [cons_ident_exp,e,exp])
gen_cons_nodes [] exp
= exp
gen_tail_strict_cons_nodes [] exp
= exp
gen_tail_strict_cons_nodes r exp
= gen_tail_strict_cons_nodes r exp
where
tail_strict_cons_ident_exp = makeTailStrictConsIdentExpression head_strictness is_pattern
gen_tail_strict_cons_nodes [e:r] exp
= gen_tail_strict_cons_nodes r (PE_List [tail_strict_cons_ident_exp,e,exp])
gen_tail_strict_cons_nodes [] exp gen_tail_strict_cons_nodes [] exp
= exp = exp
gen_tail_strict_cons_nodes r exp
= gen_tail_strict_cons_nodes r exp
where
tail_strict_cons_ident_exp = makeTailStrictConsIdentExpression head_strictness is_pattern
gen_tail_strict_cons_nodes [e:r] exp
= gen_tail_strict_cons_nodes r (PE_List [tail_strict_cons_ident_exp,e,exp])
gen_tail_strict_cons_nodes [] exp
= exp
want_head_strictness :: Token *ParseState -> *(!Int,!Token,!*ParseState) want_head_strictness :: Token *ParseState -> *(!Int,!Token,!*ParseState)
want_head_strictness ExclamationToken pState want_head_strictness ExclamationToken pState
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment