allow multiple tags inside control and top-level opers

This commit is contained in:
Krasimir Angelov
2025-06-06 06:21:32 +00:00
parent 21b44e3c55
commit 04639d2c6b
+24 -11
View File
@@ -275,10 +275,10 @@ ParamDef
OperDef :: { [(Ident,Info)] }
OperDef
: Posn LhsNames ':' Exp ';' Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $6 $4)) Nothing ] }
| Posn LhsNames '=' Markup Posn { [(i, info) | i <- $2, info <- mkOverload Nothing (Just (mkL $1 $5 $4))] }
| Posn LhsName ListArg '=' Markup Posn { [(i, info) | i <- [$2], info <- mkOverload Nothing (Just (mkL $1 $6 (mkAbs $3 $5)))] }
| Posn LhsNames ':' Exp '=' Markup Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $7 $4)) (Just (mkL $1 $7 $6))] }
: Posn LhsNames ':' Exp ';' Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $6 $4)) Nothing ] }
| Posn LhsNames '=' Exp ';' Posn { [(i, info) | i <- $2, info <- mkOverload Nothing (Just (mkL $1 $6 $4))] }
| Posn LhsName ListArg '=' Exp ';' Posn { [(i, info) | i <- [$2], info <- mkOverload Nothing (Just (mkL $1 $7 (mkAbs $3 $5)))] }
| Posn LhsNames ':' Exp '=' Exp ';' Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $8 $4)) (Just (mkL $1 $8 $6))] }
LinDef :: { [(Ident,Info)] }
LinDef
@@ -487,8 +487,7 @@ Exp6
| '{' ListLocDef '}' {% mkR $2 }
| '<' ListTupleComp '>' { R (tuple2record $2) }
| '<' Exp ':' Exp '>' { Typed $2 $4 }
| '[' Control '|' Tag ']' { Reset (fst $2) (snd $2) $4 Nothing }
| '[' Control '|' Exp ']' { Reset (fst $2) (snd $2) $4 Nothing }
| '[' Control '|' ListMarkup ']' { Reset (fst $2) (snd $2) (mkMarkup $4) Nothing }
| '(' Exp ')' { $2 }
ListExp :: { [Term] }
@@ -720,14 +719,21 @@ ERHS3 :: { ERHS }
| '(' ERHS0 ')' { $2 }
NLG :: { Map.Map Ident Info }
: ListNLGDef { Map.fromList $1 }
| Posn Tag Posn { Map.singleton (identS "main") (ResOper Nothing (Just (mkL $1 $3 $2))) }
| Posn Exp Posn { Map.singleton (identS "main") (ResOper Nothing (Just (mkL $1 $3 $2))) }
: ListNLGDef { Map.fromList $1 }
| Posn Exp Posn { Map.singleton (identS "main") (ResOper Nothing (Just (mkL $1 $3 $2))) }
| Posn ListMarkup2 Posn { Map.singleton (identS "main") (ResOper Nothing (Just (mkL $1 $3 (mkMarkup $2)))) }
ListNLGDef :: { [(Ident,Info)] }
ListNLGDef
: {- empty -} { [] }
| 'oper' OperDef ListNLGDef { $2 ++ $3 }
: 'oper' NLGDef { [] }
| 'oper' NLGDef ListNLGDef { $2 ++ $3 }
NLGDef :: { [(Ident,Info)] }
NLGDef
: Posn LhsNames ':' Exp ';' Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $6 $4)) Nothing ] }
| Posn LhsNames '=' ListMarkup2 Posn { [(i, info) | i <- $2, info <- mkOverload Nothing (Just (mkL $1 $5 (mkMarkup $4)))] }
| Posn LhsName ListArg '=' ListMarkup2 Posn { [(i, info) | i <- [$2], info <- mkOverload Nothing (Just (mkL $1 $6 (mkAbs $3 (mkMarkup $5))))] }
| Posn LhsNames ':' Exp '=' ListMarkup2 Posn { [(i, info) | i <- $2, info <- mkOverload (Just (mkL $1 $7 $4)) (Just (mkL $1 $7 (mkMarkup $6)))] }
Markup :: { Term }
Markup
@@ -746,6 +752,10 @@ ListMarkup :: { [Term] }
| Exp { [$1] }
| Markup ListMarkup { $1 : $2 }
ListMarkup2 :: { [Term] }
: Markup { [$1] }
| Markup ListMarkup2 { $1 : $2 }
Control :: { (Ident,Maybe Term) }
: Ident { ($1, Nothing) }
| Ident ':' Exp6 { ($1, Just $3) }
@@ -884,4 +894,7 @@ mkAlts cs = case cs of
mkL :: Posn -> Posn -> x -> L x
mkL (Pn l1 _) (Pn l2 _) x = L (Local l1 l2) x
mkMarkup [t] = t
mkMarkup ts = Markup identW [] ts
}