diff --git a/frege/compiler/Classes.fr b/frege/compiler/Classes.fr index 4c7a14bf..f78a4aad 100644 --- a/frege/compiler/Classes.fr +++ b/frege/compiler/Classes.fr @@ -45,6 +45,8 @@ import Data.TreeMap as TM(keys, values, TreeMap, insert, delete, lookup) import Data.List as DL(uniq, sort, sortBy, maximumBy) import Data.Graph (stronglyConnectedComponents tsort) +import frege.compiler.common.Lens (over, preview, set) + import Compiler.enums.Flags as Compilerflags(TRACE6) import Compiler.enums.Visibility import Compiler.enums.SymState @@ -52,7 +54,6 @@ import Compiler.enums.SymState import Compiler.types.Positions(Position) import Compiler.types.QNames import Compiler.types.Types --- import Compiler.common.Types as TH(tauRho) import Compiler.types.Expression import Compiler.types.Symbols import Compiler.types.Global as G @@ -80,21 +81,23 @@ post = stio true {-- * look through list of 'Symbol's and note name and direct superclasses for each class -} -classDeps syms g = [ (c.name, c.supers) | c@SymC {pos} <- syms ] +classDeps :: [SymC Global] -> Global -> [(QName, [QName])] +classDeps syms g = [ (c.name, c.supers) | c <- syms ] --- will loop on mutually recursive classes -superclasses (c@SymC {supers}) g = (uniq • sort) (supers ++ +superclasses (SymbolT.C SymC{supers}) g = (uniq . sort) (supers ++ [ supsup | sup <- supers, csym <- (Global.findit g sup).toList, -- Symbol.name csym `notElem` supers, -- ??? supsup <- superclasses csym g ]) -superclasses _ g = [] -- error will be diagnosed later +superclasses _ _ = [] -- error will be diagnosed later {-- * collect all known classes -} +allClasses :: StG [SymC Global] allClasses = do g <- getST - stio [ c | env <- values g.packages, c@SymC {pos} <- values env ] + stio [ c | env <- values g.packages, SymbolT.C c <- values env ] {-- * handle classes @@ -115,9 +118,9 @@ passC = do deporder :: QName -> StG () deporder clas = do symc <- U.findC clas - let allsups = superclasses symc g + let allsups = superclasses (SymbolT.C symc) g newsups = [ s | s <- ordered, s `elem` allsups ] - changeSym symc.{supers=newsups} + changeSym $ SymbolT.C symc.{supers=newsups} E.logmsg TRACE6 symc.pos (text (nice symc g ++ " superclasses " ++ show (map (flip nice g) newsups))) -- foreach classdeps trace1 @@ -138,29 +141,29 @@ passC = do complete qcls = do g <- getST case g.find qcls of - Just (symc@SymC {pos}) -> do - superkind <- foldM (superKind symc) symc.tau.kind [sym | + Just (SymbolT.C symc) -> do + superkind <- foldM (superKind symc) symc.clvar.kind [sym | qn <- symc.supers, sym <- g.findit qn ] - kind <- foldM (sigmaKind symc.tau.var) superkind [ sym | - (sym@SymV {typ,anno,nativ}) <- values symc.env, + kind <- foldM (sigmaKind symc.clvar.var) superkind [ sym.toSymbol | + (sym@(SymMeth.V SymV{typ,anno,nativ})) <- values symc.meth, anno || isJust nativ, not (isPSigma typ), ] let newkind = if kind `keq` KVar then KType else kind - symc <- U.findC symc.name - changeSym symc.{tau <- Tau.{kind = newkind}} -- update class var + symc <- U.findC symc.name + changeSym $ SymbolT.C symc.{clvar <- _.{kind=newkind}} -- update class var symc <- U.findC symc.name foreach symc.supers (supercheck symc) - foreach (values symc.env) (methodcheck symc) + foreach (values symc.meth) (methodcheck symc) nothing -> E.fatal Position.null (text ("lost class " ++ QName.nice qcls g)) - superKind symc ka (supb@SymC{}) = do - case K.unifyKind ka supb.tau.kind of + superKind symc ka (SymbolT.C supb) = do + case K.unifyKind ka supb.clvar.kind of Just k -> return k Nothing -> do g <- getST - E.error (symc.pos.merge symc.tau.getpos) ( + E.error (symc.pos.merge symc.clvar.getpos) ( text "kind error: it looks like" <+> text (nicer symc g) <+> text "should have kind" @@ -169,13 +172,13 @@ passC = do text "but superclass" <+> text (nicer supb.name g) <+> text "demands" - <+> text (show supb.tau.kind) + <+> text (show supb.clvar.kind) )) return ka superKind _ k _ = return k - sigmaKind var kind (sym@SymV {}) = do + sigmaKind var kind (SymbolT.V sym) = do (sig, _) <- K.kiSigmaC var kind sym.typ - changeSym sym.{typ = sig} + changeSym $ SymbolT.V sym.{typ = sig} let -- t = TreeMap.fromList sig.bound ok = _.kind <$> DL.find ((var==) . _.var) sig.bound case ok of @@ -194,17 +197,17 @@ passC = do return kind Nothing -> return kind -- no class var? will be flagged later sigmaKind _ _ _ = error "sigmaKind: no SymV" - - - methodcheck symc (msym@SymV {pos}) = do + + methodcheck :: SymC Global -> SymMeth Global -> StG () + methodcheck symc (SymMeth.V (msym@SymV {pos})) = do g <- getST - let jprevs = [ g.findit (MName sup msym.name.base) | sup <- Symbol.supers symc ] - xprevs = [ p | Just p <- jprevs, p.{anno?}, p.anno || isJust p.nativ] + let jprevs = [ g.findit (MName sup msym.name.base) | sup <- symc.supers ] + xprevs = [ symv | Just (SymbolT.V symv) <- jprevs, symv.anno || isJust symv.nativ ] prevs = if null xprevs then [] else [maximumBy first xprevs] first SymV{name=MName c1 _} SymV{name=MName c2 _} - | Just sym1 <- g.findit c1 - , Just sym2 <- g.findit c2 + | Just (SymbolT.C sym1) <- g.findit c1 + , Just (SymbolT.C sym2) <- g.findit c2 = if sym1.name `elem` sym2.supers then Lt else if sym2.name `elem` sym1.supers then Gt else Eq @@ -213,7 +216,7 @@ passC = do case prevs of [] -> if msym.anno || isJust msym.nativ -- new method then do - checkanno symc msym + checkanno (SymbolT.C symc) (SymbolT.V msym) checklink msym -- global link must point to us else E.error msym.pos (msgdoc ("class member " ++ msym.name.base ++ " must be annotated")) @@ -221,36 +224,32 @@ passC = do when (msym.anno && isNothing msym.nativ) do E.error msym.pos (msgdoc ("class member " ++ msym.name.base ++ " must not be annotated.")) when (isJust msym.nativ) do - T.subsCheck msym msym.typ osym.typ + T.subsCheck (SymbolT.V msym) msym.typ osym.typ case g.findit osym.name.tynm of - Just (ssym@SymC {pos}) -> do - mkanno symc msym osym ssym - return () + Just (SymbolT.C ssym) -> do + memtyp <- mkanno symc msym.pos osym ssym + changeSym $ SymbolT.V msym.{typ = memtyp, anno = true} nothing -> E.fatal pos (text ("methodcheck: class " ++ osym.name.tynm.nice g ++ " vanished.")) _ -> E.fatal pos (text (msym.name.nice g ++ " occurs in more than one super class of " ++ symc.name.nice g)) - methodcheck symc (msym@SymL{pos}) = do + methodcheck symc (SymMeth.L (msym@SymL{pos})) = do g <- getST - let jprevs = [ g.findit (MName sup msym.name.base) | sup <- Symbol.supers symc ] - prevs = [ p | Just p <- jprevs, Symbol.{anno?} p, Symbol.anno p ] + let jprevs = [ g.findit (MName sup msym.name.base) | sup <- symc.supers ] + prevs = [ p | Just (SymbolT.V p) <- jprevs, p.anno ] case prevs of [] -> E.error pos (msgdoc ("new class operation `" ++ msym.name.base ++ "` must not be an alias.")) - [osym] | Just ali <- g.findit msym.alias, - SymV{anno=true} <- ali, + [osym] | Just (SymbolT.V ali) <- g.findit msym.alias, + ali.anno, -- symc.name == same, - Just ssym <- g.findit osym.name.tynm, - SymC{} <- ssym = do - sig <- mkanno symc msym osym ssym - T.subsCheck ali ali.typ sig + Just (SymbolT.C ssym) <- g.findit osym.name.tynm -> do + sig <- mkanno symc msym.pos osym ssym + T.subsCheck (SymbolT.V ali) ali.typ sig | otherwise = E.error pos (msgdoc (nicer msym g ++ " may only point to a value whose type is known through annotation or import.")) _ -> E.fatal pos (text (msym.name.nice g ++ " occurs in more than one super class of " ++ symc.name.nice g)) - methodcheck symc other = do - g <- getST - E.error other.pos (text (other.nice g ++ " not allowed in " ++ symc.nice g)) {- mkanno class method supermethod superclass * replace forall c . Super c => c -> t * with forall t.This t => t -> n @@ -258,45 +257,42 @@ passC = do * t is the class variable of this class and n is a new name * that replaces accidental occurrences of t in the annotation of the super method -} - mkanno :: Symbol -> Symbol -> Symbol -> Symbol -> StG Sigma - mkanno csym msym osym ssym = do + mkanno :: SymC Global -> Position -> SymV Global -> SymC Global -> StG Sigma + mkanno csym mpos osym ssym = do g <- getST i <- uniqid - let newvar = TVar {pos=msym.pos, var=noClashIdent ("t" ++ show i), kind = KVar} - oldvar = ssym.tau.var - thsvar = csym.tau.var - tree1 = TreeMap.insert empty oldvar csym.tau + let newvar = TVar {pos=mpos, var=noClashIdent ("t" ++ show i), kind = KVar} + oldvar = ssym.clvar.var + thsvar = csym.clvar.var + tree1 = TreeMap.insert empty oldvar csym.clvar tree | oldvar != thsvar = tree1.insert thsvar newvar | otherwise = tree1 case isPSigma osym.typ of false -> do let - rho1 = substRho tree osym.typ.rho - rep (ctx@Ctx {cname, tau = TVar {var=x}}) - | cname == ssym.name, x == thsvar = ctx.{pos=msym.pos, cname=csym.name} + rho1 = substRho (fmap TauT.Var tree) osym.typ.rho + rep (ctx@Ctx {cname, tau=TauT.Var TVar{var=x}}) + | cname == ssym.name, x == thsvar = ctx.{pos=mpos, cname=csym.name} rep ctx = ctx - rho = rho1.{context <- map rep} + rho = over RhoT._context (map rep) rho1 repv tv = TM.lookupDefault tv tv.var tree memtyp = ForAll (map repv osym.typ.bound) rho - when msym.{typ?} do - changeSym msym.{typ = memtyp, anno=true} - return memtyp + pure memtyp true -> E.fatal osym.pos (text ("mkanno:: untyped " ++ osym.nice g)) - -- return U.pSigma checklink (symm@SymV {name=MName cls base}) = do g <- getST let glob = VName g.thisPack base case g.findit glob of - Just (v@(SymV {name=MName c b})) + Just (v@(SymbolT.V (SymV{name=MName c b}))) | c == cls, b == base = stio () | b != base = E.fatal symm.pos (text ("checklink: " ++ glob.nice g ++ " finds " ++ v.nice g)) | U.isSuper cls g c = case g.find glob of -- this can happen if subclass is defined before the base class -- we correct it here silently - Just (s@(SymL {pos})) -> changeSym s.{alias=symm.name} + Just (SymbolT.L s) -> changeSym $ SymbolT.L s.{alias=symm.name} Just s -> E.fatal s.pos (text ("checklink: " ++ s.nice g ++ " should be a link")) Nothing -> E.fatal v.pos (text ("checklink: " ++ glob.nice g ++ "findit is " ++ v.nice g ++ " but find is Nothing")) @@ -310,10 +306,10 @@ passC = do checklink sym = do g <- getST E.fatal sym.pos (text ("checklink: " ++ sym.nice g)) - checkanno (symc@SymC {tau=TVar {var}}) (msym@SymV {typ=ForAll bound rho}) = do + checkanno (SymbolT.C (symc@SymC {clvar=TVar{var}})) (SymbolT.V (msym@SymV {typ=ForAll bound rho})) = do let check1 = var `elem` map _.var bound - check2 = var `notElem` [ var | Ctx {tau=TVar {var}} <- rho.context ] - thisctx = Ctx msym.pos symc.name symc.tau + check2 = var `notElem` [ var | Ctx {tau=TauT.Var TVar{var}} <- rho.context ] + thisctx = Ctx msym.pos symc.name (TauT.Var symc.clvar) unless (check1) do E.error msym.pos (msgdoc ("class variable " ++ var ++ " does not occur in type of class member " @@ -324,16 +320,16 @@ passC = do ++ msym.name.base)) -- construct new type for class member -- == :: e -> e -> Bool => forall e.Eq e => e -> e -> Bool - changeSym msym.{typ =ForAll bound rho.{context <- (thisctx:)}} + changeSym $ SymbolT.V msym.{typ=ForAll{bound, rho = over RhoT._context (thisctx:) rho}} checkanno sym1 sym2 = do g <- getST - E.fatal (Symbol.pos sym2) (text ("checkanno (" ++ sym1.nice g + E.fatal sym2.pos (text ("checkanno (" ++ sym1.nice g ++ ") (" ++ sym2.nice g ++ ")")) - supercheck :: Symbol -> QName -> StG () + supercheck :: SymC Global -> QName -> StG () supercheck symc qn = do g <- getST case g.find qn of - Just (sup@SymC {pos}) -> return () + Just (SymbolT.C _) -> return () _ -> E.error symc.pos (msgdoc (QName.nice qn g ++ " cannot be a superclass of " ++ symc.name.nice g ++ " as it is not a class.")) @@ -346,7 +342,7 @@ passC = do err1 tns = do g <- getST case g.findit (head tns) of - Just (SymC {pos}) -> E.error pos (msgdoc ("cyclic superclass relation for classes " + Just (SymbolT.C SymC{pos}) -> E.error pos (msgdoc ("cyclic superclass relation for classes " ++ joined ", " (map (flip QName.nice g) tns))) nothing -> E.fatal Position.null (text ("lost class " ++ QName.nice (head tns) g)) @@ -368,7 +364,7 @@ alienInstsForClass c = do E.logmsg TRACE6 csym.pos (text ("alien instances for " ++ QName.nice c g)) let insts = -- (map Symbol.name • sortBy (descending (Position.start • Symbol.pos))) [ ins.name | env <- values g.packages, - ins@SymI {pos} <- values env, + SymbolT.I ins <- values env, ins.clas == c || ins.clas == csym.name] foreach insts (instForClass true c) -- foreach insts (checkTypeAgainst true c) @@ -378,7 +374,7 @@ instsForClass c = do g <- getST csym <- U.findC c E.logmsg TRACE6 csym.pos (text ("instances for " ++ QName.nice c g)) - let insts = [ ins.name | ins@SymI {pos} <- values g.thisTab, + let insts = [ ins.name | SymbolT.I ins <- values g.thisTab, ins.clas == c || ins.clas == csym.name] foreach insts (instForClass false c) -- foreach insts (checkTypeAgainst c) @@ -387,16 +383,16 @@ instsForClass c = do instForClass alien c iname = do g <- getST csym <- U.findC c - + when (not alien) do -- check if class kind matches isym <- U.findI iname - (sig, ki) <- K.kiSigmaX isym.typ csym.tau.kind - changeSym isym.{typ=sig} - - isym <- U.findI iname - case instTSym (Symbol.typ isym) g of - Just (tsym@SymT {pos}) -> do - E.logmsg TRACE6 (Symbol.pos isym) (text (isym.nice g ++ " " ++ tsym.nice g)) + (sig, ki) <- K.kiSigmaX isym.typ csym.clvar.kind + changeSym $ SymbolT.I isym.{typ=sig} + + isym <- U.findI iname + case instTSym isym.typ g of + Just tsym -> do + E.logmsg TRACE6 isym.pos (text (isym.nice g ++ " " ++ tsym.nice g)) when (not alien || g.our isym.name) do foreach (reverse csym.supers) (checkSuperInstance isym.name tsym.name csym.name) @@ -406,7 +402,7 @@ instForClass alien c iname = do csyms <- mapSt U.findC (csym.name:csym.supers) isym <- U.findI isym.name when (not alien || g.our isym.name) do tcInstMethods csyms isym - mu -> E.fatal isym.pos (text ("instForClass: bad instance type " ++ isym.typ.nice g)) + Nothing -> E.fatal isym.pos (text ("instForClass: bad instance type " ++ isym.typ.nice g)) {-- When we have @@ -432,20 +428,20 @@ checkSuperInstance iname tname cname bname = do ssym <- U.findI sinst -- this is the super instance let msg = "instance " ++ cname.nicer g ++ " " ++ isym.typ.rho.nicer g ++ " has a super instance " ++ bname.nicer g ++ " " ++ ssym.typ.rho.nicer g - E.logmsg TRACE6 (Symbol.pos isym) (text msg) + E.logmsg TRACE6 isym.pos (text msg) baserho <- T.instantiate ssym.typ let msg = "base rho is " ++ baserho.nicer g - E.logmsg TRACE6 (Symbol.pos isym) (text msg) + E.logmsg TRACE6 isym.pos (text msg) thisrho <- T.instantiate isym.typ let msg = "this rho is " ++ thisrho.nicer g - E.logmsg TRACE6 (Symbol.pos isym) (text msg) + E.logmsg TRACE6 isym.pos (text msg) - T.subsCheckRR isym baserho thisrho + T.subsCheckRR (SymbolT.I isym) baserho thisrho let msg1 = "base rho is " ++ baserho.nicer g let msg2 = "this rho is " ++ thisrho.nicer g - E.logmsg TRACE6 (Symbol.pos isym) (text (msg1 ++ " " ++ msg2)) + E.logmsg TRACE6 isym.pos (text (msg1 ++ " " ++ msg2)) g <- getST let ctx1 = T.reducedCtxs g baserho.context @@ -463,10 +459,10 @@ checkSuperInstance iname tname cname bname = do <+/> (text "instance" <+> msg3) msg2 = text (nicerctx isym.typ.rho.context g) <> text (cname.nicer g) - <+> (text "(" <> text (isym.typ.rho.{context=[]}.nicer g) <> text ")") + <+> (text "(" <> text ((set RhoT._context [] isym.typ.rho).nicer g) <> text ")") msg3 = text (nicerctx ssym.typ.rho.context g) <> text (bname.nicer g) - <+> (text "(" <> text (ssym.typ.rho.{context=[]}.nicer g) <> text ")") + <+> (text "(" <> text ((set RhoT._context [] ssym.typ.rho).nicer g) <> text ")") E.error isym.pos msg [] -> return () _ -> return () @@ -481,28 +477,28 @@ instForThisClass iname tname cname = do let previ = case filter ((tname ==) • fst) csym.insts of ((_,inst):_) -> Just inst _ -> Nothing - E.logmsg TRACE6 (Symbol.pos isym) (text ("this inst: " ++ show iname ++ ", prev inst: " ++ show previ)) + E.logmsg TRACE6 isym.pos (text ("this inst: " ++ show iname ++ ", prev inst: " ++ show previ)) case previ of Just oldinst | oldinst != iname = do iold <- U.findI oldinst when (iold.clas == isym.clas) do - U.symWarning E.warn isym (msgdoc (tsym.nice g ++ " is already an instance of " + U.symWarning E.warn (SymbolT.I isym) (msgdoc (tsym.nice g ++ " is already an instance of " ++ csym.nice g ++ " (" ++ oldinst.nice g ++ " introduced on line " ++ show iold.pos ++ ")")) stio () | otherwise = do - E.logmsg TRACE6 (Symbol.pos isym) (text ("refresh " ++ tname.nice g + E.logmsg TRACE6 isym.pos (text ("refresh " ++ tname.nice g ++ " instance of " ++ csym.nice g)) - foreach (map Symbol.name (values (Symbol.env csym))) + foreach (map (_.name) (values csym.meth)) (funForCIT cname iname tname) stio () Nothing -> do - E.logmsg TRACE6 (Symbol.pos isym) (text ("make " ++ tname.nice g + E.logmsg TRACE6 isym.pos (text ("make " ++ tname.nice g ++ " an instance of " ++ csym.nice g)) - foreach (map Symbol.name (values (Symbol.env csym))) (funForCIT cname iname tname) + foreach (map (_.name) (values csym.meth)) (funForCIT cname iname tname) csym <- U.findC cname - changeSym csym.{insts <- ((tsym.name, iname):)} + changeSym $ SymbolT.C csym.{insts <- ((tsym.name, iname):)} --- check instance member function definition {-- @@ -531,13 +527,13 @@ funForCIT cname iname tname (mname@MName _ base) = do ++ ", inst: " ++ nicer iname g ++ ", type: " ++ nicer tname g ++ ", member: " ++ nicer mname g)) - let ivmb = isym.env.lookup mname.key + let ivmb = isym.meth.lookup mname.key tvmb = tsym.env.lookup mname.key -- implemented vsym = isJust (Symbol.expr vsym) || isJust (Symbol.nativ vsym) inherit xname = do mem <- U.findV xname E.logmsg TRACE6 isym.pos (text ("inheriting " ++ mem.nice g)) - if implemented mem + if implemented $ SymVal.V mem then do -- use default implementation mex <- U.maybeST mem.expr id mbx <- U.maybeST mex (U.copyExpr (Just isym.pos) empty) @@ -546,8 +542,8 @@ funForCIT cname iname tname (mname@MName _ base) = do typ = pSigma, anno = false, exported = false, state = Unchecked, sid = 0, doc = Just ("inherited from '" ++ xname.nicer g ++ "'")} - enter imem - linkq (MName tname base) imem + enter $ SymbolT.V imem + linkq (MName tname base) $ SymbolT.V imem else if g.our cname || mem.vis == Abstract then E.error isym.pos (msgdoc ("implementation of `" ++ (MName tname base).nice g ++ "` must be supplied.")) @@ -558,16 +554,16 @@ funForCIT cname iname tname (mname@MName _ base) = do sid = 0, doc = Just ("uses '" ++ xname.nicer g ++ "'"), expr = Just (return (Vbl isym.pos xname Nothing))} - enter imem - linkq (MName tname base) imem + enter $ SymbolT.V imem + linkq (MName tname base) $ SymbolT.V imem case ivmb of - Just (ivsym@SymV {name}) - | implemented ivsym || not (g.our iname) = case tvmb of - Just (tvsym@SymL {alias}) - | alias == name = changeSym ivsym.{op=msym.op} -- copy op + Just (SymMeth.V (ivsym@SymV{name})) + | implemented (SymVal.V ivsym) || not (g.our iname) = case tvmb of + Just (SymbolT.L (tvsym@SymL{alias})) + | alias == name = changeSym $ SymbolT.V ivsym.{op=msym.op} -- copy op | MName yname _ <- alias, - Just ysym <- g.findit yname = when (g.ourSym isym) do - U.symWarning E.hint ivsym (msgdoc ("There exists another implementation of `" + Just ysym <- g.findit yname = when (g.ourSym $ SymbolT.I isym) do + U.symWarning E.hint (SymbolT.V ivsym) (msgdoc ("There exists another implementation of `" ++ mname.base ++ "` for unrelated " ++ ysym.nicer g ++ ", this will make it impossible to access " ++ ivsym.nicer g @@ -579,101 +575,102 @@ funForCIT cname iname tname (mname@MName _ base) = do ++ " already exists.")) Nothing -> do E.logmsg TRACE6 ivsym.pos (text (mname.nice g ++ " not yet implemented in " ++ tsym.nice g)) - linkq (MName tname base) ivsym - changeSym ivsym.{op=msym.op} -- copy op + linkq (MName tname base) $ SymbolT.V ivsym + changeSym $ SymbolT.V ivsym.{op=msym.op} -- copy op | otherwise = E.error isym.pos (msgdoc ("implementation missing for " ++ ivsym.nice g)) - Just SymL{pos=ipos, name=member, alias} -- imported instance with links to type methods? + Just (SymMeth.L SymL{pos=ipos, name=member, alias}) -- imported instance with links to type methods? | not (g.our iname), alias.{tynm?}, alias.tynm == tname = stio () | otherwise = case g.findit alias of - Just symv | SymV{} <- symv, !symv.anno && !(maybe false (const true) symv.nativ) = do + Just symv' | SymbolT.V symv <- symv', not symv.anno && not (maybe false (const true) symv.nativ) = do E.error ipos (msgdoc ("function `" ++ nicer alias g ++ "` given as implementation of instance member `" ++ nicer member g ++ "` must be annotated.")) - changeSym isym.{ env <- delete member.key } - Just osym | not (g.ourSym osym) || implemented osym = case tvmb of - Just (tsym @ SymL{alias=same}) - | same == alias = changeSym osym.{op=msym.op} -- copy op + changeSym $ SymbolT.I isym.{ meth <- delete member.key } + Just osym' + | Just osym <- preview SymbolT._Val osym' + , not (g.ourSym osym.toSymbol) || implemented osym -> case tvmb of + Just (SymbolT.L (tsym@SymL{alias=same})) + | same == alias = changeSym $ SymVal.toSymbol $ set SymVal._op msym.op osym -- copy op | same == member = do -- this is the normal case after enter -- remove one indirection - changeSym tsym.{alias} - changeSym osym.{op=msym.op} + changeSym $ SymbolT.L tsym.{alias} + changeSym $ SymVal.toSymbol $ set SymVal._op msym.op osym Just err -> E.error ipos (msgdoc ("definition of " ++ member.nicer g ++ " not allowed because " ++ err.nicer g ++ " already exists.")) Nothing -> do E.logmsg TRACE6 ipos (text (mname.nice g ++ " not yet implemented in " ++ tsym.nice g)) - linkq (MName tname base) osym - changeSym osym.{op=msym.op} + linkq (MName tname base) osym.toSymbol + changeSym $ SymVal.toSymbol $ set SymVal._op msym.op osym Just osym -> E.error ipos (text (nicer osym g ++ " is not implemented.")) Nothing -> do E.fatal ipos (msgdoc (nicer member g ++ " links to " ++ alias.nicer g ++ ", but the latter doesn't exist.")) - Just osym -> E.fatal isym.pos (text ("expected instance member, found " ++ osym.nice g)) Nothing -> case tvmb of Nothing -> inherit mname - Just (tvsym@SymV {pos}) + Just (SymbolT.V tvsym) | tvsym.name.getpack != isym.name.getpack = do -- imported type that aready has the member. -- We just link to it. E.logmsg TRACE6 isym.pos (text (mname.nice g ++ " implemented in imported type.")) - linkq (MName iname base) tvsym - changeSym tvsym.{op=msym.op} - | implemented tvsym = do + linkq (MName iname base) $ SymbolT.V tvsym + changeSym $ SymbolT.V tvsym.{op=msym.op} + | implemented (SymVal.V tvsym) = do E.logmsg TRACE6 tvsym.pos (text (mname.nice g ++ " not yet implemented in " ++ isym.nice g)) let ivsym = tvsym.{name=MName iname base, sid = 0, op = msym.op} - enter ivsym - changeSym tsym.{ env <- delete mname.key } - linkq (MName tname base) ivsym + enter $ SymbolT.V ivsym + changeSym $ SymbolT.T tsym.{ env <- delete mname.key } + linkq (MName tname base) $ SymbolT.V ivsym | otherwise = E.error tvsym.pos (msgdoc ("implementation missing for " ++ tvsym.nice g)) - Just (ali@SymL {alias}) + Just (SymbolT.L (ali@SymL{alias})) | alias == mname || alias == MName isym.clas base = do -- link to class fun has been introduced earlier in 'enter' - changeSym tsym.{ env <- delete mname.key } + changeSym $ SymbolT.T tsym.{ env <- delete mname.key } inherit alias | MName yname _ <- alias, -- link to member of instance for super class? - Just (ysym@SymI {pos}) <- g.findit yname, + Just (SymbolT.I ysym) <- g.findit yname, ysym.clas `elem` csym.supers = stio () -- Issue 126: can be alias to type member | MName yname other ← alias, yname == tname, - Just impl <- g.follow ali = do - if implemented impl + Just impl <- preview SymbolT._Val =<< g.follow (SymbolT.L ali) = do + if implemented impl then do E.logmsg TRACE6 impl.pos (text (mname.nice g ++ " not yet implemented in " ++ isym.nice g)) E.logmsg TRACE6 isym.pos (text ("copy implementation from " ++ impl.nice g)) - let ivsym = impl.{name=MName iname base, sid = 0, op = msym.op} - enter ivsym - changeSym tsym.{ env <- delete other } - linkq (MName tname other) ivsym + let ivsym = set SymVal._name (MName iname base) $ set SymVal._sid 0 $ set SymVal._op msym.op $ impl + enter ivsym.toSymbol + changeSym $ SymbolT.T tsym.{ env <- delete other } + linkq (MName tname other) ivsym.toSymbol else do E.error impl.pos (msgdoc ("implementation missing for " ++ impl.nicer g)) | MName yname _ <- alias, - Just (ysym@SymI {pos}) <- g.findit yname, + Just (SymbolT.I ysym) <- g.findit yname, ysym.clas `notElem` csym.supers, - Just (vsym@SymV {nativ = Just _}) <- g.findit alias = do + Just (SymbolT.V (vsym@SymV{nativ = Just _})) <- g.findit alias = do -- allow recycling of native functions - U.symWarning E.hint isym (msgdoc ("implementation for " ++ mname.nice g + U.symWarning E.hint (SymbolT.I isym) (msgdoc ("implementation for " ++ mname.nice g ++ " taken from unrelated " ++ ysym.nice g)) - enter vsym.{name=MName isym.name base, sid = 0, op = msym.op} + enter $ SymbolT.V vsym.{name=MName isym.name base, sid = 0, op = msym.op} | MName yname _ <- alias, - Just (ysym@SymI {}) <- g.findit yname, + Just (SymbolT.I ysym) <- g.findit yname, ysym.sid == isym.sid = do -- this happens in IDE, when we have an instance for an imported type -- the link still points here, but the instance data got lost -- during rebuild of symbol table - changeSym tsym.{ env <- delete mname.key } + changeSym $ SymbolT.T tsym.{ env <- delete mname.key } inherit mname | MName yname _ <- alias, - Just (ysym@SymI {pos}) <- g.findit yname, + Just (SymbolT.I (ysym@SymI {pos})) <- g.findit yname, ysym.clas `notElem` csym.supers = do - let ysupers = [ s | SymC{supers} <- g.findit ysym.clas, s <- supers ] + let ysupers = [ s | SymbolT.C SymC{supers} <- g.findit ysym.clas, s <- supers ] sibling = cname `elem` ysupers unless sibling do E.error isym.pos (msgdoc (mname.nice g ++ " already implemented via unrelated " ++ ysym.nice g)) | MName ocname _ <- alias, - Just (ocsym@SymC {name}) <- g.findit ocname, + Just (ocsym@(SymbolT.C SymC{name})) <- g.findit ocname, name `notElem` csym.supers = do E.error isym.pos (msgdoc (mname.nice g ++ " already implemented via unrelated " @@ -690,40 +687,35 @@ funForCIT cname iname tname (mname@MName _ base) = do Just osym -> E.fatal osym.pos (text ("funForCIT: expected type member, found " ++ osym.nice g)) funForCIT cname iname tname mname = error "funForCIT: not a member" ---- check if 'Symbol' is an implemented function -implemented SymD{} = true -implemented vsym = isJust (Symbol.expr vsym) || isJust (Symbol.nativ vsym) +--- check if 'SymVal' is an implemented function +implemented :: SymVal Global -> Bool +implemented (SymVal.D _) = true +implemented (SymVal.V vsym) = isJust vsym.expr || isJust vsym.nativ {-- check for each method in an instance if the type is more specific than the class type -} -tcInstMethods :: [Symbol] -> Symbol -> StG () -tcInstMethods supers inst = foreach (values inst.env) (tcInstMethod supers inst) +tcInstMethods :: [SymC Global] -> SymI Global -> StG () +tcInstMethods supers inst = foreach (values inst.meth) (tcInstMethod supers inst) {-- check if the type of an instance method is more specific than the type of the class method -} -tcInstMethod :: [Symbol] -> Symbol -> Symbol -> StG () -tcInstMethod [] isym msym = do +tcInstMethod :: [SymC Global] -> SymI Global -> SymMeth Global -> StG () +tcInstMethod [] _ msym = do g <- getST E.error msym.pos (msgdoc (msym.nice g ++ " is not a class member function")) -tcInstMethod (sc:scs) isym msym - -- | SymL{} <- msym = do - -- g <- getST - -- case g.follow msym of - -- Just realmsym -> tcInstMethod (sc:scs) isym realmsym - -- Nothing -> E.fatal msym.pos (text (msym.nice g) <+> text " links nowhere.") - | msym.{typ?} || msym.{alias?} = do +tcInstMethod (sc:scs) isym msym = do g <- getST - case sc.env.lookupS msym.name.key of + case sc.meth.lookupS msym.name.key of Nothing -> tcInstMethod scs isym msym - Just (SymV {typ=(s@ForAll sbnd srho)}) | not (isPSigma s) = do + Just (SymMeth.V SymV{typ=(s@ForAll sbnd srho)}) | not (isPSigma s) = do g <- getST let !mtnice = case isPSigma sig of true -> "None"; false -> sig.nicer g - !csig = ForAll (filter ((sc.tau.var!=) . _.var) sbnd) srho + !csig = ForAll (filter ((sc.clvar.var !=) . _.var) sbnd) srho !sig = case g.findit msym.name of - Just xsym | xsym.{typ?} -> xsym.typ + Just xsym | Just typ <- preview SymbolT._typ xsym -> typ other -> error ("tcInstMethod: link to nothing: " ++ nice msym g) E.logmsg TRACE6 msym.pos (text (msym.nice g ++ " class: " ++ sc.nice g @@ -732,13 +724,11 @@ tcInstMethod (sc:scs) isym msym -- forall i. S i => I i ==> S 42 => I 42 rhotau <- T.instantiate isym.typ case tauRho rhotau of - RhoTau ctx tau -> do -- must be RhoTau, see Enter + Just (RhoTau ctx tau) -> do -- must be RhoTau, see Enter -- C c => c a -> c b ==> forall a b.C (I 42) => I 42 a -> I 42 b - let sig1 = substSigma (TM.singleton sc.tau.var tau) csig + let sig1 = substSigma (TM.singleton sc.clvar.var tau) csig -- add the context of the instantiated type to sig - let !msig = case sig1 of - ForAll bs (RhoFun c2 a b) = ForAll bs (RhoFun (ctx ++ adapt c2) a b) - ForAll bs (RhoTau c2 a) = ForAll bs (RhoTau (ctx ++ adapt c2) a) + let !msig = sig1.{rho <- over RhoT._context (\c2 -> ctx ++ adapt c2)} -- drop C (I 42) from constraints -- this is so because, for example Eq_Int.== does not need -- a proof that Int is Eq, rather it is itself the proof. @@ -752,32 +742,16 @@ tcInstMethod (sc:scs) isym msym E.logmsg TRACE6 msym.pos (text (msym.nice g ++ " adapted type " ++ msig.nicer g)) msig <- T.canonicSignature msig E.logmsg TRACE6 msym.pos (text (msym.nice g ++ " instance type " ++ msig.nicer g)) - -- let inst = U.sigmaInst g csig msig - -- E.logmsg TRACE6 msym.pos ("sigmaInst: " ++ show (map (flip nice g) inst)) - -- let mfinal = msig.{bound = [ var | TVar {var} <- inst]} - -- E.logmsg TRACE6 msym.pos (msym.nice g ++ " instance type " ++ mfinal.nicer g) - case isPSigma sig of - true -> do - changeSym msym.{typ = msig, anno = true} - false -> do - T.subsCheck msym sig msig - T.checkConstraints msym sig msig - T.checkConstraints msym msig sig - when (msym.{expr?}) do - changeSym msym.{typ = msig, anno = true} + unless (isPSigma sig) do + T.subsCheck msym sig msig + T.checkConstraints msym sig msig + T.checkConstraints msym msig sig + case msym of + SymMeth.V msymv -> changeSym $ SymbolT.V msymv.{typ = msig, anno = true} + _ -> pure () other -> E.fatal isym.pos (msgdoc ("RhoTau expected, got " ++ rhotau.nicer g)) - Just (symv@SymV {typ=sig}) | isPSigma sig -> do + Just (SymMeth.V (symv@SymV {typ=sig})) -> do -- isPSigma sig == true E.fatal symv.pos (text (symv.nice g ++ " of " ++ sc.nice g ++ " is not annotated")) -- Some class has a default method that links somewhere else -- The method was introduced in a super class - Just SymL{} -> tcInstMethod scs isym msym - Just other -> do - E.fatal other.pos (text (other.nice g ++ " in " ++ sc.nice g)) - -tcInstMethod (sc:scs) isym (msym@SymV {typ=s}) | not (isPSigma s) = do - g <- getST - E.fatal msym.pos (text ("tcInstMethod: " ++ msym.nice g ++ " annotated with " ++ s.nicer g)) - -tcInstMethod (sc:scs) isym msym = do - g <- getST - E.fatal msym.pos (text ("tcInstMethod: strange symbol " ++ msym.nice g)) + Just (SymMeth.L _) -> tcInstMethod scs isym msym diff --git a/frege/compiler/GenMeta.fr b/frege/compiler/GenMeta.fr index aa13105b..c3c712e2 100644 --- a/frege/compiler/GenMeta.fr +++ b/frege/compiler/GenMeta.fr @@ -141,21 +141,21 @@ genmeta = do -- let ops = [ mkOp (s,x) | (s,x) <- each g.optab, x >= LOP0 ] - let asyms = [sym | sym@SymA {pos} <- values g.thisTab, sym.vis!=Private] + let asyms = [sym | SymbolT.A sym <- values g.thisTab, sym.vis!=Private] symas <- liftStG $ mapSt annoSymA asyms - let csyms = [sym | sym@SymC {pos} <- values g.thisTab, sym.vis!=Private] + let csyms = [sym | SymbolT.C sym <- values g.thisTab, sym.vis!=Private] symcs <- liftStG $ mapSt annoSymC csyms - let isyms = [sym | sym@SymI {pos} <- values g.thisTab, sym.vis!=Private] + let isyms = [sym | SymbolT.I sym <- values g.thisTab, sym.vis!=Private] symis <- liftStG $ mapSt annoSymI isyms - let tsyms = [sym | sym@SymT {pos} <- values g.thisTab, sym.vis!=Private] + let tsyms = [sym | SymbolT.T sym <- values g.thisTab, sym.vis!=Private] symts <- liftStG $ mapSt annoSymT tsyms - symvs <- liftStG $ envValues g.thisTab - symls <- liftStG $ envLinks g.thisTab + symvs <- liftStG $ envValues $ values g.thisTab + symls <- liftStG $ envLinks $ values g.thisTab g <- getSTT ctime <- liftIO (System.currentTimeMillis()) @@ -200,23 +200,23 @@ genmeta = do --- create annotations for all SymV in an environment -envValues :: Symtab -> StG [DOCUMENT] -envValues env = do - let vsyms = [sym | sym@SymV {pos} <- values env, sym.vis != Private] +envValues :: [Symbol] -> StG [DOCUMENT] +envValues envsyms = do + let vsyms = [sym | SymbolT.V sym <- envsyms, sym.vis != Private] symvs <- mapSt annoSymV vsyms stio symvs --- create annotations for all SymL in an environment -envLinks :: Symtab -> StG [DOCUMENT] -envLinks env = do +envLinks :: [Symbol] -> StG [DOCUMENT] +envLinks envsyms = do g <- getST - let syms = [ sym | sym@SymL {alias} <- values env, sym.vis != Private] + let syms = [ sym | SymbolT.L sym <- envsyms, sym.vis != Private] mapM annoSymL syms --- create annotations for all SymD in an environment -envCons :: Symtab -> StG [DOCUMENT] -envCons env = do - let syms = [sym | sym@SymD {pos} <- values env] +envCons :: [Symbol] -> StG [DOCUMENT] +envCons envsyms = do + let syms = [sym | SymbolT.D sym <- envsyms] mapSt annoSymD syms @@ -270,10 +270,10 @@ kindIndex k = do -flatTau (tv@TVar {var,kind}) = do - suba <- kindIndex (substKind empty var tv.{kind=KType} kind) -- beware of recursion +flatTau (TauT.Var (tv@TVar{var,kind})) = do + suba <- kindIndex (substKind empty var (TauT.Var tv.{kind=KType}) kind) -- beware of recursion return (TauA {kind=3,tcon=Nothing,suba,subb=0,tvar=var}) -flatTau (TCon {name}) = do +flatTau (TauT.Con TCon{name}) = do return (TauA {kind=2,tcon=Just name,suba=0,subb=0,tvar=""}) flatTau (TApp a b) = do suba <- tauIndex a @@ -321,22 +321,24 @@ flatCtx (Ctx {pos, cname, tau}) = do -- U.logmsg TRACE9 pos (tau.nice g) tau <- tauIndex tau stio (CtxA {clas=cname,tau}) - -flatRho (RhoFun ctx sig rho) = do +flatRho :: Rho -> StG RhoA +flatRho (RhoT.Fun (RhoFun ctx sig rho)) = do cont <- mapSt flatCtx ctx sigma <- sigIndex sig rhotau <- rhoIndex rho stio (RhoA {rhofun=true,cont,sigma,rhotau}) -flatRho (RhoTau ctx tau) = do +flatRho (RhoT.Tau (RhoTau ctx tau)) = do cont <- mapSt flatCtx ctx rhotau <- tauIndex tau stio (RhoA {rhofun=false,cont,sigma=0,rhotau}) +rhoIndex :: Rho -> StG Int rhoIndex rho = do rhoa <- flatRho rho raIndex rhoa +raIndex :: RhoA -> StG Int raIndex ra = do g <- getST case g.rTree.lookup ra of @@ -429,9 +431,9 @@ expIndex exp = encodeX exp >>= mbIndex -- the list of symbols corresponding to the let bound names syms ← mapM U.findV env -- make (and encode) the list of sigmas - sigs ← mapM (\s -> if Symbol.anno s then sigIndex s.typ else return (-1)) syms + sigs ← mapM (\s -> if SymV.anno s then sigIndex s.typ else return (-1)) syms -- make and encode the list of expressions - exps ← mapM (maybe (return 0) (>>=expIndex) . Symbol.expr) syms + exps ← mapM (maybe (return 0) (>>=expIndex) . _.expr) syms exp ← expIndex ex if exp == 0 || any (<1) exps || any (<1) qexs then return Nothing @@ -503,33 +505,35 @@ eaIndex expa = do changeST Global.{gen <- GenSt.{xunique <- (1+)} • GenSt.{xTree <- insert expa g.xunique}} stio g.xunique +annoSymA :: SymA Global -> StG DOCUMENT annoSymA syma = do g ← getST - vars <- mapSt tauIndex (Symbol.vars syma) - typ <- sigIndex (Symbol.typ syma) + vars <- mapSt (tauIndex . TauT.Var) syma.vars + typ <- sigIndex syma.typ kind <- kindIndex syma.kind let a = meta g "SymA" [ ("offset", anno syma.pos.first.offset), - ("name", annoG g (Symbol.name syma)), + ("name", annoG g syma.name), ("vars", anno vars), ("typ", anno typ), ("kind", anno kind), ("publik", if syma.vis == Public then PP.nil else anno false), - ("doc", maybe PP.nil anno (Symbol.doc syma)) + ("doc", maybe PP.nil anno syma.doc) ] stio a +annoSymV :: SymV Global -> StG DOCUMENT annoSymV symv = do g <- getST - gargs ← mapM tauIndex symv.gargs - case isPSigma (Symbol.typ symv) of + gargs <- mapM (tauIndex . TauT.Var) symv.gargs + case isPSigma symv.typ of true -> E.fatal symv.pos (text (symv.nice g ++ " has no type.")) false -> do - sig <- sigIndex (Symbol.typ symv) + sig <- sigIndex symv.typ -- inline candidates must be safe tail calls and no loops let !classop | MName tname _ <- symv.name, - Just SymC{} <- g.find tname = isJust symv.expr -- this is a class member + Just (SymbolT.C _) <- g.find tname = isJust symv.expr -- this is a class member | otherwise = false !candidate = classop || symv.exported -- U.logmsg TRACE9 symv.pos (text ((nicer symv g) @@ -580,32 +584,30 @@ annoSymV symv = do changeST Global.{gen <- _.{expSym <- insert symv.name exp}} stio a +annoSymL :: SymL Global -> StG DOCUMENT annoSymL sym = do g ← getST pure $ meta g "SymL" [ - ("offset", anno (Symbol.pos sym).first.offset), - ("name", annoG g (Symbol.name sym)), - ("alias", annoG g (Symbol.alias sym)), + ("offset", anno sym.pos.first.offset), + ("name", annoG g sym.name), + ("alias", annoG g sym.alias), ("publik", if sym.vis == Public then PP.nil else anno false), - -- ("doc", maybe PP.nil anno (Symbol.doc sym)) ] +annoSymD :: SymD Global -> StG DOCUMENT annoSymD sym = do g <- getST - typ <- sigIndex (Symbol.typ sym) + typ <- sigIndex sym.typ fields <- mapSt conFieldA sym.flds let a = meta g "SymD" [ - ("offset", anno (Symbol.pos sym).first.offset), - ("name", annoG g (Symbol.name sym)), - -- ("stri", lit sym.strsig.show), - ("cid", anno (Symbol.cid sym)), + ("offset", anno sym.pos.first.offset), + ("name", annoG g sym.name), + ("cid", anno sym.cid), ("typ", anno typ), ("fields", annoListG g fields), - -- ("fnms", if null fnms || all null fnms then PP.nil else anno fnms), - -- ("ftys", if null ftys then PP.nil else anno ftys), ("priv", if sym.vis == Private then anno true else PP.nil), ("publik", if sym.vis == Public then PP.nil else anno false), - ("doc", maybe PP.nil anno (Symbol.doc sym)), + ("doc", maybe PP.nil anno sym.doc), ("op", if sym.op == defaultInfix then PP.nil else anno (ord sym.op))] stio a @@ -626,14 +628,15 @@ instance AnnoG ConFieldA where ] +annoSymC :: SymC Global -> StG DOCUMENT annoSymC sym = do g ← getST - tau <- tauIndex (Symbol.tau sym) - meml <- envLinks (Symbol.env sym) - memv <- envValues (Symbol.env sym) + tau <- tauIndex $ TauT.Var sym.clvar + meml <- envLinks $ map _.toSymbol $ values sym.meth + memv <- envValues $ map _.toSymbol $ values sym.meth let a = meta g "SymC" [ - ("offset", anno (Symbol.pos sym).first.offset), - ("name", annoG g (Symbol.name sym)), + ("offset", anno sym.pos.first.offset), + ("name", annoG g sym.name), ("tau", anno tau), ("sups", if null sym.supers then PP.nil else annoListG g sym.supers), ("ins1", if null sym.insts then PP.nil else annoListG g (map fst sym.insts)), @@ -641,35 +644,37 @@ annoSymC sym = do ("lnks", some meml), ("funs", some memv), ("publik", if sym.vis == Public then PP.nil else anno false), - ("doc", maybe PP.nil anno (Symbol.doc sym))] + ("doc", maybe PP.nil anno sym.doc)] stio a +annoSymI :: SymI Global -> StG DOCUMENT annoSymI sym = do g ← getST - typ <- sigIndex (Symbol.typ sym) - meml <- envLinks (Symbol.env sym) - memv <- envValues (Symbol.env sym) + typ <- sigIndex sym.typ + meml <- envLinks $ map _.toSymbol $ values sym.meth + memv <- envValues $ map _.toSymbol $ values sym.meth let a = meta g "SymI" [ - ("offset", anno (Symbol.pos sym).first.offset), - ("name", annoG g (Symbol.name sym)), - ("clas", annoG g (Symbol.clas sym)), + ("offset", anno sym.pos.first.offset), + ("name", annoG g sym.name), + ("clas", annoG g sym.clas), ("typ", anno typ), ("lnks", some meml), ("funs", some memv), - ("doc", maybe PP.nil anno (Symbol.doc sym))] + ("doc", maybe PP.nil anno sym.doc)] stio a +annoSymT :: SymT Global -> StG DOCUMENT annoSymT sym = do g ← getST - typ <- sigIndex (Symbol.typ sym) - memc <- envCons (Symbol.env sym) - meml <- envLinks (Symbol.env sym) - memv <- envValues (Symbol.env sym) + typ <- sigIndex sym.typ + memc <- envCons $ values sym.env + meml <- envLinks $ values sym.env + memv <- envValues $ values sym.env kind <- kindIndex sym.kind - gargs ← mapM tauIndex sym.gargs + gargs <- mapM (tauIndex . TauT.Var) sym.gargs let a = meta g "SymT" [ - ("offset", anno (Symbol.pos sym).first.offset), - ("name", annoG g (Symbol.name sym)), + ("offset", anno sym.pos.first.offset), + ("name", annoG g sym.name), ("typ", anno typ), ("kind", anno kind), ("cons", some memc), @@ -679,8 +684,8 @@ annoSymT sym = do ("isEnum", if sym.enum then anno true else PP.nil), ("pur", if sym.pur then anno true else PP.nil), ("newt", if sym.newt then anno true else PP.nil), - ("nativ", maybe PP.nil anno (Symbol.nativ sym)), + ("nativ", maybe PP.nil anno sym.nativ), ("gargs", if null gargs then PP.nil else anno gargs), ("publik", if sym.vis == Public then PP.nil else anno false), - ("doc", maybe PP.nil anno (Symbol.doc sym))] + ("doc", maybe PP.nil anno sym.doc)] pure a diff --git a/frege/compiler/Javatypes.fr b/frege/compiler/Javatypes.fr index 34956f4b..5cde1f4b 100644 --- a/frege/compiler/Javatypes.fr +++ b/frege/compiler/Javatypes.fr @@ -44,6 +44,7 @@ package frege.compiler.Javatypes where import frege.compiler.Utilities as U() import frege.lib.PP (text) +import Compiler.types.Symbols(SymbolT) import Compiler.types.Positions(Position) import Compiler.types.Global as G @@ -106,8 +107,8 @@ findAllSupers name Left l -> liftStG do g <- getST syms <- mapM U.findT (U.typesOfNativ name g) - let oss = filter (g.ourSym) syms - pos = if null oss then Position.null else (head oss).pos + let oss = filter (g.ourSym . SymbolT.T) syms + pos = if null oss then Position.null else (head oss).pos E.error pos (text ("`" ++ name ++ "` is not a known java class")) changeST Global.{javaEnv <- _.delete name} Right c -> do diff --git a/frege/compiler/Kinds.fr b/frege/compiler/Kinds.fr index 9c73e4cc..b244ae5d 100644 --- a/frege/compiler/Kinds.fr +++ b/frege/compiler/Kinds.fr @@ -59,7 +59,7 @@ import Compiler.instances.Nicer import Lib.PP(group, break, text, <+>, <>) import frege.compiler.Utilities as U() -import Data.TreeMap as TM(TreeMap, keys, values, each, including, +import Data.TreeMap as TM(TreeMap, TreeSet, keys, values, each, including, lookup, insert, delete) import Data.Graph (stronglyConnectedComponents tsort) @@ -71,7 +71,7 @@ kiTypes = do g <- getST let tsyms = typeSyms g deps = map (typeDep g) tsyms - tdeps = zip (map Symbol.name tsyms) deps + tdeps = zip (map _.name tsyms) deps groups = tsort tdeps foreach groups kiTypeGroup return () @@ -79,46 +79,43 @@ kiTypes = do --- do kind inference on a group of types kiTypeGroup qns = do types <- mapM U.findT qns - let vartypes = filter (varKind . Symbol.kind) types -- with kinds that contain KVar - names = map Symbol.name vartypes + let vartypes = filter (varKind . SymT.kind) types -- with kinds that contain KVar + names = map SymT.name vartypes foreach vartypes (kiTypeSym names) --- refresh :: Symbol -> StG Symbol --- refresh sym = getST >>= (return . unJust . sym.name.findit) - - -kiTypeSym :: [QName] -> Symbol -> StG () +kiTypeSym :: [QName] -> SymT Global -> StG () kiTypeSym names sym = do g <- getST - E.logmsg TRACEK (Symbol.pos sym) (text ("kind check for " ++ nice sym g)) + E.logmsg TRACEK sym.pos (text ("kind check for " ++ nice sym g)) -- kind check all constructor sigmas - let cons = [ con | con@SymD{typ} <- values sym.env ] + let cons = [ con | SymbolT.D con <- values sym.env ] foreach cons (kiConSym names) g ← getST - sym ← U.findT sym.name + sym <- U.findT sym.name let kflat (KApp k ks) = k : kflat ks kflat ks = [ks] - typ = ForAll (zipWith Tau.{kind=} (sym.typ.bound) (kflat sym.kind)) sym.typ.rho + typ = ForAll (zipWith TVar.{kind=} sym.typ.bound (kflat sym.kind)) sym.typ.rho showbnds = text . joined " " . map (flip nice g) - changeSym sym.{typ} - E.logmsg TRACEK (Symbol.pos sym) (text "type is now ∀" + changeSym $ SymbolT.T sym.{typ} + E.logmsg TRACEK sym.pos (text "type is now ∀" <+> showbnds typ.bound <+> text "." <+> text (nicer typ.rho g) ) +kiConSym :: [QName] -> SymD Global -> StG () kiConSym names con = do g <- getST - E.logmsg TRACEK (Symbol.pos con) (text ("kind check for " ++ nice con g)) + E.logmsg TRACEK con.pos (text ("kind check for " ++ nice con g)) (sigma,_) <- kiSigma names [] con.typ - changeSym con.{typ=sigma} + changeSym $ SymbolT.D con.{typ=sigma} -- kind inference on a 'Sigma' type where something else than 'KType' is expected kiSigmaX :: Sigma -> Kind -> StG (Sigma, Kind) kiSigmaX sigma kind = do g <- getST E.logmsg TRACEK (getpos sigma) (text ("kind check " ++ nice sigma g ++ " for " ++ show kind)) - let e = Tau.kind <$> sigma.extendEnv empty + let e = TVar.kind <$> sigma.extendEnv empty (rho, envs, kind) <- kiRhoX sigma.rho [e] kind let e' = fmap repKVar (head envs) return (substSigmaBound sigma.{rho = substRhoKind e' rho} e', repKVar kind) @@ -128,10 +125,10 @@ substSigmaBound (ForAll bound rho) e = ForAll new rho new = [ tv.{kind=k} | tv ← bound, k ← lookup tv.var e ] kiRhoX :: Rho -> Envs -> Kind -> StG (Rho, Envs, Kind) -kiRhoX (it@RhoTau{}) env kind = do +kiRhoX (RhoT.Tau it) env kind = do env <- foldM (kiCtx []) env it.context (kind, env) <- unifyTauKind [] env it.tau kind - return (it, env, kind) + pure (RhoT.Tau it, env, kind) kiRhoX it env kind = do -- it is a RhoFun, and this a type (rho, env) <- kiRho [] env it case unifyKind KType kind of @@ -149,7 +146,7 @@ kiSigmaC :: String -> Kind -> Sigma -> StG (Sigma, Envs) kiSigmaC name kind sigma = do g <- getST E.logmsg TRACEK (getpos sigma) (text ("kind check " ++ nice sigma g)) - let se = Tau.kind <$> sigma.extendEnv empty + let se = TVar.kind <$> sigma.extendEnv empty e = case kind of KVar -> se ; _ -> insert name kind se -- the sub rho is checked with an extended env, i.e. one that is 1 longer than the -- one passed in. @@ -167,7 +164,7 @@ kiSigma :: [QName] -> Envs -> Sigma -> StG (Sigma, Envs) kiSigma names env sigma = do g <- getST E.logmsg TRACEK (getpos sigma) (text ("kind check " ++ nice sigma g)) - let e = Tau.kind <$> sigma.extendEnv empty + let e = TVar.kind <$> sigma.extendEnv empty -- the sub rho is checked with an extended env, i.e. one that is 1 longer than the -- one passed in. -- If kiRho always returns an env with the same length as passed, @@ -184,11 +181,12 @@ kiSigma names env sigma = do repKVar KVar = KType repKVar (KApp a b) = KApp (repKVar a) (repKVar b) repKVar x = x - -substRhoKind env (it@RhoTau{}) = it.{ + +substRhoKind :: TreeMap String (KindT a) -> RhoT a -> RhoT a +substRhoKind env (RhoT.Tau it) = RhoT.Tau it.{ context <- map (substCtxKind env), tau <- substTauKind env} -substRhoKind env (it@RhoFun{}) = it.{ +substRhoKind env (RhoT.Fun it) = RhoT.Fun it.{ context <- map (substCtxKind env), sigma <- Sigma.{rho <- substRhoKind env'}, rho <- substRhoKind env} @@ -200,7 +198,7 @@ substCtxKind :: TreeMap String (KindT β) -> ContextT β -> ContextT β substCtxKind env it = it.{tau <- substTauKind env} substTauKind :: TreeMap String (KindT β) -> TauT β -> TauT β -substTauKind env (it@TVar{}) = case env.lookup it.var of +substTauKind env (TauT.Var it) = TauT.Var $ case env.lookup it.var of Just kind -> it.{kind} _ -> it substTauKind env (TApp a b) = TApp (substTauKind env a) (substTauKind env b) @@ -208,24 +206,25 @@ substTauKind env tau = tau --- kind inference on a 'Rho' type kiRho :: [QName] -> Envs -> Rho -> StG (Rho, Envs) -kiRho names env (it@RhoTau{context,tau}) = do - env <- foldM (kiCtx names) env context - (_, env) <- unifyTauKind names env tau KType - return (it, env) -kiRho names env (it@RhoFun{context,sigma,rho}) = do - env <- foldM (kiCtx names) env context - (sig, env) <- kiSigma names env sigma - (rho, env) <- kiRho names env rho - return (it.{sigma=sig, rho}, env) +kiRho names env (RhoT.Tau it) = do + env <- foldM (kiCtx names) env it.context + (_, env) <- unifyTauKind names env it.tau KType + pure (RhoT.Tau it, env) +kiRho names env (RhoT.Fun it) = do + env <- foldM (kiCtx names) env it.context + (sig, env) <- kiSigma names env it.sigma + (rho, env) <- kiRho names env it.rho + pure (RhoT.Fun it.{sigma=sig, rho}, env) --- kind inference on a 'Ctx', takes into account kind checked classes only +kiCtx :: [QName] -> Envs -> Context -> StG Envs kiCtx names env Ctx{cname, tau} = do cls <- U.findC cname - case cls.tau.kind of + case cls.clvar.kind of KVar -> return env -- not yet kind checked k -> do (_, env) <- unifyTauKind names env tau k - return env + return env type Envs = [TreeMap String Kind] @@ -245,9 +244,9 @@ type Envs = [TreeMap String Kind] If kind errors are detected, error messages will be written. -} unifyTauKind :: [QName] -> Envs -> Tau -> Kind -> StG (Kind, Envs) -unifyTauKind names env (tvar@TVar{}) exp - | Just _ ← tvar.wildTau, - KGen taus ← tvar.kind = do +unifyTauKind names env (TauT.Var tvar) exp + | Just _ <- tvar.wildTau, + KGen taus <- tvar.kind = do env' ← foldM (\env t -> snd <$> unifyTauKind names env t KType) env taus case unifyKind tvar.kind exp of Nothing → do @@ -258,15 +257,15 @@ unifyTauKind names env (tvar@TVar{}) exp ++ ", expected was " ++ nicer exp g)) pure (tvar.kind, env') Just _ → pure (tvar.kind, env') -unifyTauKind names env (TVar{pos,var,kind}) exp = do +unifyTauKind names env (TauT.Var TVar{pos,var,kind}) exp = do g <- getST E.logmsg TRACEK pos (text ("unifyTauKind: " ++ var ++ " initial " ++ nicer varkind g ++ " expected " ++ nicer exp g)) case unifyKind varkind exp of Just (KGen ts) → do - let subst = fold (\tm tv -> TreeMap.insert tm tv.var tv.{var,pos,kind=KVar}) empty - [ftv | t ← ts, ftv ← U.freeTVars [] (RhoTau [] t)] + let subst = fold (\tm tv -> TreeMap.insert tm tv.var $ TauT.Var tv.{var,pos,kind=KVar}) empty + [ftv | t <- ts, ftv <- U.freeTVars [] $ RhoT.Tau $ RhoTau [] t] ts' = map (T.substTau subst) ts pure (KGen ts', updenv env var (KGen ts')) Just k -> do @@ -290,27 +289,27 @@ unifyTauKind names env (TVar{pos,var,kind}) exp = do -unifyTauKind names env (TCon{pos,name}) exp = do +unifyTauKind names env (TauT.Con TCon{pos,name}) exp = do g <- getST sym <- U.findT name - + E.logmsg TRACEK pos (text ("unifyTauKind: " ++ nice name g ++ " initial " ++ show sym.kind ++ " expected " ++ show exp)) - + case unifyKind sym.kind exp of Just k -> do when (! (k `keq` sym.kind) && sym.name `elem` names) do - changeSym sym.{kind=k} + changeSym $ SymbolT.T sym.{kind=k} E.logmsg TRACEK pos (text ("unifyTauKind: " ++ nice name g ++ " result " ++ show k)) return (k, env) Nothing -> do g <- getST - E.error pos (text ("kind error, type constructor `" ++ name.nice g + E.error pos (text ("kind error, type constructor `" ++ name.nice g ++ "` has kind " ++ show sym.kind ++ ", expected was " ++ show exp)) - return (sym.kind, env) + return (sym.kind, env) -- TCon b ~ exp => check TCon for kb -> exp and b for kb unifyTauKind names env (it@TApp a b) exp = do @@ -409,7 +408,7 @@ varKind (KApp a b) = varKind a || varKind b varKind _ = false --- find the 'Sigmas' of all constructors of the given type 'Symbol' -conSigmas SymT{env} = [ typ | SymD{typ} <- values env ] +conSigmas (SymbolT.T SymT{env}) = [ typ | SymbolT.D SymD{typ} <- values env ] conSigmas _ = [] --- give the direct dependencies of a type symbol @@ -418,8 +417,8 @@ typeDep g = ourNames g . sigmasTCons . conSigmas --- find our type symbols typeSyms :: Global -> [Symbol] typeSyms g = filter isOurT (values g.thisTab) where - isOurT SymT{name} = g.our name - isOurT _ = false + isOurT (SymbolT.T SymT{name}) = g.our name + isOurT _ = false --- find all our 'QNames' from a 'OrdSet' ourNames :: Global -> TreeMap QName β -> [QName] @@ -432,12 +431,12 @@ sigmasTCons = fold rhoTCons TreeMap.empty . map Sigma.rho sigmaTCons (ForAll _ rho) = keys (rhoTCons TreeMap.empty rho) --- find all 'QName's that denote types in a 'Rho' type -rhoTCons set (rho@RhoFun{}) = rhoTCons sigset rho.rho where +rhoTCons :: TreeSet QName -> Rho -> TreeSet QName +rhoTCons set (RhoT.Fun rho) = rhoTCons sigset rho.rho where sigset = rhoTCons set rho.sigma.rho -rhoTCons set (rho@RhoTau{}) = tauTCons set rho.tau +rhoTCons set (RhoT.Tau rho) = tauTCons set rho.tau --- find all 'QName's that denote types in a 'Tau' type -tauTCons set (TCon{name}) = set `including` name +tauTCons set (TauT.Con c) = set `including` c.name tauTCons set (TApp a b) = tauTCons (tauTCons set a) b tauTCons set _ = set - \ No newline at end of file diff --git a/frege/compiler/Main.fr b/frege/compiler/Main.fr index 20bd573c..ea633996 100644 --- a/frege/compiler/Main.fr +++ b/frege/compiler/Main.fr @@ -46,6 +46,9 @@ import Control.monad.State import Data.TreeMap as TM(TreeMap, each, values, keys, insert, delete) import Data.List (sort, uniq) +import frege.compiler.common.Lens (set) +import frege.data.Foldable (for_) + import frege.Version(version) import Compiler.enums.Flags @@ -59,6 +62,7 @@ import Compiler.types.Tokens import Compiler.enums.TokenID import Compiler.types.Packs import Compiler.types.Positions +import Compiler.types.Symbols (SymbolT) import Compiler.grammar.Lexer as L() import Compiler.grammar.Frege as F() @@ -263,13 +267,15 @@ makeFile glob sts = do Just _ → return () none → do u ← uniqid - if sym.{env?} then enter sym.{sid=u, env=empty} else enter sym.{sid=u} + enter $ set SymbolT._sid u $ case sym of + SymbolT.T symt -> SymbolT.T symt.{env=empty} + _ -> set SymbolT._meth empty $ sym E.logmsg TRACEZ Position.null ( text "makeFile: entered" <+> (text (sym.nice g)) <+> (text (show u)) ) - when sym.{env?} (mergeSymtab sym.env) + for_ sym.env' mergeSymtab --- make filename from package name @x.y.z.Packet@ => @dest/x/y/z/Packet.java@ targetPath :: Global -> String -> String diff --git a/frege/compiler/Typecheck.fr b/frege/compiler/Typecheck.fr index 2ff0ac2b..d0de7601 100644 --- a/frege/compiler/Typecheck.fr +++ b/frege/compiler/Typecheck.fr @@ -100,13 +100,14 @@ import Compiler.common.Types as TH import Compiler.common.Resolve as R(weUse) import Compiler.common.SymbolTable import Compiler.common.Binders(avoidBinders) +import Compiler.common.Lens(over, set) import Compiler.classes.Nice import Compiler.instances.Nicer import Lib.PP(text, msgdoc, nest, stack, <>, , <+/>, <+>) -import frege.compiler.Utilities as U(findC, findD, findV, findVD, symVD, freeTVars, freeTVnames, +import frege.compiler.Utilities as U(findC, findD, findV, findVD, freeTVars, freeTVnames, mapEx, foldEx, arity) import frege.compiler.Kinds as K() @@ -121,26 +122,27 @@ post = stio true --- construct a tree of all our member functions memberTree = do g <- getST - let envs = g.thisTab : [ Symbol.env sy | sy <- values g.thisTab, Symbol.{env?} sy ] - mems = fold ins empty [ sy | env <- envs, sy@SymV {name=MName _ _} <- values env, g.ourSym sy] + let envs = g.thisTab : mapMaybe SymbolT.env' (values g.thisTab) + mems = fold ins empty [ sy | env <- envs, sy@(SymbolT.V SymV{name=MName _ _}) <- values env, g.ourSym sy] ins :: TreeMap String [Symbol] -> Symbol -> TreeMap String [Symbol] ins t sy | Just list <- t.lookup b = if sy `elem` list then t else t.insert b (sy:list) | otherwise = insert b [sy] t - where b = (Symbol.name sy).base + where b = sy.name.base stio mems -fundep mtree (SymV {name, expr=Just dx}) = do +fundep :: TreeMap String [Symbol] -> SymV Global -> StG (QName, [QName]) +fundep mtree SymV{name, expr=Just dx} = do g <- getST deptree <- dx >>= U.ourGlobalFuns mtree - let dep = [ Symbol.name sy | sy <- keys deptree, g.ourSym sy, - -- leave annotated symbols and symbols with sigmas out - sy.{expr?} && isPSigma sy.typ || not sy.{expr?} ] + let needed sy = + -- leave annotated symbols and symbols with sigmas out + case sy of + SymbolT.V SymV{typ} -> isPSigma typ + _ -> true + dep = [ sy.name | sy <- keys deptree, g.ourSym sy, needed sy ] stio (name, dep) -fundep mtree (SymV {name, expr=Nothing}) = stio (name, []) -fundep mtree other = do - g <- getST - E.fatal other.pos (text ("fundep: strange symbol: " ++ other.nice g)) +fundep mtree SymV{name, expr=Nothing} = stio (name, []) --- collect all variable symbols and their dependencies @@ -176,26 +178,37 @@ pass = do return ("functions", length names) ---- e.g. @tc "Int"@ is the 'Tau' with type constructor for @PreludeBase.Int@ +--- e.g. @tc "Int"@ is the @'TCon' 'QName'@ with type constructor for @PreludeBase.Int@ +tc :: String -> TCon QName tc n = TCon {pos=Position.null, name=TName pPreludeBase n} -mainSigmaA t = ForAll [] - (RhoFun [] (ForAll [] (RhoTau [] strings)) - (RhoTau [] iovoid)) - where - strings = TApp (tc "[]") tauString -- [String] - iovoid = TApp (TApp (tc "ST") (tc "RealWorld")) t +--- @tcTau = TauT.Con . tc@, for abbreviation +tcTau :: String -> Tau +tcTau n = TauT.Con (tc n) -mainSigma = ForAll [] - (RhoFun [] (ForAll [] (RhoTau [] strings)) - (RhoTau [] iovoid)) +mainSigmaA t = ForAll [] + $ RhoT.Fun $ RhoFun [] + (ForAll [] (RhoT.Tau $ RhoTau [] strings)) + (RhoT.Tau $ RhoTau [] iovoid) where - strings = TApp (tc "[]") tauString -- [String] - iovoid = TApp (TApp (tc "ST") (tc "RealWorld")) (tc "()") + strings = TApp (tcTau "[]") tauString -- [String] + iovoid = TApp (TApp (tcTau "ST") (tcTau "RealWorld")) t + +mainSigma = mainSigmaA (tcTau "()") -mainSimple (ForAll xs RhoFun{rho}) = ForAll xs rho +mainSimple (ForAll xs (RhoT.Fun r)) = ForAll xs r.rho mainSimple sigma = sigma +findMain :: StG (Maybe (SymV Global)) +findMain = do + g <- getST + case g.findit (VName g.thisPack "main") of + Just (SymbolT.V symv) -> pure $ Just symv + Nothing -> pure Nothing + -- main must be SymV, so this always throws an error. + -- reuse the error message + Just sym -> fmap Just $ findV (VName g.thisPack "main") + {-- * make sure that, for example, @main _ = return ()@ is not rejected later because of * inferred type @forall a m Monad m . a -> m ()@ @@ -210,25 +223,29 @@ mainSimple sigma = sigma -} annotateMain = do g <- getST - case g.findit (VName g.thisPack "main") of - Just sym | sym.name.pack == g.thisPack, - Just dx <- sym.expr, - not sym.anno = do + msym <- findMain + case msym of + Just sym + | sym.name.pack == g.thisPack + , Just dx <- sym.expr + , not sym.anno -> do x <- dx if U.lambdaDepth x > 0 - then changeSym sym.{typ = mainSigma, anno = true} - else changeSym sym.{typ = mainSimple mainSigma, anno = true} - _ -> stio () + then changeSym $ SymbolT.V sym.{typ = mainSigma, anno = true} + else changeSym $ SymbolT.V sym.{typ = mainSimple mainSigma, anno = true} + | otherwise -> stio () + Nothing -> stio () checkMain = do g <- getST tau <- Util.newMeta2 ("a", KType) - case g.findit (VName g.thisPack "main") of + msym <- findMain + case msym of Just sym | sym.name.pack == g.thisPack -> do let m = Vbl {pos = sym.pos, name = sym.name, typ = Just pSigma} sigma - | RhoFun{} <- sym.typ.rho = mainSigmaA tau - | otherwise = mainSimple (mainSigmaA tau) + | RhoT.Fun _ <- sym.typ.rho = mainSigmaA tau + | otherwise = mainSimple (mainSigmaA tau) checkAnnotated m sigma gnew <- getST when (g.errors < gnew.errors) do @@ -278,7 +295,7 @@ checkgroup7 nms = do -- foreach nms verbose foreach nms checkName syms <- mapSt findV nms - when (length syms > 1 || any ((==Recursive) • Symbol.state) syms) + when (length syms > 1 || any ((==Recursive) . _.state) syms) (foreach nms checkName) changeST Global.{typEnv <- drop (length nms)} g <- getST @@ -297,14 +314,13 @@ checkgroup7 nms = do verbose nm = do g <- getST sym <- findV nm - let sig = Symbol.typ sym - E.explain (Symbol.pos sym) (text (sym.nice g ++ " :: " ++ sig.nicer g)) + let sig = sym.typ + E.explain sym.pos (text (sym.nice g ++ " :: " ++ sig.nicer g)) typeSanity nm = do sym <- findV nm sym <- checkKind sym - checkAmbiguous sym sym.typ - checkReturn sym sym.typ - -- sym <- removeCheckedCtx sym sym.typ + checkAmbiguous (SymbolT.V sym) sym.typ + checkReturn (SymbolT.V sym) sym.typ case sym.name of Local{} -> return () aGlobalName -> do -- issue #23 @@ -318,67 +334,62 @@ checkgroup7 nms = do Just dx -> do x <- dx ex <- U.mapEx false removeCtx x - changeSym sym.{expr = Just (return ex)} + changeSym $ SymbolT.V sym.{expr = Just (return ex)} where scrapCtx it = do - let sig = (Symbol.typ it).{rho <- clear} - clear ∷ Rho → Rho - clear RhoFun{context, sigma, rho} = RhoFun{context=[], sigma, rho = clear rho} - clear RhoTau{context, tau} = RhoTau{context=[], tau} + let sig = it.typ.{rho <- zapCtx} nex <- case it.expr of Just x -> x >>= U.mapEx false removeCtx >>= (return . Just . return) Nothing -> return Nothing - changeSym it.{typ=sig, expr = nex} + changeSym $ SymbolT.V it.{typ=sig, expr = nex} removeCtx (it@Let{env}) = do syms <- mapM U.findV env foreach syms scrapCtx return (Left it) removeCtx x = return (Left x) -checkKind ∷ Symbol → StG Symbol -checkKind sym = correctK empty sym +checkKind :: SymV Global -> StG (SymV Global) +checkKind = correctK empty where - correctK ∷ TreeMap String Tau → Symbol → StG Symbol + correctK :: TreeMap String (TVar QName) -> SymV Global -> StG (SymV Global) correctK subst (sym@SymV{typ,expr}) = do - --g ← getST - --E.logmsg TRACEZ sym.pos (text "Checking kind of" <+> text (nice sym g)) sig ← bool (pure typ) (fst <$> K.kiSigma [] [] typ) (null typ.bound) - let rsubst = sig.extendEnv subst -- (zip sig.vars (sig.tvars sym.pos)) + let rsubst = sig.extendEnv subst ex ← maybe (pure Nothing) (\x → Just <$> (x >>= mapEx false (correctKind rsubst))) expr let new = sym.{typ=sig, expr = fmap pure ex} return new - correctK subst sym = error "only SymV allowed" correctKind subst Let{env, ex, typ} = do - syms ← mapM U.findV env + syms <- mapM U.findV env mapM_ (correctK subst) syms - ex' ← mapEx false (correctKind subst) ex - pure $ Right Let{env, ex = ex', typ = fmap (substSigma subst) typ } - correctKind subst x = pure $ Left x.{typ ← fmap (substSigma subst)} + ex' <- mapEx false (correctKind subst) ex + pure $ Right Let{env, ex = ex', typ = fmap (substSigma $ fmap TauT.Var subst) typ } + correctKind subst x = pure $ Left x.{typ <- fmap (substSigma $ fmap TauT.Var subst)} +checkAmbiguous :: Symbol -> Sigma -> StG () checkAmbiguous sym (ForAll bnd r) = do - let ra = r.{context=[]} -- ctx => rho --> rho - rb = (rhoInt).{context=r.context} -- Int --> ctx => Int + let ra = set RhoT._context [] r -- ctx => rho --> rho + rb = set RhoT._context r.context rhoInt -- Int --> ctx => Int va = freeTVnames [] ra vb = freeTVnames [] rb bad = filter (`notElem` va) vb if null bad then stio () else do g <- getST - E.error (Symbol.pos sym) (msgdoc ("Ambiguous type " + E.error sym.pos (msgdoc ("Ambiguous type " ++ nicer r g ++ " in " ++ nice sym g)) - E.hint (Symbol.pos sym) (msgdoc ("It is not clear at what types to instantiate " + E.hint sym.pos (msgdoc ("It is not clear at what types to instantiate " ++ (if length bad == 1 then "type variable " else "type variables ") ++ joined ", " bad ++ " that " ++ (if length bad == 1 then "occurs" else "occur") ++ " in the context, but not in the type.")) - E.hint (Symbol.pos sym) (msgdoc ("This can happen through constructs like (Enum.ord • Enum.from) " + E.hint sym.pos (msgdoc ("This can happen through constructs like (Enum.ord • Enum.from) " ++ " where a class context is both introduced and eliminated locally so " ++ "that a caller can not know which type is meant.")) @@ -390,8 +401,8 @@ checkReturn sym sigma = let svars = [ v | ForAll bs br <- ss, v <- U.freeTVnames (map _.var bs) br ] ++ keys (U.freeCtxTVars [] empty sigma.rho.context) tvars = case t of - TVar {pos} -> [t.var] - TApp _ _ | (TVar {var}:_) <- t.flat = [var] + TauT.Var t -> [t.var] + TApp _ _ | (TauT.Var TVar{var}:_) <- t.flat = [var] _ -> [] if all (`elem` svars) tvars then stio () else do @@ -409,31 +420,32 @@ removeCheckedCtx sym sigma resolveConstraints :: Symbol -> StG () resolveConstraints sym - | SymV{typ, expr=Just x, anno=false, state} <- sym, state != Recursive = do + | SymbolT.V (symv@SymV{typ, expr=Just x, anno=false, state}) <- sym, state != Recursive = do x <- x >>= resolveHas cxs <- collectConstrs x - rho <- simplify sym.pos typ.rho.{context=cxs} - >>= simplify sym.pos -- remove duplicates + rho <- simplify symv.pos (set RhoT._context cxs typ.rho) + >>= simplify symv.pos -- remove duplicates -- Drop the contexts that contain a rigid tvar that is not occurring in the type itself. -- Those stem from typechecking applications of higher rank functions where -- there is a constraint in an inner forall. -- The rigid context remains intact on the application itself, which will help us -- in code generation to identify them. g <- getST - let rhometas = rhoTvs g rho.{context=[]} + let rhometas = rhoTvs g $ set RhoT._context [] rho ctxmetas = map (ctxTvs g) rho.context let filteredCtx = [ ctx | (metas, ctx) <- zip ctxmetas rho.context, all (`elem` rhometas) (filter (not . MetaTv.isFlexi) metas)] - changeSym sym.{typ <- Sigma.{rho <- rmtrailing . Rho.{context=filteredCtx}}, + changeSym $ SymbolT.V symv.{typ <- Sigma.{rho <- rmtrailing . set RhoT._context filteredCtx}, expr = Just (return x)} | otherwise = return () where - rmtrailing rho - | RhoFun{} <- rho = rho.{rho <- zapctx} - | otherwise = rho - zapctx RhoTau{context, tau} = RhoTau{context=[], tau} - zapctx RhoFun{context, sigma, rho} = RhoFun{context=[], sigma, rho = zapctx rho} - + rmtrailing (RhoT.Fun r) = RhoT.Fun r.{rho <- zapCtx} + rmtrailing rho = rho + +--- Remove all contexts in RhoT, recursively +zapCtx :: RhoT a -> RhoT a +zapCtx = set RhoT._traverseCtxs [] + {-- * look for applications of class member functions in the code of the named item * and replace them with instance member functions, if possible. @@ -449,7 +461,7 @@ substInstMethod qname = do Just dx -> do x <- dx x <- mapEx true substInst x - changeSym sym.{expr = Just (return x)} + changeSym $ SymbolT.V sym.{expr = Just (return x)} --- replace class member with instance member, if possible substInst (vbl@Vbl {pos, name = MName tn bs, typ = Just (ForAll [] rho)}) @@ -467,19 +479,16 @@ substInst (vbl@Vbl {pos, name = MName tn bs, typ = Just (ForAll [] rho)}) {- | MName iname bs != qname -} -> do mem <- findV vbl.name case g.findit (MName iname bs) of - Just imem -> do - let nrho = rho.{context <- filter (not • sameCtx ctx)} + Just imem' | Just imem <- SymVal.fromSymbol imem' -> do + let nrho = over RhoT._context (filter (not . sameCtx ctx)) rho strho = substRho - (unifySigma g imem.typ ForAll{bound=[], rho=nrho}) + (unifySigma imem.typ ForAll{bound=[], rho=nrho}) imem.typ.rho - !repl | SymV{} <- imem = vbl.{name=imem.name, - typ = Just (ForAll [] strho)} - | SymD{} <- imem = Con{pos=vbl.pos, - name=imem.name, - typ = Just (ForAll [] strho)} - | otherwise = error ("substInst WTF??? : " ++ nicer imem g) + !repl = case imem of + SymVal.V _ -> vbl.{name=imem.name, typ = Just (ForAll [] strho)} + SymVal.D _ -> Con{pos=vbl.pos, name=imem.name, typ = Just (ForAll [] strho)} E.logmsg TRACEO pos ( - text ("replace " ++ vbl.name.nice g) + text ("replace " ++ vbl.name.nice g) nest 4 ( text (":: " ++ vbl.typ.nicer g) text ("sigma :: " ++ mem.typ.nicer g) @@ -491,6 +500,7 @@ substInst (vbl@Vbl {pos, name = MName tn bs, typ = Just (ForAll [] rho)}) idKind <- insert (KeyTk vbl.pos.first) (Right imem.name)}} weUse imem.name stio (Left repl) + Just wtf -> error ("substInst WTF??? : " ++ nicer wtf g) Nothing -> E.fatal vbl.pos (msgdoc ("substInst: trying " ++ nice vbl g ++ ", but " ++ nice (MName iname bs) g @@ -509,15 +519,15 @@ substInst (vbl@Vbl {pos, name = MName tn bs, typ = Just (ForAll [] rho)}) --- Also, make sure no DWIM literal has a constraint in its type. substInst (lit@Lit{pos, kind, value, typ=Just (ForAll [] rho)}) | kind == LInt || kind == LDouble, - not (null rho.context) = pure (Right lit.{typ=Just (ForAll [] rho.{context=[]})}) + not (null rho.context) = pure $ Right lit.{typ=Just $ ForAll [] $ set RhoT._context [] rho} substInst x = stio (Left x) -renameSigma ∷ Symbol -> StG () +renameSigma :: SymV Global -> StG () renameSigma sym | sym.name.isLocal && sym.anno = do g ← getST - outer ← mapSt findV g.typEnv - let avoid = \c → c `elem` concatMap (Sigma.vars . Symbol.typ) outer - || (any (null . Sigma.vars . Symbol.typ) outer && avoidBinders g c) + outer <- mapSt findV g.typEnv + let avoid = \c → c `elem` concatMap (Sigma.vars . _.typ) outer + || (any (null . Sigma.vars . _.typ) outer && avoidBinders g c) newsym = sym.{typ ← avoidSigma avoid } when (sym.typ.vars != newsym.typ.vars) do E.warn sym.pos ((text "Renamed type variables in annotated type of let bound function " @@ -525,7 +535,7 @@ renameSigma sym | sym.name.isLocal && sym.anno = do (text "was: " <+> text (sym.typ.nicer g)) (text "now: " <+> text (newsym.typ.nicer g)) text "because of (potential) type variable naming conflicts.") - changeSym newsym + changeSym $ SymbolT.V newsym pure () renameSigma other = pure () @@ -533,37 +543,33 @@ renameSigma other = pure () checkName nm = do g <- getST sym <- findV nm - -- sym <- if nm.isLocal && sym.anno then renameSigma sym else pure sym E.logmsg TRACEZ sym.pos (text ("checkName: " ++ sym.name.nice g ++ " :: " ++ sym.typ.nice g)) - -- E.logmsg TRACET sym.pos (text ("checkName: " ++ sym.name.nice g ++ " :: " ++ sym.typ.nice g)) sigma <- checkSym sym unless (nm.isLocal) do sym <- findV nm - resolveConstraints sym + resolveConstraints $ SymbolT.V sym where checkSym sym = do g <- getST - -- E.logmsg TRACEZ (Symbol.pos sym) (text ("typechecking " ++ sym.nice g ++ ", state=" ++ show sym.state)) - -- E.logmsg TRACET (Symbol.pos sym) (text ("typechecking " ++ sym.nice g ++ ", state=" ++ show sym.state)) case sym of SymV {nativ = Just _, typ = t} | not (isPSigma t) -> do (sig, _) <- K.kiSigma [] [] t E.logmsg TRACEZ sym.pos (text "after kind inference: " <+> text (sig.nicer g)) - changeSym sym.{typ=sig} - M.sanity sym.{typ=sig} + changeSym $ SymbolT.V sym.{typ=sig} + M.sanity $ SymbolT.V sym.{typ=sig} return sig SymV {expr = Nothing, name, pos, typ = t} | not (isPSigma t), MName c _ <- name, - Just (SymC {pos}) <- g.findit c = do + Just (SymbolT.C _) <- g.findit c = do (sig, _) <- K.kiSigma [] [] t - changeSym sym.{state=Typechecked, vis=Abstract, typ = sig} + changeSym $ SymbolT.V sym.{state=Typechecked, vis=Abstract, typ = sig} stio t | otherwise = do E.error pos (msgdoc ("implementation missing for " ++ sym.nice g)) (sig, _) <- K.kiSigma [] [] t - changeSym sym.{state=Typechecked, typ=sig} + changeSym $ SymbolT.V sym.{state=Typechecked, typ=sig} stio t SymV {expr = Just dx, typ = t} | isPSigma t, @@ -571,17 +577,17 @@ checkName nm = do x <- dx rho0 <- approxRho x ex <- case rho0 of - RhoTau{} -> do - changeSym sym.{state=Typechecking} + RhoT.Tau _ -> do + changeSym $ SymbolT.V sym.{state=Typechecking} (rho, ex) <- inferRho x -- CAF ? return ex - RhoFun{} -> do - changeSym sym.{state=Typechecking, typ = ForAll [] rho0} + RhoT.Fun _ -> do + changeSym $ SymbolT.V sym.{state=Typechecking, typ = ForAll [] rho0} checkRho x rho0 sym <- findV sym.name -- refresh, might be updated meanwhile let newstate = if sym.state != Recursive then Typechecked else Recursive newsig <- maybe (error "untyped after checkRho") pure ex.typ - changeSym sym.{typ = newsig, expr=Just (return ex), state = newstate} + changeSym $ SymbolT.V sym.{typ = newsig, expr=Just (return ex), state = newstate} stio newsig SymV {expr = Just dx, typ = t, state, anno} @@ -592,7 +598,7 @@ checkName nm = do <+> text (nice sig g)) x <- checkAnnotated x sig -- t <- canonicSignature t - changeSym sym.{state = Typechecked, expr = Just (return x), typ = sig } + changeSym $ SymbolT.V sym.{state = Typechecked, expr = Just (return x), typ = sig } stio sig | not (isPSigma t), state == Typechecked && anno = stio t -- opt: do not recheck annotated | not (isPSigma t), state == Recursive || state == Typechecked = do @@ -601,7 +607,7 @@ checkName nm = do rho <- zonkRho rho sym <- findV sym.name -- refresh, might be updated meanwhile let newsig = ForAll [] rho - changeSym sym.{typ = newsig, expr=Just (return ex), state = Typechecked} + changeSym $ SymbolT.V sym.{typ = newsig, expr=Just (return ex), state = Typechecked} stio newsig wrongsy -> E.fatal wrongsy.pos (text ("checkSym: wrong symbol: " ++ wrongsy.nice g ++ ", state=" ++ show wrongsy.state @@ -612,9 +618,9 @@ quantifyOne nms = do g <- getST sym <- U.findV (head nms) lsyms <- mapSt U.findV g.typEnv - let rec = [ Symbol.typ sym | sym <- lsyms, - sym <- (g.follow sym), -- follow aliases - Symbol.state sym == Recursive] + let rec = [ sym.typ + | sym <- lsyms + , sym.state == Recursive] when (false && null sym.typ.rho.context && not (TH.isFun sym.typ g) && null rec) do quantifyWith (quantifiedExcept sym.sid) nms stio () @@ -631,7 +637,7 @@ quantifyWith f nms = do nativ = Nothing, anno = false, typ = (ForAll [] rho)}) <- syms, not (isPSigma sy.typ)] - asyms = [ (name, typ) | sy@SymV {name, expr = Just _, + asyms = [ (name, typ) | SymV {name, expr = Just _, nativ = Nothing, anno = true, typ} <- syms ] -- sigRho (ForAll [] rho) = rho @@ -649,10 +655,10 @@ quantifyWith f nms = do zex <- zonkExpr x -- from here on no bound Meta anywhere zex <- zonkRigid (Sigma.vars sigm) zex -- replace Rigid#nnn a where a is bound let sigma = substRigidSigma (Sigma.vars sigm) sigm - changeSym sym.{typ = sigma, expr = Just (return zex), anno = true} + changeSym $ SymbolT.V sym.{typ = sigma, expr = Just (return zex), anno = true} g <- getST - E.logmsg TRACET (Symbol.pos sym) (text ("qfy: " ++ sym.nice g ++ " :: " ++ sigma.nice g)) - E.explain (Symbol.pos sym) (text (sym.nice g ++ " :: " ++ sigma.nicer g)) + E.logmsg TRACET sym.pos (text ("qfy: " ++ sym.nice g ++ " :: " ++ sigma.nice g)) + E.explain sym.pos (text (sym.nice g ++ " :: " ++ sigma.nicer g)) other = Prelude.error "findV behaves badly" @@ -662,7 +668,7 @@ zonkRigid bound ex = do -- g <- getST mapEx false zonk ex where - symWork (symv@ SymV {pos, expr, typ = sig}) = do + symWork (symv@SymV{expr, typ = sig}) = do g <- getST -- E.logmsg TRACEZ (getpos ex) (text ("symWork: " ++ show (bound ++ sig.vars) ++ " " ++ nice ex g)) rhoz ← zonkRho sig.rho @@ -673,8 +679,7 @@ zonkRigid bound ex = do x <- zonkRigid (bound ++ sig.vars) x return (Just (return x)) Nothing -> return Nothing - changeSym symv.{expr, typ = ForAll sig.bound rho} - symWork _ = error "symWork: not a variable" + changeSym $ SymbolT.V symv.{expr, typ = ForAll sig.bound rho} zonk (x@Let {env,ex,typ = Just sigm}) = do let sig = substRigidSigma bound sigm @@ -720,11 +725,11 @@ zonkExpr x = mapEx false zonk x foreach syms symWork stio (Left x.{typ = Just sig}) where - symWork (symv@ SymV {pos, expr = Just dex, typ = sig}) = do + symWork (symv@SymV{expr = Just dex, typ = sig}) = do sig <- zonkSigma sig ex <- dex ex <- zonkExpr ex - changeSym symv.{expr = Just (return ex), typ = sig} + changeSym $ SymbolT.V symv.{expr = Just (return ex), typ = sig} symWork _ = error "symWork: not a variable" zonk x | Just sig <- Expr.typ x = do @@ -741,14 +746,14 @@ approxRho :: Expr -> StG Rho approxRho (Lam {ex,pat}) = do sig <- case pat of PAnn{pat, typ} -> return typ - sonst -> ForAll [] . RhoTau [] <$> newMeta2 ("arg", KType) + _ -> ForAll [] . RhoT.Tau . RhoTau [] <$> newMeta2 ("arg", KType) rho <- approxRho ex - stio (RhoFun [] sig rho) + pure $ RhoT.Fun $ RhoFun [] sig rho approxRho _ = newRhoTyVar ("res", KType) inferRho x = do - rho <- RhoTau [] <$> newMeta2 ("infer", KVar) -- doio (Ref.new Nothing) + rho <- RhoT.Tau . RhoTau [] <$> newMeta2 ("infer", KVar) x <- tcRho x (Infer rho) case x.typ of Just s -> return (s.rho, x) @@ -798,9 +803,9 @@ checkSigma1 annotated x s = do ectx <- collectConstrs x let pos = getpos x let sigma = unJust (Expr.typ x) - rho <- simplify pos sigma.rho.{context=ectx} + rho <- simplify pos $ set RhoT._context ectx sigma.rho g <- getST - let rhometas = rhoTvs g rho.{context=[]} + let rhometas = rhoTvs g $ set RhoT._context [] rho ctxmetas = map (ctxTvs g) rho.context let fctx = map snd . filter relevantCtx $ zip ctxmetas rho.context @@ -814,7 +819,7 @@ checkSigma1 annotated x s = do -- . filter (not . MetaTv.isFlexi) . fst - frho = rho.{context=fctx} + frho = set RhoT._context fctx rho x <- return (x.{typ = Just sigma.{rho=frho}}) let ety = canonicContext g expty @@ -860,26 +865,36 @@ tcRho x expty = case expty of tcRho' x expty -rhoFor s = RhoTau [] (TCon {pos=Position.null,name=TName pPreludeBase s}) -rhoBool = rhoFor "Bool" -rhoChar = rhoFor "Char" -rhoString = RhoTau [] tauString -rhoInt = rhoFor "Int" -rhoLong = rhoFor "Long" -rhoDouble = rhoFor "Double" -rhoFloat = rhoFor "Float" -rhoDec = RhoTau [] (TCon {pos=Position.null, name=TName pPreludeDecimal "Decimal"}) -rhoRegex = RhoTau [] (TCon {pos=Position.null, name=TName pUtilRegex "Regex"}) -rhoMatcher = RhoTau [] (TCon {pos=Position.null, name=TName pUtilRegex "MatchResult"}) -rhoInteger = rhoFor "Integer" -tauString = TApp (tc "StringJ") (tc "Char") -numVar = ForAll [tau] - RhoTau{context=[Ctx{pos, cname=TName pPreludeBase "Num", tau}], tau} - where tau = TVar{pos, kind=KType, var="int"} +tnameBool = TName pPreludeBase "Bool" +tnameChar = TName pPreludeBase "Char" +tnameInt = TName pPreludeBase "Int" +tnameLong = TName pPreludeBase "Long" +tnameDouble = TName pPreludeBase "Double" +tnameFloat = TName pPreludeBase "Float" +tnameInteger = TName pPreludeBase "Integer" + +rhoFor name = RhoT.Tau RhoTau{context=[], tau=TauT.Con TCon{pos=Position.null,name}} +rhoBool = rhoFor tnameBool +rhoChar = rhoFor tnameChar +rhoString = RhoT.Tau RhoTau{context=[], tau=tauString} +rhoInt = rhoFor tnameInt +rhoLong = rhoFor tnameLong +rhoDouble = rhoFor tnameDouble +rhoFloat = rhoFor tnameFloat +rhoDec = RhoT.Tau RhoTau{context=[], tau=TauT.Con TCon{pos=Position.null, name=TName pPreludeDecimal "Decimal"}} +rhoRegex = RhoT.Tau RhoTau{context=[], tau=TauT.Con TCon{pos=Position.null, name=TName pUtilRegex "Regex"}} +rhoMatcher = RhoT.Tau RhoTau{context=[], tau=TauT.Con TCon{pos=Position.null, name=TName pUtilRegex "MatchResult"}} +rhoInteger = rhoFor tnameInteger +tauString = TApp (tcTau "StringJ") (tcTau "Char") +numVar = ForAll [tvar] + (RhoT.Tau RhoTau{context=[Ctx{pos, cname=TName pPreludeBase "Num", tau}], tau}) + where tau = TauT.Var tvar + tvar = TVar{pos, kind=KType, var="int"} pos = Position.null -realVar = ForAll [tau] - RhoTau{context=[Ctx{pos, cname=TName pPreludeBase "Real", tau}], tau} - where tau = TVar{pos, kind=KType, var="int"} +realVar = ForAll [tvar] + (RhoT.Tau RhoTau{context=[Ctx{pos, cname=TName pPreludeBase "Real", tau}], tau}) + where tau = TauT.Var tvar + tvar = TVar{pos, kind=KType, var="int"} pos = Position.null @@ -917,13 +932,13 @@ tcRho' (x@Vbl{name}) (ety@Check erho) y ← expand x erho tcRho y ety where - higherRankedConstrainedArgs RhoFun{sigma, rho} + higherRankedConstrainedArgs (RhoT.Fun RhoFun{sigma, rho}) | ForAll{bound, rho=r} ← sigma, not (null bound), not (null r.context) = true | otherwise = higherRankedConstrainedArgs rho - higherRankedConstrainedArgs RhoTau{} = false - expand ex RhoTau{} = pure ex - expand ex RhoFun{rho} = do - ex' <- expand ex rho + higherRankedConstrainedArgs (RhoT.Tau _) = false + expand ex (RhoT.Tau _) = pure ex + expand ex (RhoT.Fun r) = do + ex' <- expand ex r.rho pat ← U.freshVar x.pos pure Lam{pat, ex=App{fun=ex', @@ -934,34 +949,34 @@ tcRho' (x@Vbl{name}) (ety@Check erho) tcRho' (x@Vbl {name}) ety = do sym <- findVD name - case sym of - SymD{} -> tcRho' Con{pos=x.pos, name=x.name, typ=x.typ} ety - other -> case isPSigma sym.typ of - false -> if sym.state != Typechecked + case sym of + SymVal.D _ -> tcRho' Con{pos=x.pos, name=x.name, typ=x.typ} ety + SymVal.V symv -> case isPSigma symv.typ of + false -> if symv.state != Typechecked then do - sig ← fst <$> K.kiSigma [] [] sym.typ - changeSym sym.{typ=sig} + sig <- fst <$> K.kiSigma [] [] symv.typ + changeSym $ SymbolT.V symv.{typ=sig} rho <- instantiate sig instRho x rho ety else do - rho <- instantiate sym.typ + rho <- instantiate symv.typ instRho x rho ety - true -> if sym.state == Unchecked + true -> if symv.state == Unchecked then do checkName name sym <- findV name rho <- instantiate sym.typ instRho x rho ety - else if sym.state == Typechecking - || sym.state == Recursive then do + else if symv.state == Typechecking + || symv.state == Recursive then do -- unavoidable in mutual recursive definitions - changeSym sym.{state=Recursive} + changeSym $ SymbolT.V symv.{state=Recursive} rho <- approxRho x instRho x rho ety else do g <- getST - E.fatal (getpos x) (text ("tcRho: untyped " ++ x.nice g ++ ", state=" ++ show sym.state)) + E.fatal (getpos x) (text ("tcRho: untyped " ++ x.nice g ++ ", state=" ++ show symv.state)) tcRho' (x@Con {name}) ety = do sym <- U.findD name rho <- instantiate sym.typ @@ -1008,13 +1023,13 @@ tcRho' (lam@Lam {pat,ex}) (ety@Check rho) = do (asig, brho) <- unifyFun x rho checkPat pat asig ex <- checkRho ex brho - instRho x.{ex} (RhoFun [] asig (unJust ex.typ).rho) ety + instRho x.{ex} (RhoT.Fun RhoFun{context=[], sigma=asig, rho=(unJust ex.typ).rho}) ety tcRho' (lam@Lam {}) ety = do (pat, ex) <- dwimPatEx lam.pat lam.ex let x = lam.{pat, ex} sigma <- inferPat x.pat (rho, ex) <- inferRho x.ex - instRho (x.{ex}) (RhoFun [] sigma rho) ety + instRho (x.{ex}) (RhoT.Fun RhoFun{context=[], sigma, rho}) ety tcRho' (x@Mem {ex,member}) ety = do (rho, ex) <- inferRho ex @@ -1036,17 +1051,17 @@ tcRho' (x@Mem {ex,member}) ety = do let pos = getpos x case rho of - RhoFun _ _ _ -> do + RhoT.Fun _ -> do E.error pos (text ("primary expression " ++ ex.nice g ++ " must not be a function")) wrong <- newRhoTyVar ("wrong", KType) instRho x.{ex} wrong ety - RhoTau _ taut -> do + RhoT.Tau RhoTau{tau=taut} -> do let tau = reducedTau g taut let expected ety - | Check RhoTau{tau=fun} <- ety, + | Check (RhoT.Tau RhoTau{tau=fun}) <- ety, TApp a b <- reduced fun g, TApp f _ <- reduced a g, - TCon{name=TName{pack,base="->"}} <- reduced f g, + TauT.Con TCon{name=TName{pack,base="->"}} <- reduced f g, pack == pPreludeBase, member.value.startsWith "upd$" || member.value.startsWith "chg$" = [reducedTau g b] @@ -1073,13 +1088,13 @@ tcRho' (x@Mem {ex,member}) ety = do else member case instTauSym tau g of - Just (SymT {name, env, nativ, newt}) - | Just (SymV {name}) <- env.lookup member.value = do + Just (SymT{name, env, nativ, newt}) + | Just (SymbolT.V (SymV{name})) <- env.lookup member.value = do changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk original) (Right name)}} weUse name tcRho (nApp (Vbl mpos name Nothing) ex) ety - | Just (SymL {alias}) <- env.lookup member.value = do + | Just (SymbolT.L SymL{alias}) <- env.lookup member.value = do changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk original) (Right alias)}} weUse alias @@ -1092,8 +1107,8 @@ tcRho' (x@Mem {ex,member}) ety = do -- traceLn ("types " ++ show qns) || true, h:_ <- [ h | q <- qns, h <- g.findit (MName q member.value) ] = do let m = case h of - SymV {name} -> name - SymL {alias} -> alias + SymbolT.V SymV{name} -> name + SymbolT.L SymL{alias} -> alias _ -> error "no symbol or alias" changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk original) (Right m)}} @@ -1102,18 +1117,20 @@ tcRho' (x@Mem {ex,member}) ety = do | newt, name == TName pPreludeIO "Mutable", -- it is some Mutable type TApp _ ntau <- tau, -- Mutable x ntau - TCon{name=tcon}:_ <- ntau.flat, - Just SymT{nativ=Just s} <- g.findit tcon, - SymV{name=m}:_ <- [ h | sup <- s:U.supersOfNativ s g, - q <- U.typesOfNativ sup g, - h <- g.findit (MName q member.value) ] + TauT.Con TCon{name=tcon}:_ <- ntau.flat, + Just (SymbolT.T SymT{nativ=Just s}) <- g.findit tcon, + (SymbolT.V SymV{name=m}):_ <- + [ h + | sup <- s:U.supersOfNativ s g + , q <- U.typesOfNativ sup g + , h <- g.findit (MName q member.value) ] = do changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk original) (Right m)}} weUse m tcRho (nApp (Vbl mpos m Nothing) ex) ety - other | Just (m@SymV {name=MName clas _}) <- g.findit (VName g.thisPack member.value), - Just (SymC {tau}) <- g.findit clas = do + other | Just (SymbolT.V (m@SymV {name=MName clas _})) <- g.findit (VName g.thisPack member.value), + Just (SymbolT.C _) <- g.findit clas = do changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk original) (Right m.name)}} weUse m.name @@ -1157,7 +1174,7 @@ tcPat p expty = case expty of E.logmsg TRACET (getpos p) (text ("tcPat Check " ++ p.nice g ++ " for " ++ s.nice g)) tcPat' p expty -sigFor s = ForAll [] (RhoTau [] (TCon {pos=Position.null,name=TName pPreludeBase s})) +sigFor s = ForAll [] (RhoT.Tau RhoTau{context=[], tau=TauT.Con TCon{pos=Position.null,name=TName pPreludeBase s}}) sigBool = ForAll [] rhoBool sigChar = ForAll [] rhoChar sigString = ForAll [] rhoString @@ -1195,19 +1212,17 @@ tcPat' (p@PLit {pos,kind}) ety = case kind of tcPat' (p@PVar {uid,var}) (ety@Check sig) = do sym <- findV (Local{uid, base=var}) - -- E.logmsg TRACET p.pos (text("lookup PVar{uid=" ++ show uid ++ "} --> " ++ show sym.name)) case isPSigma sym.typ of - true -> do changeSym sym.{typ=sig, state=Typechecked} + true -> do changeSym $ SymbolT.V sym.{typ=sig, state=Typechecked} instPatSigma p sig ety false -> instPatSigma p sym.typ ety tcPat' (p@PVar {uid,var}) ety = do sym <- findV (Local{uid, base=var}) - -- E.logmsg TRACET p.pos (text("lookup PVar{uid=" ++ show uid ++ "} --> " ++ show sym.name)) case isPSigma sym.typ of true -> do sig <- newSigmaTyVar (var, KType) - changeSym sym.{typ = sig, state = Typechecked} + changeSym $ SymbolT.V sym.{typ = sig, state = Typechecked} instPatSigma p sig ety false -> instPatSigma p sym.typ ety @@ -1218,7 +1233,7 @@ tcPat' (p@PMat {pos,uid,var}) ety = do tcPat' (p@PCon {qname,pats}) ety = do sym <- findD qname rho <- instantiate sym.typ - let spRho (RhoFun _ s r) = case spRho r of + let spRho (RhoT.Fun (RhoFun _ s r)) = case spRho r of (args, ret) -> (s:args,ret) spRho rhotau = ([], rhotau) case spRho rho of @@ -1253,19 +1268,19 @@ private num = TName{pack=pPreludeBase, base="Num"} --- Make sure all constraints are removed when a type is found literalType ctxs (lit@Lit{pos, kind, value, typ=Just sigma}) | kind != LInt, kind != LDouble = return (Left lit) - | kind == LInt, isDWIM LInt value, RhoTau _ taut <- sigma.rho = do + | kind == LInt, isDWIM LInt value, RhoT.Tau RhoTau{tau=taut} <- sigma.rho = do g <- getST let tau = reduced taut g case tau of - TCon{pos, name} - | name == rhoInt.tau.name = strip lit - | name == rhoLong.tau.name = strip lit.{kind=LLong, value <- (++"L")} - | name == rhoInteger.tau.name = strip lit.{kind=LBig} - | name == rhoFloat.tau.name = strip lit.{kind=LFloat, value <- (++"F")} - | name == rhoDouble.tau.name = strip lit.{kind=LDouble, value <- (++"D")} + TauT.Con TCon{pos, name} + | name == tnameInt = strip lit + | name == tnameLong = strip lit.{kind=LLong, value <- (++"L")} + | name == tnameInteger = strip lit.{kind=LBig} + | name == tnameFloat = strip lit.{kind=LFloat, value <- (++"F")} + | name == tnameDouble = strip lit.{kind=LDouble, value <- (++"D")} | otherwise = fromInt Meta Flexi{uid, hint, kind} = do -- unbound, because already reduced @@ -1285,14 +1300,14 @@ literalType ctxs (lit@Lit{pos, kind, value, typ=Just sigma}) _ -> do x <- checkRho lit rhoInt -- fix unresolved to Int strip x -- or force type error - | kind == LDouble, isDWIM LDouble value, RhoTau _ taut <- sigma.rho = do + | kind == LDouble, isDWIM LDouble value, RhoT.Tau RhoTau{tau=taut} <- sigma.rho = do g <- getST let tau = reduced taut g case tau of - TCon{pos, name} - | name == rhoFloat.tau.name = strip lit.{kind=LFloat, value <- (++"F")} - | name == rhoDouble.tau.name = strip lit.{kind=LDouble, value <- (++"D")} + TauT.Con TCon{pos, name} + | name == tnameFloat = strip lit.{kind=LFloat, value <- (++"F")} + | name == tnameDouble = strip lit.{kind=LDouble, value <- (++"D")} | otherwise = fromDouble Meta Rigid{} -> fromDouble TApp _ _ -> fromDouble -- force type error unless Real @@ -1303,15 +1318,15 @@ literalType ctxs (lit@Lit{pos, kind, value, typ=Just sigma}) | otherwise = checkRho lit rhoInt >>= strip -- no DWIM where strip ∷ ExprT → StG (ExprT | ExprT) - strip x = pure . Right $ x.{typ ← fmap _.{rho ← _.{context = []}}} + strip x = pure . Right $ x.{typ <- fmap _.{rho <- set RhoT._context []}} frmIntlit = nApp frmInt lit.{typ=Just sigInt} frmDbllit = nApp frmDbl lit.{typ=Just sigDouble} frmInt = Vbl{pos = pos.change VARID "fromInt", name = MName{tynm=num, base="fromInt"}, typ=Nothing} frmDbl = Vbl{pos= pos.change VARID "fromDouble", name = MName{tynm=real, base="fromDouble"}, typ=Nothing} - fromInt = checkRho frmIntlit sigma.rho.{context=[]} >>= strip - fromDouble = checkRho frmDbllit sigma.rho.{context=[]} >>= strip + fromInt = checkRho frmIntlit (set RhoT._context [] sigma.rho) >>= strip + fromDouble = checkRho frmDbllit (set RhoT._context [] sigma.rho) >>= strip literalType _ x = return (Left x) @@ -1355,11 +1370,11 @@ rHas flagerr (x@Mem{ex, member, typ = Just sigma}) = do Mem{} | not flagerr = return (Left x) | Just sigma <- ex.typ, - RhoTau{tau=taut} <- sigma.rho = do + RhoT.Tau RhoTau{tau=taut} <- sigma.rho = do g <- getST let tau = reduced taut g case tau.flat of - TCon{}:_ = do + TauT.Con _:_ = do E.error (getpos x) (text "can't find a type for " <+/> text (x.nicer g) <+/> text "`" <> text member.value <> text "`" @@ -1393,7 +1408,7 @@ rHas flagerr (v@Vbl{pos, name, typ}) | not name.isLocal = do _ -> resolveOver v sym where -- resolve overloaded variable - resolveOver :: Expr -> Symbol -> StG (Expr|Expr) + resolveOver :: Expr -> SymV Global -> StG (Expr|Expr) resolveOver v sym = do g <- getST let sigma = (unJust v.typ) @@ -1402,11 +1417,11 @@ rHas flagerr (v@Vbl{pos, name, typ}) | not name.isLocal = do let candidates = overloads g sym groups - | MName{} <- sym.name = groupBy (using (QName.tynm . Symbol.name)) candidates + | MName{} <- sym.name = groupBy (using (QName.tynm . _.name)) candidates | otherwise = [candidates] E.logmsg TRACET v.pos (text ("by " - ++ joined ", " (map (flip nice g . Symbol.name) candidates))) + ++ joined ", " (map (flip nice g . _.name) candidates))) checked <- mapM (resolve v.pos sigma) groups case filter (not . null) checked of @@ -1420,17 +1435,17 @@ rHas flagerr (v@Vbl{pos, name, typ}) | not name.isLocal = do <+> text " cannot be resolved at type " <+/> text (nicer sigma g)) return (Right v) - ms:_ -> case sortBy (comparing arity) ms of -- compare b arity to find + ms:_ -> case sortBy (comparing arityV) ms of -- compare b arity to find -- the one that fits - cs → case filter ((arity (head cs) ==) . arity) cs of -- remove the ones that don't + cs -> case filter ((arityV (head cs) ==) . arityV) cs of -- remove the ones that don't some -> do when (length some > 1) do E.warn v.pos (text "overloaded `" <> text (nicer v g) <> text "´ is ambiguous at type " <+/> text (nicer sigma g) text "It could mean one of " - stack [ text (nicer (Symbol.name s) g) - <+> text " :: " + stack [ text (nicer s.name g) + <+> text " :: " <+> text (nicer s.typ g) | s <- some ]) let s = head some @@ -1444,12 +1459,12 @@ rHas flagerr (v@Vbl{pos, name, typ}) | not name.isLocal = do idKind <- insert (KeyTk v.pos.first) (Right s.name)}} return (Right x) where - resolve ∷ Position → Sigma → [Symbol] → StG [Symbol] - resolve pos sigma [] = return [] + resolve :: Position -> Sigma -> [SymV Global] -> StG [SymV Global] + resolve _ _ [] = return [] resolve pos sigma (sym:syms) = do g1 <- getST changeST Global.{options <- Options.{flags <- flagSet OVERLOADING}} - x <- checkSigma Vbl{pos, name=Symbol.name sym, typ=Nothing} sigma + x <- checkSigma Vbl{pos, name=sym.name, typ=Nothing} sigma g <- getST putST g1 if (g.errors > g1.errors) @@ -1457,19 +1472,19 @@ rHas flagerr (v@Vbl{pos, name, typ}) | not name.isLocal = do else do rs <- resolve pos sigma syms return (sym:rs) - overloads ∷ Global → Symbol → [Symbol] + overloads :: Global -> SymV Global -> [SymV Global] overloads g sym = case sym of SymV{over=[]} -> [sym] - SymV{pos, name = MName{tynm, base}, over=(_:_)} - | Just SymT{nativ = Just this} <- g.findit tynm, - ov <- [ sy | m <- sym.over, sy <- g.findit m ], + SymV{name = MName{tynm, base}, over=(_:_)} + | Just (SymbolT.T SymT{nativ = Just this}) <- g.findit tynm, + ov <- [ sy | m <- sym.over, SymbolT.V sy <- g.findit m ], syms <- [ sy | s <- U.supersOfNativ this g, q <- U.typesOfNativ s g, - h <- g.findit (MName q base), + SymbolT.V h <- g.findit (MName q base), sy <- overloads g h] = ov++syms - SymV{} -> [ sy | m <- sym.over, sy <- g.findit m] - _ -> [] + SymV{} -> [ sy | m <- sym.over, SymbolT.V sy <- g.findit m ] + arityV = arity . SymVal.V rHas _ x = pure (Left x) diff --git a/frege/compiler/Utilities.fr b/frege/compiler/Utilities.fr index 23761d97..9e182519 100644 --- a/frege/compiler/Utilities.fr +++ b/frege/compiler/Utilities.fr @@ -50,6 +50,8 @@ import Data.List as DL(partitioned, sortBy, minimumBy, \\) import Lib.PP(fill, break, pretty, text, nest, msgdoc, <+>, <>, DOCUMENT) +import frege.compiler.common.Lens (over, preview, set) + -- import Compiler.enums.Flags import Compiler.enums.TokenID(defaultInfix, VARID) import Compiler.enums.RFlag(RState) @@ -118,56 +120,62 @@ supersOfNativ nativ g = case g.javaEnv.lookup nativ of --- find a specific symbol or die +findC :: QName -> StG (SymC Global) findC qname = do g <- getST case g.findit qname of - Just (symc@SymC {pos}) -> stio symc + Just (SymbolT.C sym) -> stio sym Just sym -> E.fatal sym.pos (fill (break ("looked for class " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for class " ++ qname.nice g ++ ", found Nothing"))) +findI :: QName -> StG (SymI Global) findI qname = do g <- getST case g.findit qname of - Just (symc@SymI {pos}) -> stio symc + Just (SymbolT.I sym) -> stio sym Just sym -> E.fatal sym.pos (fill (break ("looked for instance " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for instance " ++ qname.nice g ++ ", found Nothing"))) +findT :: QName -> StG (SymT Global) findT qname = do g <- getST case g.findit qname of - Just (symc@SymT {pos}) -> stio symc + Just (SymbolT.T sym) -> stio sym Just sym -> E.fatal sym.pos (fill (break("looked for type " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for type " ++ qname.nice g ++ ", found Nothing"))) +findV :: QName -> StG (SymV Global) findV qname = do g <- getST case g.findit qname of - Just (symc@SymV {pos}) -> stio symc + Just (SymbolT.V sym) -> stio sym Just sym -> E.fatal sym.pos (fill (break ("looked for function " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for function " ++ qname.nice g ++ ", found Nothing"))) +findVD :: QName -> StG (SymVal Global) findVD qname = do g <- getST case g.findit qname of - Just (symc@SymV {pos}) -> stio symc - Just (symc@SymD {pos}) -> stio symc + Just (SymbolT.V sym) -> stio (SymVal.V sym) + Just (SymbolT.D sym) -> stio (SymVal.D sym) Just sym -> E.fatal sym.pos (fill (break ("looked for function or constructor " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for function " ++ qname.nice g ++ ", found Nothing"))) +findD :: QName -> StG (SymD Global) findD qname = do g <- getST case g.findit qname of - Just (symc@SymD {pos}) -> stio symc + Just (SymbolT.D sym) -> stio sym Just sym -> E.fatal sym.pos (fill (break ("looked for constructor " ++ qname.nice g ++ ", found " ++ sym.nice g))) Nothing -> E.fatal Position.null (fill (break ("looked for constructor " ++ qname.nice g ++ ", found Nothing"))) @@ -185,7 +193,7 @@ nstname s g = case s of --- return a list of 'TVar's that are unbound in the type --- the first argument is the list of 'TVar' names bound outside this rho -freeTVars :: [String] -> RhoT a -> [TauT a] +freeTVars :: [String] -> RhoT a -> [TVar a] freeTVars bound rho = values (freeRhoTVars bound TreeMap.empty rho) @@ -194,22 +202,24 @@ freeTVnames :: [String] -> RhoT a -> [String] freeTVnames bound rho = keys (freeRhoTVars bound TreeMap.empty rho) -freeRhoTVars bound collected (RhoFun ctx (ForAll bndleft rho1) rho2) = +freeRhoTVars :: [String] -> SigmaEnv t -> RhoT t -> SigmaEnv t +freeRhoTVars bound collected (RhoT.Fun RhoFun{context=ctx,sigma=ForAll bndleft rho1,rho=rho2}) = freeRhoTVars (map _.var bndleft ++ bound) (freeRhoTVars bound ctxcoll rho2) rho1 where ctxcoll = freeCtxTVars bound collected ctx -freeRhoTVars bound collected (RhoTau ctx tau) = freeTauTVars bound ctxcoll tau +freeRhoTVars bound collected (RhoT.Tau RhoTau{context=ctx,tau}) = freeTauTVars bound ctxcoll tau where ctxcoll = freeCtxTVars bound collected ctx --- @freeCtxTVars bnd coll ctxs@ --- add the 'TVar's that occur in the contexts in @ctxs@ and are not elemnt of @bnd@ to 'OrdSet' @coll@ +freeCtxTVars :: [String] -> SigmaEnv t -> [ContextT t] -> SigmaEnv t freeCtxTVars bnd coll cs = fold ctxTVars coll cs where ctxTVars t ctx = freeTauTVars bnd t (Context.tau ctx) -freeTauTVars :: [String] -> TreeMap String (TauT β) -> TauT β -> TreeMap String (TauT β) -freeTauTVars bound collected (tv@TVar{var,kind}) +freeTauTVars :: [String] -> SigmaEnv t -> TauT t -> SigmaEnv t +freeTauTVars bound collected (TauT.Var (tv@TVar{var,kind})) | isJust tv.wildTau = coll | var `elem` bound = coll | otherwise = insert var tv coll @@ -223,8 +233,8 @@ freeTauTVars _ collected _ = collected --- return a list of constructors in this environment ordered by constructor number -envConstructors :: Symtab -> [Symbol] -envConstructors env = sortBy (comparing Symbol.cid) [ sy | (sy::Symbol) <- values env, sy.{cid?} ] +envConstructors :: Symtab -> [SymD Global] +envConstructors env = sortBy (comparing _.cid) [ syd | SymbolT.D syd <- values env ] --- provide a new Position for a Pattern @@ -281,21 +291,22 @@ pVarLocal p = Local p.uid p.var {-- @patLocal pos name@ creates a local variable symbol from pos and name -} +patLocal :: Position -> Int -> String -> SymV g patLocal pos uid name = vSym pos (Local uid name) --- set uid for a local symbol -setuid uid = Symbol.{sid=uid, name <- QName.{uid}} +setuid uid = over SymbolT._name QName.{uid} . set SymbolT._sid uid {-- Make a new local symbol from a 'PVar' and enters it in the symbol table. Will fail if argument is not a 'PVar' -} -mkLocal :: Pattern -> StG Symbol +mkLocal :: Pattern -> StG (SymV Global) mkLocal pvar = do let sym = patLocal pvar.pos (abs pvar.uid) pvar.var - enter sym + enter $ SymbolT.V sym stio sym --- make a completely fresh var @@ -307,7 +318,7 @@ freshVar pos = do --- update the local names uids in an expression that match one of the symbols by name replaceLocals :: [Symbol] -> Expr -> StG (Either Expr Expr) -replaceLocals syms (v@Vbl {name = Local 0 s}) = +replaceLocals syms (v@Vbl {name = Local 0 s}) = case DL.find (\sym -> sym.name.base == s) syms of Just sym -> stio (Right v.{name = sym.name}) other -> stio (Right v) @@ -319,6 +330,7 @@ replaceLocals syms x = stio (Left x) * and 'Symbol.name' set to standard values. * If the name is a 'Local' one, the 'Symbol.sid' is set to the 'QName.uid' -} +vSym :: Position -> QName -> SymV g vSym pos name = SymV {pos, sid= if QName.{uid?} name then name.uid else 0, name, vis=Private, doc=Nothing, @@ -340,8 +352,8 @@ lambdaDepth ex = 0 * make a rho type from a tau type -} rhoTau tau - | Just (a,b) <- Tau.getFun tau = RhoFun [] (ForAll [] (rhoTau a)) (rhoTau b) -rhoTau tau = RhoTau [] tau + | Just (a,b) <- Tau.getFun tau = RhoT.Fun $ RhoFun [] (ForAll [] (rhoTau a)) (rhoTau b) +rhoTau tau = RhoT.Tau $ RhoTau [] tau {-- @@ -353,11 +365,11 @@ rhoTau tau = RhoTau [] tau validSigma :: SigmaT a -> StG (SigmaT a) validSigma (ForAll [] rho) = do let vs = freeTVars [] rho - rho <- validRho (map Tau.var vs) rho + rho <- validRho (map _.var vs) rho stio (ForAll vs rho) validSigma sig = validSigma1 [] sig -type SigmaEnv a = TreeMap String (TauT a) +type SigmaEnv a = TreeMap String (TVar a) validSigma1 outer (ForAll bound rho) = do g <- getST @@ -386,15 +398,13 @@ validSigma1 outer (ForAll bound rho) = do * extract the contexts from the type. For this purpose, we assume * sigmas to be of the form @Sigma [] rho@ -} --- validRho :: [String] -> RhoT Ord:a -> StG (RhoT a) +validRho :: [String] -> RhoT a -> StG (RhoT a) validRho bound rho = do - foreach (Rho.context rho) check - case rho of - RhoFun _ sig r -> do - sig <- validSigma1 bound sig - r <- validRho bound r - stio rho.{sigma=sig, rho=r} - _ -> stio rho + foreach rho.context check + flip RhoT._Fun rho $ \it -> do + sigma <- validSigma1 bound it.sigma + rho <- validRho bound it.rho + pure it.{sigma, rho} where check (Ctx pos qname tau) = do let vars = keys (freeTauTVars [] empty tau) @@ -431,19 +441,20 @@ private transSigma1 outer sigma = do innerMap = fold (\tm tv → tm.insertS tv.var tv) TreeMap.empty inner newbound = [ maybe tv id (innerMap.lookupS tv.var) | tv ← freeTV ] constraints rho = case rho of - RhoTau{} -> (rho.context, rho.{context=[]}) - RhoFun{} -> (rho.context ++ subctx, rho.{context=[], rho=subrho}) - where (subctx, subrho) = constraints rho.rho + RhoT.Tau r -> (r.context, RhoT.Tau r.{context=[]}) + RhoT.Fun r -> (r.context ++ subctx, RhoT.Fun r.{context=[], rho=subrho}) + where (subctx, subrho) = constraints r.rho (ctx, rrho) = constraints rho - nrho = rrho.{context=ctx} + nrho = set RhoT._context ctx rrho case rho of - RhoTau _ _ -> return (ForAll newbound nrho) + RhoT.Tau _ -> return (ForAll newbound nrho) _ -> return (ForAll newbound (unTau nrho)) {-- * transform a string context to q 'QName' context -} +transCtx :: ContextS -> StG Context transCtx (Ctx pos name tau) = do name <- defaultXName pos (TName pPreludeBase "Eq") name tau <- transTau tau >>= forceTau @@ -454,15 +465,15 @@ transCtx (Ctx pos name tau) = do * check a rho and translate it to 'QName' form -} transRho :: SigmaEnv QName -> RhoS -> StG Rho -transRho outer (RhoFun ctx sig rho) = do - sig <- transSigma1 outer sig - rho <- transRho outer rho - ctx <- mapSt transCtx ctx - stio (RhoFun ctx sig rho) -transRho outer (RhoTau ctx tau) = do - sig <- transTau tau - ctx <- mapSt transCtx ctx - stio $ sig.rho.{context <- (++ ctx)} +transRho outer (RhoT.Fun r) = do + sig <- transSigma1 outer r.sigma + rho <- transRho outer r.rho + ctx <- mapSt transCtx r.context + pure $ RhoT.Fun RhoFun{context=ctx, sigma=sig, rho} +transRho _ (RhoT.Tau r) = do + sig <- transTau r.tau + ctx <- mapSt transCtx r.context + pure $ over RhoT._context (++ ctx) sig.rho --- translate a 'KindT' 'Sname' to 'KindT' 'QName' transKind KType = pure KType @@ -478,30 +489,42 @@ transKind (KGen ts) = do Just t → pure t Nothing → do E.error (getpos t) (text "invalid type in a kind") - pure TVar{pos=getpos t, kind=KType, var="wrong"} + pure $ TauT.Var TVar{pos=getpos t, kind=KType, var="wrong"} + +{-- + Translate a 'TVar' to 'QName' form. + + Note that the following holds: + > transTau (TauT.Var v) >>= forceTau === TauT.Var <$> transTVar v + -} +transTVar :: TVar SName -> StG (TVar QName) +transTVar = TVar._kind transKind + +{-- + Translate a 'Sigma' bound. ---- Translate a 'Sigma' bound. ---- This is really a shortcut way to translate a type variable. ---- Will die of pattern match failure if argument doesn't have a @kind@ field. -transBound ∷ TauS → StG Tau -transBound tv = tv.{kind=} <$> transKind tv.kind + This is really a shortcut way to translate a type variable. + In fact, this is defined as @transBound = transTVar@ + -} +transBound :: TVar SName -> StG (TVar QName) +transBound = transTVar --- translate 'Sigma' bounds -transBounds ∷ [TauS] → StG [Tau] +transBounds :: [TVar SName] -> StG [TVar QName] transBounds = mapM transBound {-- check a tau and translate it to 'QName' form -} transTau :: TauT SName -> StG (SigmaT QName) -transTau (TVar{pos,var,kind}) = do - k ← transKind kind - pure (tauAsSigma (TVar {pos,var,kind = k})) +transTau (TauT.Var tvar) = do + kind <- transKind tvar.kind + pure (tauAsSigma $ TauT.Var tvar.{kind}) transTau (t@Meta _) = do -- Meta must not happen at this time g <- getST E.fatal (tauPos t) (text("meta type must not occur at this time: " ++ t.nice g)) -transTau (con@TCon {pos,name}) = transTApp [con] +transTau (t@TauT.Con _) = transTApp [t] transTau (t@TApp _ _) = transTApp t.flat transTau (TSig s) = do sig <- transSigma s @@ -509,35 +532,34 @@ transTau (TSig s) = do Just t -> return (tauAsSigma t) Nothing -> return sig - +transTApp :: [TauS] -> StG Sigma transTApp (con:as) = do case con of - TCon {pos,name} -> do + TauT.Con TCon{pos,name} -> do tname <- resolveTName pos name g <- getST case tname of Nothing -> unit -- check if this is really a type constructor Just tn -> case g.findit tn of - Just (SymT {name,typ=ForAll bs _}) -> do - let ncon = TCon {pos, name} + Just (SymbolT.T SymT{name,typ=ForAll bs _}) -> do + let ncon = TauT.Con TCon{pos, name} as <- mapSt transTau as appTauSigmas ncon as - -- checkTApp partial (ncon:as) - Just (alias@SymA {typ}) - | ForAll _ (RhoTau _ tau) <- typ, + Just (SymbolT.A (alias@SymA {typ})) + | ForAll _ (RhoT.Tau RhoTau{tau}) <- typ, length as >= length alias.vars = do as <- mapSt transTau as -- partial args allowed in alias tas <- mapSt forceTau as - let env = TM.fromList (zip (map Tau.var alias.vars) tas) + let env = TM.fromList (zip (map _.var alias.vars) tas) ras = drop (length alias.vars) as let nt = substTau env tau -- make sure errors are flagged on the right position let posnt = case Tau.flat nt of - (tcon:xs) | tcon.{pos?} = Tau.mkapp tcon.{pos} xs + (tcon:xs) | Just pos <- preview TauT._pos tcon = Tau.mkapp (set TauT._pos pos tcon) xs other -> nt appTauSigmas posnt ras - | ForAll _ (RhoTau _ tau) <- typ, + | ForAll _ (RhoT.Tau _) <- typ, length as < length alias.vars = do E.error pos (msgdoc ("apply " ++ alias.nice g ++ " to at least " ++ show (length alias.vars) @@ -551,7 +573,7 @@ transTApp (con:as) = do | length as == length alias.vars = do sargs <- mapSt transTau as targs <- mapSt forceTau sargs - let env = TM.fromList (zip (map Tau.var alias.vars) targs) + let env = TM.fromList (zip (map _.var alias.vars) targs) return (substSigma env alias.typ) | otherwise = do E.error pos (msgdoc("Apply " ++ alias.nice g ++ " to exactly " ++ show alias.vars.length @@ -563,7 +585,7 @@ transTApp (con:as) = do Nothing -> do E.error pos (msgdoc("Can't find `" ++ tn.nice g ++ "`")) unit - where unit = return (tauAsSigma (TCon {pos, name=TName pPreludeBase "()"})) + where unit = pure $ tauAsSigma $ TauT.Con TCon{pos, name=TName pPreludeBase "()"} other -> do con <- transTau con >>= forceTau as <- mapSt transTau as @@ -572,8 +594,9 @@ transTApp _ = undefined -- must only be used with tau.flat --- wrap a 'Tau' in a 'Sigma' +tauAsSigma :: Tau -> Sigma tauAsSigma (TSig s) = s -tauAsSigma t = ForAll [] (unTau (RhoTau [] t)) +tauAsSigma tau = ForAll [] (unTau (RhoT.Tau RhoTau{context=[], tau})) {-- @@ -582,18 +605,21 @@ tauAsSigma t = ForAll [] (unTau (RhoTau [] t)) > ForAll [] (RhoTau [] t) > ForAll [] (RhoFun [] a b) -} -sigmaAsTau (ForAll [] (RhoTau [] t)) = Just t -sigmaAsTau (ForAll [] (r@RhoFun{})) | RhoTau [] t <- tauRho r = Just t +sigmaAsTau :: Sigma -> Maybe Tau +sigmaAsTau (ForAll [] (RhoT.Tau RhoTau{context=[], tau=t})) = Just t +sigmaAsTau (ForAll [] (r@RhoT.Fun _)) + | Just RhoTau{context=[], tau=t} <- tauRho r = Just t sigmaAsTau _ = Nothing +forceTau :: Sigma -> StG Tau forceTau sig = case (sigmaAsTau sig) of Just t -> return t Nothing -> do g <- getST E.error sig.getpos (msgdoc ("illegal type " ++ nicer sig g ++ ", forall types are not allowed here.")) - return TCon{pos=sig.getpos, name=TName pPreludeBase "()"} + pure $ TauT.Con TCon{pos=sig.getpos, name=TName pPreludeBase "()"} {-- @@ -620,10 +646,11 @@ appTauSigmas tau sigs = foldM appTauSig tau sigs >>= return . tauAsSigma does not start with "nowarn:" -} symWarning :: (Position -> DOCUMENT -> StG ()) -> Symbol -> DOCUMENT -> StG () -symWarning warn sym msg = do - case sym.doc of - Just ´^\s*nowarn:´ -> return () - other -> warn sym.pos msg +symWarning warn sym msg = + case preview SymbolT._doc sym of + Nothing -> pure () + Just (Just ´^\s*nowarn:´) -> pure () + Just _ -> warn sym.pos msg {- ################# functions introduced through Classes.fr ############## -} @@ -636,7 +663,7 @@ symWarning warn sym msg = do isSuper x g y | x == y = true - | ysym@Just (SymC {supers}) <- Global.findit g y = any (isSuper x g) supers + | ysym@Just (SymbolT.C SymC{supers}) <- Global.findit g y = any (isSuper x g) supers | otherwise = false @@ -748,7 +775,7 @@ mapEx b f x = do where mapsub (sy@SymV {expr=Just dx}) = do x <- dx x <- mapEx b f x - changeSym sy.{expr=Just (return x)} + changeSym $ SymbolT.V sy.{expr=Just (return x)} mapsub sy = do g <- getST E.fatal sy.pos (text ("mapEx: strange symbol in let def rhs: " @@ -856,15 +883,14 @@ copyExpr mbp t x = mapEx false (copy t) x where --- copy a local symbol copySym mbp tree qname = do sym <- findV qname - case tree.lookupI (Symbol.sid sym) of + case tree.lookupI sym.sid of Just nuid -> do mex <- maybeST sym.expr id mbx <- maybeST mex (copyExpr mbp tree) let name = sym.name.{uid=nuid} npos = (fromMaybe sym.pos mbp).change VARID name.base - -- nsig = if sym.anno || isNothing sym.expr then sym.typ else pSigma nsym = sym.{pos = npos, name, expr = fmap return mbx, sid = nuid} - enter nsym + enter $ SymbolT.V nsym stio name Nothing -> Prelude.error ("Can't find sid " ++ show sym.sid ++ " for name " ++ show sym.name) @@ -884,9 +910,10 @@ maybeST Nothing _ = stio Nothing untypeExpr x = mapEx true unty x where untySy qn = do - sym <- findV qn - changeSym sym.{typ = if sym.anno then sym.typ else pSigma, - state = Unchecked} + symv <- findV qn + changeSym $ SymbolT.V + symv.{ typ = if symv.anno then symv.typ else pSigma + , state = Unchecked } unty (x@Ann{}) = return (Left x) -- keep type signatures intact unty (x@Lam{pat}) = do foreach (patNames pat) untySy @@ -913,8 +940,8 @@ ourGlobalFuns mtree ex = foldEx true collect empty ex where | otherwise = do sym <- findVD name case sym of - SymV{} -> stio (Left (acc `including` sym)) - sonst -> stio (Left acc) + SymVal.V _ -> stio (Left (acc `including` sym.toSymbol)) + _ -> stio (Left acc) collect acc (Mem {member}) | Just list <- TreeMap.lookupS mtree member.value = stio (Left (fold including acc list)) @@ -922,43 +949,34 @@ ourGlobalFuns mtree ex = foldEx true collect empty ex where collect acc _ = stio (Left acc) -symVD f g sym = case sym of - SymV{} -> f sym - SymD{} -> g sym - other -> Prelude.error (sym.name.base ++ " is neither SymV nor SymD") - - {-- * [usage] @fundep expr@ * [returns] a list of our 'QName's that are directly mentioned in _ex_ -} -fundep (SymV {name, expr=Just dx}) = do +fundep :: SymV Global -> StG (QName, [QName]) +fundep (SymV{name, expr=Just dx}) = do g <- getST x <- dx deptree <- ourGlobalFuns empty x - let dep = [ Symbol.name sy | sy <- keys deptree, g.our sy.name ] + let dep = [ sy.name | sy <- keys deptree, g.our sy.name ] stio (name, dep) -fundep (SymV {name, expr=Nothing}) = stio (name, []) -fundep other = do - g <- getST - E.fatal other.pos (text("fundep: strange symbol: " ++ other.nice g)) +fundep (SymV{name, expr=Nothing}) = stio (name, []) --- find all our 'SymV' symbols -allourvars :: Global -> [Symbol] +allourvars :: Global -> [SymV Global] allourvars g = - let collectedenvs = g.thisTab : [ Symbol.env sy | sy <- values g.thisTab, Symbol.{env?} sy ] - in [ v | env <- collectedenvs, v@SymV {name} <- values env, g.our name] + let collectedenvs = g.thisTab : mapMaybe SymbolT.env' (values g.thisTab) + in [ v | env <- collectedenvs, SymbolT.V v <- values env, g.our v.name ] --- find all 'SymV' symbols, be they ours or not -allvars = do - g <- getST - let envEnvs env = env : [Symbol.env sy | sy <- values env, Symbol.{env?} sy] +allvars :: Global -> [SymV Global] +allvars g = + let envEnvs env = env : mapMaybe SymbolT.env' (values g.thisTab) packEnvs = values g.packages collectedenvs = fold (++) [] (map envEnvs packEnvs) - collectedvars = [ v | env::Symtab <- collectedenvs, v@SymV {name} <- values env] - stio collectedvars + in [ v | env::Symtab <- collectedenvs, SymbolT.V v <- values env ] {-- @@ -998,8 +1016,9 @@ println x = do * yet the actual number of formal arguments derived from the * number of nested lambdas (given in 'Symbol.depth') may be smaller and even 0. -} -returnType (RhoFun _ sig rho) = (tau, sig:sigs) where (tau, sigs) = returnType rho -returnType (RhoTau _ tau) = (tau, []) +returnType :: Rho -> (Tau, [Sigma]) +returnType (RhoT.Fun r) = (tau, r.sigma:sigs) where (tau, sigs) = returnType r.rho +returnType (RhoT.Tau r) = (r.tau, []) {-- @@ -1009,16 +1028,17 @@ returnType (RhoTau _ tau) = (tau, []) * [undefined] if @n@ is greater than the 'arity' of the type. This should never happen after * type check and hints at a compiler error. -} -returnTypeN 0 !rho = (tauRho rho, []) -returnTypeN n (RhoFun _ sig rho) = (r, sig:sigs) where (r, sigs) = returnTypeN (n-1) rho -returnTypeN n rho = Prelude.error "returnTypeN: too many arguments" +returnTypeN :: Int -> Rho -> (Rho, [Sigma]) +returnTypeN 0 !rho = (maybe rho RhoT.Tau $ tauRho rho, []) +returnTypeN n (RhoT.Fun fun) = (r, fun.sigma:sigs) where (r, sigs) = returnTypeN (n-1) fun.rho +returnTypeN _ _ = Prelude.error "returnTypeN: too many arguments" --- tell if a given type is a java type -isJavaType (TCon {name}) = do - sym <- findT name +isJavaType (TauT.Con c) = do + sym <- findT c.name stio (isJust sym.nativ) isJavaType (tapp@TApp _ _) = isJavaType (head tapp.flat) isJavaType (Meta tv) | tv.isFlexi = do @@ -1028,20 +1048,21 @@ isJavaType (Meta tv) | tv.isFlexi = do isJavaType _ = stio false -{-- Arity of a 'Symbol' based on its type -} -arity sym = case returnType (Symbol.typ sym).rho of +{-- Arity of a 'SymVal' based on its type -} +arity :: SymVal Global -> Int +arity sym = case returnType sym.typ.rho of (_, xs) -> length xs -isList (TApp (TCon {name = TName p "[]"}) ty) | p == pPreludeBase = Just ty +isList (TApp (TauT.Con TCon{name = TName p "[]"}) ty) | p == pPreludeBase = Just ty isList _ = Nothing -isUnit (ty@TCon {name = TName p "()"}) | p == pPreludeBase = Just ty +isUnit (ty@TauT.Con TCon{name = TName p "()"}) | p == pPreludeBase = Just ty isUnit _ = Nothing -isMaybe (TApp (TCon {name = TName p "Maybe"}) ty) | p == pPreludeBase = Just ty +isMaybe (TApp (TauT.Con TCon{name = TName p "Maybe"}) ty) | p == pPreludeBase = Just ty isMaybe _ = Nothing @@ -1054,8 +1075,8 @@ isMaybe _ = Nothing isException g (TApp (TApp con ex) ty) | isEither con, isEx ex = Just (ex, ty) where - isEither TCon {name = TName p1 "Either"} = p1 == pPreludeBase - isEither _ = false + isEither (TauT.Con TCon{name = TName p1 "Either"}) = p1 == pPreludeBase + isEither _ = false isEx (TApp (TApp con a) b) = isEither con && isEx a && isThrowable g b isEx x = isThrowable g x isException g _ = Nothing @@ -1066,7 +1087,7 @@ isException g _ = Nothing type _ty_ denotes a sub type of @java.lang.Throwable@ -} isThrowable g ty = case instTauSym ty g of - Just SymT{nativ=Just x} -> x == "java.lang.Throwable" + Just (SymT{nativ=Just x}) -> x == "java.lang.Throwable" || "java.lang.Throwable" `elem` supersOfNativ x g other -> false @@ -1076,10 +1097,10 @@ isThrowable g ty = case instTauSym ty g of If @sym@ is a class member, return the class it belongs to, otherwise 'Nothing'. -} -isClassMember SymV{name} g +isClassMember (SymbolT.V SymV{name}) g | MName{tynm} <- name, found <- Global.findit g tynm, - Just SymC{} <- found = found + Just (SymbolT.C _) <- found = found isClassMember _ _ = Nothing diff --git a/frege/compiler/classes/Nice.fr b/frege/compiler/classes/Nice.fr index 82adecad..a89dc139 100644 --- a/frege/compiler/classes/Nice.fr +++ b/frege/compiler/classes/Nice.fr @@ -90,27 +90,60 @@ instance Nice SName where nice s _ = s.show +instance Nice (SymT Global) where + nice sym = nice $ SymbolT.T sym + nicer sym = nicer $ SymbolT.T sym +instance Nice (SymL Global) where + nice sym = nice $ SymbolT.L sym + nicer sym = nicer $ SymbolT.L sym +instance Nice (SymD Global) where + nice sym = nice $ SymbolT.D sym + nicer sym = nicer $ SymbolT.D sym +instance Nice (SymC Global) where + nice sym = nice $ SymbolT.C sym + nicer sym = nicer $ SymbolT.C sym +instance Nice (SymI Global) where + nice sym = nice $ SymbolT.I sym + nicer sym = nicer $ SymbolT.I sym +instance Nice (SymV Global) where + nice sym = nice $ SymbolT.V sym + nicer sym = nicer $ SymbolT.V sym +instance Nice (SymA Global) where + nice sym = nice $ SymbolT.A sym + nicer sym = nicer $ SymbolT.A sym + + +instance Nice (SymVal Global) where + nice = nice . _.toSymbol + nicer = nicer . _.toSymbol + + +instance Nice (SymMeth Global) where + nice = nice . _.toSymbol + nicer = nicer . _.toSymbol + + instance Nice Symbol where - nice (sym@SymL {alias}) g = category sym g ++ " `" ++ alias.nice g ++ "`" + nice (sym@(SymbolT.L SymL{alias})) g = category sym g ++ " `" ++ alias.nice g ++ "`" nice sym g = category sym g ++ " `" ++ sym.name.nice g ++ "`" - nicer (sym@SymL {alias}) g = category sym g ++ " `" ++ alias.nicer g ++ "`" + nicer (sym@(SymbolT.L SymL{alias})) g = category sym g ++ " `" ++ alias.nicer g ++ "`" nicer sym g = category sym g ++ " `" ++ sym.name.nicer g ++ "`" -protected category (SymT {name}) g = "data type" -protected category (SymD {name}) g = "constructor" -protected category (SymC {name}) g = "class" -protected category (SymI {name}) g = "instance" -protected category (symv@SymV {name,nativ, expr}) g = if isJust nativ then "native " ++ fun else fun +protected category (SymbolT.T _) _ = "data type" +protected category (SymbolT.D _) _ = "constructor" +protected category (SymbolT.C _) _ = "class" +protected category (SymbolT.I _) _ = "instance" +protected category (SymbolT.V SymV{name, nativ, typ}) g = if isJust nativ then "native " ++ fun else fun where fun | MName t b <- name, Just sym <- Global.find g t = category sym g ++ " member " ++ funval | MName _ _ <- name = "member " ++ funval | otherwise = funval funval | isJust nativ = "function" - | ForAll _ RhoFun{} <- symv.typ = "function" + | ForAll _ (RhoT.Fun _) <- typ = "function" | otherwise = "value" -protected category (SymA {name}) g = "type alias" -protected category (SymL {alias}) g = case g.find alias of +protected category (SymbolT.A _) _ = "type alias" +protected category (SymbolT.L SymL{alias}) g = case g.find alias of Just sym -> "alias for " ++ category sym g Nothing -> "alias" diff --git a/frege/compiler/common/Desugar.fr b/frege/compiler/common/Desugar.fr index 7d4755b3..3c3d5dde 100644 --- a/frege/compiler/common/Desugar.fr +++ b/frege/compiler/common/Desugar.fr @@ -81,7 +81,7 @@ type Def = DefinitionS type Exp = ExprS type Pat = ExprS type Item = Token -type Qual = Either (Maybe Pat, Exp) [Def] +type Qual = Either (Maybe Pat, Exp) [LetMemberS] type Guard = (Position, [Qual], Exp) type SigTau = Either SigmaS TauS @@ -160,8 +160,20 @@ opSname t = case t.qual of {-- change the visibility of a definition -} -updVis :: Visibility -> DefinitionS -> DefinitionS -updVis v d = d.{vis = v} +updVis :: Visibility -> DefinitionS -> DefinitionS +updVis _ (d@DefinitionS.Imp _) = d +updVis _ (d@DefinitionS.Fix _) = d +updVis _ (d@DefinitionS.Doc _) = d +updVis v (DefinitionS.Typ d) = DefinitionS.Typ $ d.{vis = v} +updVis v (DefinitionS.Cla d) = DefinitionS.Cla $ d.{vis = v} +updVis v (DefinitionS.Ins d) = DefinitionS.Ins $ d.{vis = v} +updVis v (DefinitionS.Drv d) = DefinitionS.Drv $ d.{vis = v} +updVis v (DefinitionS.Ann d) = DefinitionS.Ann $ d.{vis = v} +updVis v (DefinitionS.Nat d) = DefinitionS.Nat $ d.{vis = v} +updVis v (DefinitionS.Fun d) = DefinitionS.Fun $ d.{vis = v} +updVis v (DefinitionS.Dat d) = DefinitionS.Dat $ d.{vis = v} +updVis v (DefinitionS.Jav d) = DefinitionS.Jav $ d.{vis = v} +updVis _ (d@DefinitionS.Mod _) = d {-- set the visibility of a constructor to 'Private' @@ -172,7 +184,7 @@ updCtr dc = dc.{vis = Private} {-- create an annotation -} -annotation :: SigmaS -> Token -> Def +annotation :: SigmaS -> Token -> AnnDcl annotation sig it = AnnDcl { pos=yyline it, vis=Public, name=it.value, typ=sig, doc=Nothing} -- exprToPat :: Exp -> YYM Global Pat @@ -321,13 +333,15 @@ funhead ex = do {-- - * construct a function definition as list + * construct a function definition -} -fundef lhs pats expr = [FunDcl {vis=Public, lhs, pats, expr, positions=[], doc=Nothing}]; +fundef :: ExprS -> [ExprS] -> ExprS -> FunDcl +fundef lhs pats expr = FunDcl {vis=Public, lhs, pats, expr, positions=[], doc=Nothing} {-- * construct a function with guards -} +fungds :: ExprS -> [ExprS] -> [Guard] -> FunDcl fungds lhs pats gds = let expr = gdsexpr gds -- (gdln,_,_) = head gds @@ -424,6 +438,7 @@ refutable _ = true * > TQ [e | ] L * > = e : L -} +listComprehension :: Position -> ExprS -> [Qual] -> ExprS -> StG ExprS listComprehension pos e [] l2 = YYM.pure (cons `nApp` e `nApp` l2) where f = Position.first pos @@ -469,7 +484,7 @@ listComprehension pos e (q:qs) l2 = case q of calts = if refutable pat then [calt2, calt1, calt3] else [calt2, calt1] ecas = Case CNormal usvar calts hdef = FunDcl {vis = Private, lhs=hvar, pats=[uspat], expr=ecas, positions = [], doc = Nothing} - YYM.pure (Let [hdef] (App hvar (App tlvar xs))) + YYM.pure (Let [LetMemberS.Fun hdef] (App hvar (App tlvar xs))) where rest = listComprehension pos e qs l2 @@ -511,7 +526,7 @@ mkEnumFromTo t1 es t2 ex t3 mkEither :: Position -> TauS -> [TauS] -> TauS mkEither pos tau taus = fold mkE tau taus where - mkE left right = TApp (TApp e left) right + mkE left right = TApp (TApp (TauT.Con e) left) right tok = pos.first.{tokid=CONID, value="Either"} name = With1 (baseTokenAt tok) tok e = TCon{pos=Pos{first=tok, last=tok}, name} @@ -675,12 +690,21 @@ litdec tok = case parseDecimal val of val = (Token.value tok).replaceAll ´[_Zz]´ "" -- just the digits, plz dec x y = pure (Lit (yyline tok) LDec x y) -classContext :: String -> [ContextS] -> String -> StG [SName] -classContext clas ctxs cvar = do +{-- + @classContext ctxs cvar@ raises an error if the super classes (contexts) mention unknown type variables. + + Parameters: + - definitions of super classes + - type variables of the class + Returns: + - names of the super classes + -} +classContext :: [ContextS] -> String -> StG [SName] +classContext ctxs cvar = do g <- getST mapSt (sup g) ctxs where - sup g (Ctx {pos, cname, tau = TVar {var}}) | var == cvar = stio cname + sup g (Ctx {pos, cname, tau=TauT.Var v}) | v.var == cvar = stio cname sup g (Ctx {pos, cname, tau}) = do yyerror pos ("illegal constraint on `" ++ nice tau g ++ "`, only `" ++ cvar ++ "` may be constrained here") @@ -760,8 +784,9 @@ withTau f (Left sig) = do expectTau = withTau return --- promote 'Left' 'TauS' to 'SigmaS' -asSigma = either (ForAll [] . RhoTau []) id - +asSigma :: Either (TauT a) (SigmaT a) -> SigmaT a +asSigma = either (ForAll [] . RhoT.Tau . RhoTau []) id + {-- * @tauToCtx pos tau@ tries to convert a tau to a context list. @@ -777,7 +802,7 @@ asSigma = either (ForAll [] . RhoTau []) id tauToCtx :: TauS -> StG [ContextS] tauToCtx tau | TApp _ _ <- tau = case tau.flat of - (TCon {name = With1{ty, id}} : subtaus) + TauT.Con TCon{name = With1{ty, id}} : subtaus | ty.value==(baseTokenAt id).value, id.value ~ ´^\(,+\)$´ = do ctxss <- mapSt tauCtx subtaus let ctxs = [ ctx | ctxs <- ctxss, ctx <- ctxs ] @@ -792,7 +817,7 @@ tauToCtx tau ++ " and t is a type variable or a type application involving only " ++ "type variables.")) stio [] - tauCtx (TApp (TCon {pos=tpos, name}) tvapp) + tauCtx (TApp (TauT.Con TCon{pos=tpos, name}) tvapp) | isTvApp tvapp = do let pos = tpos.merge (getpos tvapp) stio [Ctx {pos, cname=name, tau = tvapp}] diff --git a/frege/compiler/common/ImpExp.fr b/frege/compiler/common/ImpExp.fr index 1e3ecebe..04547fba 100644 --- a/frege/compiler/common/ImpExp.fr +++ b/frege/compiler/common/ImpExp.fr @@ -43,6 +43,7 @@ import Compiler.types.Positions import Compiler.types.QNames import Compiler.types.Packs import Compiler.types.Global +import Compiler.types.Symbols (SymbolT) import Compiler.enums.SymState import Compiler.types.Strictness import Compiler.Utilities as U() @@ -93,9 +94,9 @@ tauFromA :: JArray TauA -> TauA -> JArray Tau -> Tau tauFromA karray ta tarray = case ta.kind of 0 -> tapp 1 -> tfun - 2 | Just qn <- ta.tcon = TCon pos qn - 3 -> TVar pos (kindFromA karray.[ta.suba] karray tarray) ta.tvar - k | k>=8, k<=13 = TVar pos KType "?" + 2 | Just qn <- ta.tcon = TauT.Con TCon{pos, name=qn} + 3 -> TauT.Var TVar{pos, kind=kindFromA karray.[ta.suba] karray tarray, var=ta.tvar} + k | k>=8, k<=13 = TauT.Var TVar{pos, kind=KType, var="?"} | otherwise = error ("illegal tau kind " ++ show k ++ " in tau") where pos = Position.null @@ -121,8 +122,8 @@ ctRho ct = RhoA{rhofun=ct.rhofun, --- At this point we don't have a sigma array yet, hence we use an array of 'SigmaA' rhoFromA :: JArray TauA -> JArray Tau -> JArray SigmaA -> RhoA -> JArray Rho -> Rho rhoFromA karray tarray sarray ra rarray = case ra of - RhoA{rhofun=false} = RhoTau{context, tau} - RhoA{rhofun=true} = RhoFun{context, sigma, rho} + RhoA{rhofun=false} = RhoT.Tau RhoTau{context, tau} + RhoA{rhofun=true} = RhoT.Fun RhoFun{context, sigma, rho} where context = map (ctxFromA tarray) ra.cont tau = tarray.[ra.rhotau] @@ -203,7 +204,7 @@ exprFromA sarray earray exa = case exa.xkind of pat <- dpat ex <- dex pat <- U.pReturn pat -- make sure it has numbers - syms <- mapSt U.mkLocal (patVars pat) + syms <- mapSt (fmap SymbolT.V . U.mkLocal) (patVars pat) mkStrictPVars pat ex <- U.mapEx true (U.replaceLocals syms) ex stio CAlt {pat, ex} @@ -212,11 +213,10 @@ exprFromA sarray earray exa = case exa.xkind of triples xs = error "list size must be multiple of 3" mklet triples body = do syms ← mapSt letbound triples - syms `foreach` - \sym → changeSym sym.{ - expr ← fmap (>>= U.mapEx true (U.replaceLocals syms))} - ex ← xref body >>= U.mapEx true (U.replaceLocals syms) - return Let{env=map Symbol.name syms, ex, typ=Nothing} + syms `foreach` + \sym -> changeSym $ SymbolT.V sym.{expr <- fmap (>>= U.mapEx true (U.replaceLocals $ map SymbolT.V syms))} + ex ← xref body >>= U.mapEx true (U.replaceLocals $ map SymbolT.V syms) + return Let{env=map _.name syms, ex, typ=Nothing} letbound (varix, sigix, rhsix) = do pat ← pref varix >>= U.pReturn let pvar = patVars pat @@ -224,10 +224,10 @@ exprFromA sarray earray exa = case exa.xkind of [p@PVar{}] → do sym ← U.mkLocal p let bound = sym.{expr = Just (xref rhsix), - typ = if sigix >= 0 - then nSigma sigix + typ = if sigix >= 0 + then nSigma sigix else pSigma} - changeSym bound + changeSym $ SymbolT.V bound return bound _ -> do g <- getST @@ -238,7 +238,7 @@ exprFromA sarray earray exa = case exa.xkind of mkStrictPVars PUser{pat,lazy} | PVar{pos,uid,var} <- pat = do sym <- U.findV (Local {base=var, uid}) - changeSym sym.{state=StrictChecked, strsig=if lazy then U else S[]} + changeSym $ SymbolT.V sym.{state=StrictChecked, strsig=if lazy then U else S[]} | otherwise = mkStrictPVars pat mkStrictPVars PAnn{pat} = mkStrictPVars pat mkStrictPVars PAt{pat} = mkStrictPVars pat diff --git a/frege/compiler/common/JavaName.fr b/frege/compiler/common/JavaName.fr index 40a4497b..cf3c4ee9 100644 --- a/frege/compiler/common/JavaName.fr +++ b/frege/compiler/common/JavaName.fr @@ -30,31 +30,32 @@ javaName g qname = case g.findit qname of For 'SymV', it is guaranteed that the name is of the form (JName pack base) -} -symJavaName g SymV{name=Local uid s} = JName "" (mangled s ++ "$" ++ show uid) +symJavaName g (SymbolT.V SymV{name=Local uid s}) = JName "" (mangled s ++ "$" ++ show uid) symJavaName g sym = case sym of - SymT {name} -> t "T" name - SymD {name = MName tname base} -> case g.findit tname of - Just (SymT {product,enum}) -> if enum + SymbolT.T SymT{name} -> t "T" name + SymbolT.D SymD{name = MName tname base} -> case g.findit tname of + Just (SymbolT.T SymT{product,enum}) -> if enum then memberOf (t "T" tname) (mangled base) else if product then t "T" tname else memberOf (t "T" tname) ("D" ++ mangled base) fail -> Prelude.error "javaName: tname is no SymT" - SymC {name} -> t "C" name - SymI {name} -> t "I" name - SymV {name = MName tname base} = case g.findit tname of - Just (SymT {product=false,enum=false,newt=false,nativ=Nothing}) + SymbolT.C SymC{name} -> t "C" name + SymbolT.I SymI{name} -> t "I" name + SymbolT.V SymV{name = name@(MName tname base)} = case g.findit tname of + Just (SymbolT.T SymT{product=false,enum=false,newt=false,nativ=Nothing}) = memberOf tjname mbase - Just (SymC {sid}) = memberOf (memberOf tjname "I") mbase + Just (SymbolT.C SymC{sid}) + = memberOf (memberOf tjname "I") mbase other = memberOf tjname mbase where tjname = javaName g tname - mbase = mangled sym.name.base - SymV {name = VName pname base} + mbase = mangled name.base + SymbolT.V SymV{name = name@(VName pname base)} | pname == g.thisPack = JName jpack.base vbase | hasJavaImport pname g = JName jpack.base vbase | otherwise = memberOf jpack vbase where - vbase = mangled sym.name.base + vbase = mangled name.base jpack = g.packClass pname other -> Prelude.error ("javaName: strange symbol " ++ nice sym g) where diff --git a/frege/compiler/common/Lens.fr b/frege/compiler/common/Lens.fr new file mode 100644 index 00000000..63ce09a9 --- /dev/null +++ b/frege/compiler/common/Lens.fr @@ -0,0 +1,78 @@ +{-- + The code here is taken and modified from Haskell's "lens" packages. + + lens: + Copyright 2012-2016 Edward Kmett + License BSD-2-Clause + -} +module frege.compiler.common.Lens where + +import frege.data.Monoid (First) +import frege.data.wrapper.Boolean (All, Any) +import frege.data.wrapper.Const (Const) +import frege.data.wrapper.Identity (Identity) + +-- note: currently the compiler fails to infer the correct kinds of @f@ +-- when incrementally compiling, so you have to write type annotations without the aliases +-- see GutHub issue #383 + +type ASetter s t a b = (a -> Identity b) -> s -> Identity t +type ASetter' s a = ASetter s s a a +type Getting r s a = (a -> Const r a) -> s -> Const r s +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t +type Lens' s a = Lens s s a a +type LensLike f s t a b = (a -> f b) -> s -> f t +type LensLike' f s a = LensLike f s s a a +type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t +type Traversal' s a = Traversal s s a a + +-- getters + +-- dealing with Lenses + +view :: Getting a s a -> (s -> a) +view l = Const.get . (l Const) + +views :: Getting r s a -> (a -> r) -> (s -> r) +views l f = Const.get . l (Const . f) + +-- dealing with optional fields (Traversals) + +-- internal note: also used in place of @is@ of @Prism@ because we don't have @Prism@. +has :: Getting Any s a -> s -> Bool +has l = Any.unwrap . views l (\_ -> Any True) + +-- internal note: also used in place of @isn't@ of @Prism@ because we don't have @Prism@. +hasn't :: Getting All s a -> s -> Bool +hasn't l = All.unwrap . views l (\_ -> All False) + +preview :: Getting (First a) s a -> s -> Maybe a +preview l = First.getFirst . views l (First . Just) + +-- setters + +over :: ASetter s t a b -> (a -> b) -> s -> t +over l f = Identity.run . l (Identity . f) + +set :: ASetter s t a b -> b -> s -> t +set l b = Identity.run . l (\_ -> Identity b) + +-- some concrete prisms +-- defined as @Traversal@ because we don't have @Prism@ + +_Left :: Traversal (Either a c) (Either b c) a b +_Left f (Left x) = Left <$> f x +_Left _ (Right x) = pure (Right x) + +_Right :: Traversal (Either c a) (Either c b) a b +_Right f (Right x) = Right <$> f x +_Right _ (Left x) = pure (Left x) + +_Just :: Traversal (Maybe a) (Maybe b) a b +_Just f (Just x) = Just <$> f x +_Just _ Nothing = pure Nothing + +-- identical to @flip (const . pure)@ but added for consistency +_Nothing :: Traversal' (Maybe a) () +_Nothing _ Nothing = pure Nothing +_Nothing _ (Just x) = pure (Just x) diff --git a/frege/compiler/common/PatternCompiler.fr b/frege/compiler/common/PatternCompiler.fr index ba85a913..2d552b71 100644 --- a/frege/compiler/common/PatternCompiler.fr +++ b/frege/compiler/common/PatternCompiler.fr @@ -47,15 +47,12 @@ import Compiler.Utilities as U(freshVar) - -ccSym (vsym@SymV {pos}) +ccSym :: SymV Global -> StG () +ccSym vsym | Just x ← vsym.expr = do nx ← x >>= ccExpr - changeSym vsym.{expr = Just (return nx)} + changeSym $ SymbolT.V vsym.{expr = Just (return nx)} | otherwise = pure () -ccSym sym = do - g <- getST - E.fatal sym.pos (text ("ccSym no SymV : " ++ sym.nice g)) diff --git a/frege/compiler/common/Resolve.fr b/frege/compiler/common/Resolve.fr index 035a2c31..1ee0bb67 100644 --- a/frege/compiler/common/Resolve.fr +++ b/frege/compiler/common/Resolve.fr @@ -6,6 +6,7 @@ import frege.Prelude hiding(break, <+>) import frege.data.TreeMap as TM(TreeMap, lookup, each, insert, union, including, contains, keys, values, fromKeys) import frege.data.List as DL(partitioned, sortBy, minimumBy) import frege.lib.PP(break, fill, text, nest, msgdoc, <+>, <>, DOCUMENT) +import frege.compiler.common.Lens (_Just, preview, set) import frege.compiler.enums.Flags import frege.compiler.enums.Visibility import frege.compiler.types.Positions @@ -33,12 +34,13 @@ canonical g qname = case Global.findit g qname of -- access is forbidden to global private symbols from a different package -accessforbidden we sym - | Local {} <- Symbol.name sym = false - | VName p _ <- Symbol.name sym = sym.vis == Private && p != we - | TName p _ <- Symbol.name sym = sym.vis == Private && p != we - | MName (TName p _) _ <- Symbol.name sym = sym.vis == Private && p != we - | otherwise = Prelude.error ("Strange symbol") +accessforbidden :: Pack -> Symbol -> Bool +accessforbidden we sym = case sym.name of + Local {} -> false + VName p _ -> sym.vis == Private && p != we + TName p _ -> sym.vis == Private && p != we + MName (TName p _) _ -> sym.vis == Private && p != we + _ -> Prelude.error ("Strange symbol") protected resolve :: (String -> QName) -> Position -> SName -> StG [QName] @@ -58,13 +60,13 @@ protected resolve fname pos sname = do foreach ss docWarningSym foreach ss (traceSym sname) foreach ss registerNS - stio (map Symbol.name ss) -- some public ones found + stio (map (_.name) ss) -- some public ones found where - registerNS sym = weUse sym.name + registerNS sym = weUse sym.name docWarningSym :: Symbol -> StG () docWarningSym sym = do g <- getST - docWarning pos (sym.name.nicer g) sym.doc + docWarning pos (sym.name.nicer g) (join $ preview SymbolT._doc sym) traceSym :: SName -> Symbol -> StG () traceSym sname symbol = do @@ -123,13 +125,14 @@ private resolve3 fname pos (Simple Token{value=qs}) = do rs -> stio rs where scope g (MName t _) | Just sym <- g.findit t - = scopefrom [sym.env, g.thisTab] + , Just env <- sym.env' + = scopefrom [env, g.thisTab] scope g _ = scopefrom [g.thisTab] scopefrom envs = fold more [] envs where more :: [String] -> Symtab -> [String] more acc env = foldr (:) acc [ v.name.base | v <- values env, - not (v::Symbol).{clas?} ] + not (Lens.has SymbolT._I v) ] -- T.v T.C N.v N.C N.T private resolve3 _ pos (snm@With1 Token{value=n} Token{value=qv}) = do g <- getST @@ -137,7 +140,7 @@ private resolve3 _ pos (snm@With1 Token{value=n} Token{value=qv}) = do let tname = TName g.thisPack n mname = MName tname v -- T.v or T.C member = g.findit mname - mlist = map (canonical g • Symbol.name) member.toList -- [MName _ _ ] or [] + mlist = map (canonical g . _.name) member.toList -- [MName _ _ ] or [] mbtsym = g.findit tname msts | Just sym <- mbtsym = ms sym | otherwise = [] @@ -193,10 +196,10 @@ private resolve3 _ pos (snm@With1 Token{value=n} Token{value=qv}) = do tsns g = [ n | NSX n <- keys g.namespaces ] ++ [ s.name.base | (s::Symbol) <- values g.thisTab, isTName s.name] ms :: Symbol -> [String] - ms s | s.{env?} = map (QName.base • Symbol.name) (values s.env) + ms s | Just env <- s.env' = map (QName.base . _.name) (values env) | otherwise = [] es :: Symtab -> [String] - es e = map (QName.base • Symbol.name) (values e) + es e = map (QName.base . _.name) (values e) private resolve3 _ pos (snm@With2 Token{value=n} Token{value=t} Token{value=qm}) = do g <- getST @@ -238,13 +241,10 @@ private resolve3 _ pos (snm@With2 Token{value=n} Token{value=t} Token{value=qm}) ns :: Global -> [String] ns g = [ n | NSX n <- keys g.namespaces ] ms :: Symbol -> [String] - ms s | s.{env?} = map (QName.base • Symbol.name) (values s.env) + ms s | Just env <- s.env' = map (QName.base . _.name) (values env) | otherwise = [] - -- es :: Symtab -> [String] - -- es e = map (QName.base • Symbol.name) (values e) - -- all type names from a given package ts :: Symtab -> [String] - ts e = [ x | TName _ x <- map Symbol.name (values e) ] + ts e = [ x | TName _ x <- map (_.name) (values e) ] resolveVName fname pos name = do @@ -258,11 +258,11 @@ resolveVName fname pos name = do -- but only if it is linked from the global level. | Simple{} <- name, -- simple name was resolved MName iname op <- x, -- found member name - Just (SymI{}) <- g.findit iname, -- of an instance + Just (SymbolT.I _) <- g.findit iname, -- of an instance -- same is known globally - Just (SymV{name=cop}) <- g.findit (VName g.thisPack op), + Just (SymbolT.V SymV{name=cop}) <- g.findit (VName g.thisPack op), MName cname _ <- cop, -- and is linked to a member - Just (SymC{}) <- g.findit cname = do -- of a type class + Just (SymbolT.C _) <- g.findit cname = do -- of a type class -- register id changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk name.id) (Right cop)}} @@ -334,7 +334,7 @@ checkXName pos sym name = do Nothing -> stio Nothing -- error should have come from resolve Just it | constructor sym == constructor it = stio (Just it.name) | otherwise = do - E.error pos (fill ([text "expected", text ((Symbol.{name=name} sym).nice g) <> text ","] + E.error pos (fill ([text "expected", text ((set SymbolT._name name sym).nice g) <> text ","] ++ break "but found " ++ [text (it.nice g)])) stio Nothing diff --git a/frege/compiler/common/SymbolTable.fr b/frege/compiler/common/SymbolTable.fr index 00d03b53..90764cc3 100644 --- a/frege/compiler/common/SymbolTable.fr +++ b/frege/compiler/common/SymbolTable.fr @@ -5,6 +5,7 @@ module frege.compiler.common.SymbolTable where import frege.Prelude hiding(error, print, println, break, <+>) import frege.data.TreeMap as TM(TreeMap, lookup, each, insert, union, including, contains, keys, values, fromKeys) import frege.lib.PP(fill, break, pretty, text, nest, msgdoc, <+>, <>, DOCUMENT) +import frege.compiler.common.Lens (preview, set) import frege.compiler.enums.Flags import frege.compiler.enums.SymState import frege.compiler.enums.Visibility @@ -19,51 +20,66 @@ import frege.compiler.common.Annotate(lit) import frege.compiler.common.Errors as E() import frege.compiler.instances.Nicer -private insertGlobal p n s = enterWith insertSym p n s - -private updateGlobal p n s = enterWith updateSym p n s +-- "private" crashes fregedoc +protected data InsUpd = DoInsert | DoUpdate +protected derive Show InsUpd +private enterWith :: InsUpd -> Pack -> String -> Symbol -> StG () private enterWith insupd p n s = do g <- getST -- give me the state case g.packages.lookup p of Just tab -> do - ntab <- insupd tab n s + ntab <- doInsUpd tab n s changeST Global.{packages <- insert p ntab} Nothing -> do let sp = g.unpack p - E.error (Symbol.pos s) (fill ([text "module", text "`" <> text sp <> text "`"] + E.error s.pos (fill ([text "module", text "`" <> text sp <> text "`"] ++ break "does not exist.")) + where + doInsUpd = case insupd of + DoInsert -> insertSym id + DoUpdate -> updateSym id + {-- insert symbol, but make sure it does not exist yet -} -private insertSym :: Symtab -> String -> Symbol -> StG Symtab -private insertSym tab key value = case tab.lookupS key of +private insertSym :: (sym -> Symbol) -> TreeMap String sym -> String -> sym -> StG (TreeMap String sym) +private insertSym toSymbol tab key value = case tab.lookupS key of Nothing -> stio (tab.insertS key value) Just old -> do g <- getST - let on = Symbol.nice old g - qn = Symbol.nice value g - case value of - SymV {pos} -> E.error pos (msgdoc("duplicate function or pattern binding for `" - ++ value.name.nice g ++ "`, already bound on line " - ++ show old.pos)) - _ -> E.error value.pos (msgdoc("redefinition of " ++ on ++ " with " ++ qn - ++ " introduced on line " ++ show old.pos)) + let on = (toSymbol old).nice g + qn = (toSymbol value).nice g + case toSymbol value of + SymbolT.V SymV{pos, name} -> E.error pos $ msgdoc $ "duplicate function or pattern binding for `" + ++ name.nice g ++ "`, already bound on line " + ++ show (toSymbol old).pos + _ -> E.error (toSymbol value).pos $ msgdoc $ "redefinition of " ++ on ++ " with " ++ qn + ++ " introduced on line " ++ show (toSymbol old).pos stio (tab.insertS key value) {-- update symbol, but make sure it does already exist -} -private updateSym :: Symtab -> String -> Symbol -> StG Symtab -private updateSym tab key value = case tab.lookupS key of +private updateSym :: (sym -> Symbol) -> TreeMap String sym -> String -> sym -> StG (TreeMap String sym) +private updateSym toSymbol tab key value = case tab.lookupS key of Just _ -> stio (tab.insert key value) Nothing -> do g <- getST - let qn = Symbol.nice value g - E.error value.pos (fill (break ("cannot update " ++ qn ++ " " ++ show (keys tab)))) + let qn = (toSymbol value).nice g + E.error (toSymbol value).pos (fill (break ("cannot update " ++ qn ++ " " ++ show (keys tab)))) stio (tab.insert key value) +{-- + Assume a Symbol is SymV because it's name is Local + + It is caller's responsibility to ensure that. + -} +private toSymVBecauseLocal :: Symbol -> SymV Global +private toSymVBecauseLocal (SymbolT.V symv) = symv +private toSymVBecauseLocal _ = Prelude.error "thisIsSymVBecauseLocal: not SymV" + {-- * Enter symbol into appropriate symbol table. @@ -77,40 +93,41 @@ private updateSym tab key value = case tab.lookupS key of - an annotation finds that a non native variable is already there -} enter :: Symbol -> StG () -enter sym - | sym.{alias?} = do - g <- getST - let asy = g.find sym.alias - case asy of - Nothing | g.our sym.alias -> do - let sa = sym.nicer g - -- st = sym.alias.nice g - E.fatal sym.pos (fill (break ("can't enter " ++ sa ++ " for unknown target"))) - sonst -> enterOrUpdate - | otherwise = enterOrUpdate +enter sym = case sym of + SymbolT.L syml -> do + g <- getST + let asy = g.find syml.alias + case asy of + Nothing | g.our syml.alias -> do + let sa = sym.nicer g + E.fatal syml.pos (fill (break ("can't enter " ++ sa ++ " for unknown target"))) + sonst -> enterOrUpdate + _ -> enterOrUpdate where - enterOrUpdate - | Local{uid} <- sym.name = do + enterOrUpdate = + case sym.name of + Local{uid} -> do g <- getST uid <- if uid > 0 then return uid else uniqid + let symv = toSymVBecauseLocal sym case g.find sym.name of Nothing - | uid == sym.sid -> do - E.logmsg TRACE3 sym.pos (text("enterLocal: " ++ - show sym.sid ++ - " " ++ sym.nice g ++ " :: " ++ sym.typ.nice g ++ - ", " ++ show sym.state)) - changeST Global.{locals <- TreeMap.insertkvI uid sym} - | otherwise = E.fatal sym.pos (text ("enterLocal: uid=" ++ - show uid ++ ", sid=" ++ show sym.sid ++ " for " ++ show sym.name)) - Just that -> E.error sym.pos (text ("already entered: " ++ nice sym g ++ " with uid " ++ show uid)) - | otherwise = do + | uid == symv.sid -> do + E.logmsg TRACE3 symv.pos (text("enterLocal: " ++ + show symv.sid ++ + " " ++ sym.nice g ++ " :: " ++ symv.typ.nice g ++ + ", " ++ show symv.state)) + changeST Global.{locals <- TreeMap.insertkvI uid symv} + | otherwise = E.fatal symv.pos (text ("enterLocal: uid=" ++ + show uid ++ ", sid=" ++ show symv.sid ++ " for " ++ show sym.name)) + Just that -> E.error symv.pos (text ("already entered: " ++ nice symv g ++ " with uid " ++ show uid)) + _ -> do g <- getST case g.find sym.name of Nothing -> enterByName sym Just that - | SymL{} <- that, SymL{} <- sym, that.alias == sym.alias = pure () -- do nothing - | SymL {alias} <- that, alias.getpack != sym.name.getpack = do + | SymbolT.L SymL{alias=thatAlias} <- that, SymbolT.L SymL{alias=symAlias} <- sym, thatAlias == symAlias = pure () -- do nothing + | SymbolT.L SymL{alias} <- that, alias.getpack != sym.name.getpack = do E.warn sym.pos (fill (break("hiding previously (line " ++ show that.pos ++ ") imported " ++ that.nice g ++ " through " ++ sym.nice g))) @@ -118,63 +135,78 @@ enter sym | otherwise = enterByName sym -- error message follows -changeSym :: Symbol -> StG () -changeSym sym | sym.sid == 0 = do - u <- uniqid - changeSym sym.{sid=u} -changeSym sym = do - g <- getST - E.logmsg TRACE3 sym.pos (fill [text "changeSym", lit sym.sid, text (sym.nice g ++ " :: " ++ - (if sym.{typ?} then sym.typ.nice g else "") ++ ", " ++ - (if sym.{state?} then show sym.state else ""))]) - case sym.name of - TName p b -> updateGlobal p sym.name.key sym - VName p b -> updateGlobal p sym.name.key sym - MName t b -> do - g <- getST - let tsy = g.findit t - case tsy of - Nothing -> do - let qn = t.nice g - E.error sym.pos (fill ([text "namespace", text "`" <> text qn <> text "`"] ++ break "does not exist")) - Just typ | typ.{env?} = do - env <- updateSym typ.env sym.name.key sym - updateGlobal t.pack t.key typ.{env} - | otherwise = E.fatal sym.pos (text "no environment:" <+> text (t.nice g)) - Local uid s -> do - -- g <- getST - when (sym.sid != uid) do - E.fatal sym.pos (text("changeSym: name =" ++ show sym.name - ++ ", sid=" ++ show sym.sid)) - changeST Global.{locals <- TreeMap.updatekvI uid sym} +changeSym :: Symbol -> StG () +changeSym = insUpdSymByName DoUpdate private enterByName :: Symbol -> StG () -private enterByName sym | sym.sid == 0 = do - u <- uniqid - enterByName sym.{sid=u} -private enterByName sym = do +private enterByName = insUpdSymByName DoInsert + + +private insUpdSymByName :: InsUpd -> Symbol -> StG () +private insUpdSymByName insupd sym | sym.sid == 0 = do + u <- uniqid + insUpdSymByName insupd $ set SymbolT._sid u sym +private insUpdSymByName insupd sym = do g <- getST - E.logmsg TRACE3 sym.pos (fill (break ("enterByName " ++ sym.nice g ++ " " ++ show sym.sid ++ " " - ++ (if sym.{expr?} && not (isPSigma sym.typ) - then " :: " ++ sym.typ.nicer g else "")))) + E.logmsg TRACE3 sym.pos $ logMessage g case sym.name of - TName p b -> insertGlobal p sym.name.key sym - VName p b -> insertGlobal p sym.name.key sym + TName p b -> enterWith insupd p sym.name.key sym + VName p b -> enterWith insupd p sym.name.key sym MName t b -> do g <- getST - let tsy = g.findit t - case tsy of + case g.findit t of Nothing -> do let qn = t.nice g - E.error sym.pos (msgdoc("namespace `" ++ qn ++ "` does not exist")) - Just typ | typ.{env?} = do - env <- insertSym typ.env sym.name.key sym - updateGlobal t.pack (t.key) typ.{env} - | otherwise = E.fatal sym.pos (msgdoc ("no environment: " ++ t.nice g)) - Local {} -> do - g <- getST - E.fatal sym.pos (text ("local passed to enterbyname " ++ nice sym g)) + E.error sym.pos $ msgdoc $ "namespace `" ++ qn ++ "` does not exist" + Just (SymbolT.T typt) -> do + env <- enterSym insupd id typt.env sym.name.key sym + enterWith DoUpdate t.pack t.key $ SymbolT.T typt.{env} + Just typ -> case preview SymbolT._meth typ of + Just typMeth -> case SymMeth.fromSymbol sym of + Just ameth -> do + meth <- enterSym insupd SymMeth.toSymbol typMeth sym.name.key ameth + enterWith DoUpdate t.pack t.key $ set SymbolT._meth meth typ + Nothing -> E.error sym.pos $ msgdoc $ sym.nice g ++ " cannot be a member of " ++ typ.nice g + Nothing -> E.fatal sym.pos $ msgdoc $ "no environment: " ++ t.nice g + Local uid _ -> enterLocal insupd sym uid + where + logMessage g = fill $ case insupd of + DoUpdate -> + [ text $ "insUpdSymByName " ++ show insupd + , lit sym.sid + , text $ concat + [ sym.nice g + , " :: " + , maybe "" (\typ -> typ.nice g) $ preview SymbolT._typ sym + , ", " + , maybe "" (\SymV{state} -> show state) $ preview SymbolT._V sym + ]] + DoInsert -> break $ unwords $ + [ "insUpdSymByName" + , show insupd + , sym.nice g + , show sym.sid + ] ++ + case sym of + SymbolT.V SymV{typ} | not (isPSigma typ) -> ["::", typ.nicer g] + _ -> [] + + enterSym :: InsUpd -> (sym -> Symbol) -> TreeMap String sym -> String -> sym -> StG (TreeMap String sym) + enterSym DoInsert = insertSym + enterSym DoUpdate = updateSym + + +private enterLocal :: InsUpd -> Symbol -> Int -> StG () +private enterLocal DoInsert sym _ = do + g <- getST + E.fatal sym.pos (text ("local passed to enterbyname " ++ nice sym g)) +private enterLocal DoUpdate sym uid = do + let symv = toSymVBecauseLocal sym + when (symv.sid != uid) do + E.fatal symv.pos (text("changeSym: name =" ++ show symv.name + ++ ", sid=" ++ show symv.sid)) + changeST Global.{locals <- TreeMap.updatekvI uid symv} {-- create a symbolic link to given qname -} @@ -184,11 +216,7 @@ linkq from sym = linkqv from sym sym.vis --- create a symbolic link to a given 'Symbol' with a given 'Visibility' linkqv :: QName -> Symbol -> Visibility -> StG () -linkqv from sym vis = do - g <- getST - E.logmsg TRACE3 sym.pos (text ("`" ++ from.nice g ++ "` link to " ++ sym.nice g)) - enter (SymL {sid=0, pos=sym.pos, vis, -- doc=Nothing, - name=from, alias=sym.name}) +linkqv from sym vis = linkqvp from sym vis sym.pos -- create a symbolic link to a given 'Symbol' with a given 'Visibility' and 'Position' @@ -196,6 +224,7 @@ linkqvp :: QName -> Symbol -> Visibility -> Position -> StG () linkqvp from sym vis pos = do g <- getST E.logmsg TRACE3 pos (text ("`" ++ from.nice g ++ "` link to " ++ sym.nice g)) - enter (SymL {sid=0, pos=pos, vis, -- doc=Nothing, + enter $ SymbolT.L + (SymL {sid=0, pos=pos, vis, -- doc=Nothing, name=from, alias=sym.name}) diff --git a/frege/compiler/common/Trans.fr b/frege/compiler/common/Trans.fr index 36cef4cc..88e5db87 100644 --- a/frege/compiler/common/Trans.fr +++ b/frege/compiler/common/Trans.fr @@ -33,7 +33,6 @@ import Compiler.types.Patterns import Compiler.enums.Literals import Compiler.common.Types as T(unifySigma) import Compiler.common.Errors as E() --- import Compiler.types.Expression {-- * how often the symbol with 'Symbol.sid' is referenced in 'Expr' @x@ @@ -59,7 +58,7 @@ references sids x = U.foldEx true refs 0 x stio (Right (n + lrefs)) refs n (Let {env,ex}) = do syms <- mapSt U.findV env - srefs <-sequence [ subex | SymV{expr = Just subex} <- syms ] >>= mapSt (references sids) + srefs <-sequence [ subex | SymV{expr = Just subex} <- syms ] >>= mapSt (references sids) lrefs <- references sids ex stio (Right (n + 2*sum srefs + lrefs)) refs n x = do @@ -97,7 +96,7 @@ isEasy :: Global -> Expr -> Bool isEasy g (App a b _) = isSimple g a && isSimple g b isEasy g (Let {env,ex}) = isEasy g ex && all (isEasy g) xprs where - xprs = [ ex | q <- env, sym <- g.findit q, ex <- sym.gExpr g] + xprs = [ ex | q <- env, SymbolT.V sym <- g.findit q, ex <- sym.gExpr g ] isEasy g (Case {ex,alts}) = isSimple g ex && all (isEasy g • _.ex) alts isEasy g (Ifte a b c _) = isSimple g a && isEasy g b && isEasy g c @@ -159,6 +158,7 @@ patternRefutable g p = case p of * A pattern is _refutable_ if the match can possibly fail. Variables and product constructor * applications that contain only irrefutable patterns are irrefutable. -} +patternStrictness :: Pattern -> StG Strictness patternStrictness p = case p of PVar {uid,var} -> do g ← getST @@ -185,7 +185,7 @@ patternStrictness p = case p of if lazy then case pat of PVar{uid, var} -> do v <- U.findV (Local uid var) - when v.strsig.isStrict do changeSym v.{strsig = U} + when v.strsig.isStrict do changeSym $ SymbolT.V v.{strsig = U} pure U other → pure U else if ps == U then stio (S[]) else stio ps @@ -210,7 +210,7 @@ patternStrictness p = case p of * [requires] @name@ must name a member of a data type in @g@ -} productCon (MName tname _) g = case g.findit tname of - Just (SymT {product}) -> product + Just (SymbolT.T (SymT {product})) -> product other -> error ("productCon " ++ tname.nice g ++ " is not a type") productCon _ _ = false @@ -221,7 +221,7 @@ productCon _ _ = false * [requires] @name@ must name a member of a data type in @g@ -} newtypeCon (MName tname _) g = case g.findit tname of - Just (SymT {newt}) -> newt + Just (SymbolT.T (SymT {newt})) -> newt other -> error ("productCon " ++ tname.nice g ++ " is not a type") newtypeCon _ _ = false @@ -278,19 +278,19 @@ patsComplete g ps else missingLiteral ps missing (ps@(PLit {pos}:_)) = missingLiteral ps missing (ps@(PCon {qname}:_)) - | s:_ <- filter (not • (`elem` pnames) • Symbol.name) (cons qname) = Just (mkCon s) + | s:_ <- filter (not . (`elem` pnames) . _.name) (cons qname) = Just (mkCon s) | otherwise = case (filter isJust • map groupcheck) (group ps) of some:_ -> some [] -> Nothing where pnames = map Pattern.qname ps + cons :: QName -> [SymD Global] cons (MName tname _) = case Global.findit g tname of - Just (SymT {env}) -> U.envConstructors env + Just (SymbolT.T (SymT {env})) -> U.envConstructors env _ -> [] cons _ = [] mkCon (SymD {name,flds}) = PCon {pos=Position.null, qname=name, pats = map (const pany) flds} - mkCon _ = error "mkCon: no constructor" group :: [Pattern] -> [(QName, [[Pattern]])] group [] = [] group (PCon {qname,pats}:ps) = (qname, pats:map Pattern.pats same):group other @@ -326,9 +326,9 @@ patsComplete g ps -- constructors :: Pattern -> ([Pattern] -> constructors (lit@PLit {kind=LBool}) = [ lit.{value=s} | s <- ["true", "false"] ] constructors (con@PCon {qname=MName tname _}) = case g.findit tname of - Just (SymT {env}) -> + Just (SymbolT.T (SymT {env})) -> [ PCon con.pos sym.name (take (length sym.flds) dummies) | - (sym::Symbol) <- U.envConstructors env ] where + sym <- U.envConstructors env ] where dummies = repeat (PVar con.pos 0 "_") _ -> [] constructors _ = [] @@ -372,14 +372,14 @@ patsComplete g ps -classMethodOfInstMethod :: Position -> QName -> String -> StG Symbol +classMethodOfInstMethod :: Position -> QName -> String -> StG (SymV Global) classMethodOfInstMethod pos inst base = do g <- getST case g.findit inst of - Just isym | SymI{clas} <- isym = case g.findit clas of - Just csym | SymC{supers} <- csym = do - let sym = head [ sym | c <- clas:supers, SymC{env} <- g.findit c, - sym <- values env, + Just isym | SymbolT.I SymI{clas} <- isym = case g.findit clas of + Just csym | SymbolT.C SymC{supers} <- csym = do + let sym = head [ sym | c <- clas:supers, SymbolT.C SymC{meth} <- g.findit c, + SymMeth.V sym <- values meth, sym.name.base == base ] return sym other -> E.fatal pos (text ("classMethodOfInstMethod: " ++ nice clas g ++ " not a type class.")) @@ -417,24 +417,24 @@ etaExpand (x@Ann {}) = do -- eta (x :: y) = (eta x :: y) etaExpand x = case x.typ of -- all other expressions - Just (ForAll [] (RhoTau ctx tau)) + Just (ForAll [] (RhoT.Tau (RhoTau ctx tau))) | Just (farg, fret) <- tau.getFun = do g ← getST uniq <- uniqid let var = "η" ++ show uniq pos = (getpos x).change VARID var - arg = ForAll [] (RhoTau [] farg) - res = RhoTau [] fret + arg = ForAll [] (RhoT.Tau (RhoTau [] farg)) + res = RhoT.Tau (RhoTau [] fret) sym = U.patLocal pos uniq var y = cleanVarType g x app = App y (Vbl {pos, name=sym.name, typ = Just arg}) (Just (ForAll [] res)) pat = PVar {pos=pos, uid=uniq, var} -- env = insert Nil pat.var (U.patLocal pos pat.var).{sid=uniq} - enter sym.{state=Typechecked, typ=arg} + enter $ SymbolT.V sym.{state=Typechecked, typ=arg} body <- etaExpand app - stio Lam {pat, ex=body, typ = Just (ForAll [] (RhoFun ctx arg res))} + pure Lam {pat, ex=body, typ = Just (ForAll [] (RhoT.Fun (RhoFun ctx arg res)))} | otherwise = stio x - Just (ForAll [] (RhoFun ctx arg res)) = do + Just (ForAll [] (RhoT.Fun (RhoFun ctx arg res))) = do g ← getST uniq <- uniqid sarg <- TCU.skolemise arg @@ -445,8 +445,7 @@ etaExpand x = case x.typ of -- all other expressions iarg = ForAll [] (snd sarg) -- Num t42#a => t42#a -> t42#a y = cleanVarType g x app = App y (Vbl {pos, name=sym.name, typ = Just iarg}) (Just (ForAll [] res)) - -- sym <- U.mkLocal pat - enter sym.{state=Typechecked, typ=arg} + enter $ SymbolT.V sym.{state=Typechecked, typ=arg} body <- etaExpand app stio Lam {pat, ex=body, typ = x.typ} @@ -465,10 +464,10 @@ etaExpand x = case x.typ of -- all other expressions -- see also #294 cleanVarType g (v@Vbl{pos, name, typ = Just sigma}) | not (null sigma.rho.context) = case g.findit name of - Just sym → v.{typ = Just vtyp} + Just (SymbolT.V sym) -> v.{typ = Just vtyp} where - subst = unifySigma g sym.typ sigma - vtyp = ForAll [b | b ← sym.typ.bound, not (TM.member b.var subst)] (T.substRho subst sym.typ.rho) + subst = unifySigma sym.typ sigma + vtyp = ForAll [b | b <- sym.typ.bound, not (TM.member b.var subst)] (T.substRho subst sym.typ.rho) other → error ("etaExpand: variable not found:" ++ nicer name g) cleanVarType g novar = novar @@ -490,7 +489,7 @@ isMeager _ = false --- - native functions or CAFs simpleCAF :: Global -> Bool -> Expr -> Bool simpleCAF g local Vbl{pos, name, typ} = case g.findit name of - Just (sym@SymV{}) + Just (SymbolT.V sym) | Just _ <- sym.nativ = true | otherwise = local || sym.depth == 0 other = false diff --git a/frege/compiler/common/Types.fr b/frege/compiler/common/Types.fr index b7a286e1..40b2c1e5 100644 --- a/frege/compiler/common/Types.fr +++ b/frege/compiler/common/Types.fr @@ -16,12 +16,12 @@ import frege.compiler.classes.Nice(Nice) isFun (ForAll _ rho) g = isRhoFun rho g --- tell if the 'RhoT' represents a function type. -isRhoFun (RhoFun _ _ _) g = true -isRhoFun (RhoTau _ tau) g = isTauFun tau g +isRhoFun (RhoT.Fun _) _ = true +isRhoFun (RhoT.Tau r) g = isTauFun r.tau g --- tell if the 'TauT' represents a function type. -isTauFun fun g | [TCon {name}, _, _] <- Tau.flat fun, name.nice g ~ ´->$´ = true +isTauFun fun g | [TauT.Con c, _, _] <- Tau.flat fun, c.name.nice g ~ ´->$´ = true | otherwise = false @@ -39,14 +39,15 @@ unboundTauTvs g tau = keys (unboundTauTvs' g tau TreeSet.empty) unboundSigmaTvs' g (ForAll{rho}) acc = unboundRhoTvs' g rho acc --- accumulate unbound 'MetaTv's from the components of a 'Rho' -unboundRhoTvs' g RhoFun{context, sigma, rho} acc = - unboundRhoTvs' g rho ( - unboundSigmaTvs' g sigma ( - fold (unboundCtxTvs' g) acc context)) -unboundRhoTvs' g RhoTau{context, tau} acc = - unboundTauTvs' g tau (fold (unboundCtxTvs' g) acc context) +unboundRhoTvs' g (RhoT.Fun r) acc = + unboundRhoTvs' g r.rho $ + unboundSigmaTvs' g r.sigma $ + fold (unboundCtxTvs' g) acc r.context +unboundRhoTvs' g (RhoT.Tau r) acc = + unboundTauTvs' g r.tau (fold (unboundCtxTvs' g) acc r.context) --- accumulate unbound 'MetaTv's of a 'Context' +unboundCtxTvs' :: Global -> TreeSet Int -> Context -> TreeSet Int unboundCtxTvs' g acc Ctx{pos, cname, tau} = unboundTauTvs' g tau acc --- accumulate unbound 'MetaTv's of a 'Tau' @@ -64,8 +65,8 @@ unboundTauTvs' g (Meta m) acc = case m of bs → foldr (unboundTauTvs' g) (acc.insertI uid ()) bs Rigid{} → acc -unboundTauTvs' g TVar{} acc = acc -unboundTauTvs' g TCon{} acc = acc +unboundTauTvs' _ (TauT.Var _) acc = acc +unboundTauTvs' _ (TauT.Con _) acc = acc --- substitute 'MetaTv' unique ids in a 'Sigma' substSigmaUID :: Global -> TreeMap Int Int → Sigma → Sigma @@ -73,11 +74,15 @@ substSigmaUID g m sigma = sigma.{rho ← substRhoUID g m} --- substitute 'MetaTv' unique ids in a 'Rho' substRhoUID :: Global -> TreeMap Int Int → Rho → Rho -substRhoUID g m (r@RhoFun{}) = r.{context ← map (substCtxUID g m), - sigma ← substSigmaUID g m, - rho ← substRhoUID g m} -substRhoUID g m (r@RhoTau{}) = r.{context ← map (substCtxUID g m), - tau ← substTauUID g m} +substRhoUID g m (RhoT.Fun r) = RhoT.Fun + r.{ context <- map (substCtxUID g m) + , sigma <- substSigmaUID g m + , rho <- substRhoUID g m + } +substRhoUID g m (RhoT.Tau r) = RhoT.Tau + r.{ context <- map (substCtxUID g m) + , tau <- substTauUID g m + } --- substitute 'MetaTv' unique ids in a 'Context' substCtxUID :: Global -> TreeMap Int Int -> Context -> Context @@ -87,8 +92,8 @@ substCtxUID g m ctx = ctx.{tau <- substTauUID g m} substTauUID :: Global -> TreeMap Int Int -> Tau -> Tau substTauUID g m tau = case tau of TApp a b → TApp (substTauUID g m a) (substTauUID g m b) - TCon{} → tau - TVar{} → tau + TauT.Con _ -> tau + TauT.Var _ -> tau TSig s → TSig (substSigmaUID g m s) Meta v → case v of Flexi{uid} @@ -137,11 +142,21 @@ instance BetterReadable Tau where subst = zip (unboundTauTvs g s) (smallUIDs g) {-- - * make @RhoFun a b@ to @RhoTau (TFun a b)@ + * make @RhoFun ctxs a b@ to @RhoTau ctxs (TFun a b)@ + * + * For @RhoTau@, this is identity. + * For @RhoFun@, all of the following conditions must hold: + * - @null a.bound@ + * - @a.rho == RhoT.Tau t@ and @null t.context@ + * - @b@ recursively satisfies the above conditions + * + * This in particular means 'tauRho' returns 'Nothing' for higher order functions and Rank-N types. -} -tauRho (RhoFun ctxs (ForAll [] (RhoTau [] a)) rho2) - | RhoTau _ b <- tauRho rho2 = RhoTau ctxs (Tau.tfun a b) -tauRho r = r +tauRho :: Rho -> Maybe (RhoTau QName) +tauRho (RhoT.Tau r) = Just r +tauRho (RhoT.Fun (RhoFun ctxs (ForAll [] (RhoT.Tau (RhoTau [] a))) rho2)) + | Just (RhoTau _ b) <- tauRho rho2 = Just $ RhoTau ctxs (Tau.tfun a b) +tauRho _ = Nothing {-- @@ -151,37 +166,46 @@ tauRho r = r ordinary instance head, e.g. > (A a, B b) ⇒ C (F a b) -} -instanceHead :: QName -> Rho -> Rho -instanceHead clas rho = RhoTau{context=rho.context, tau=TApp tcon tau} +instanceHead :: QName -> RhoTau QName -> RhoTau QName +instanceHead clas rho = rho.{tau <- TApp (TauT.Con tcon)} where - tau = (tauRho rho).tau - tcon = TCon{pos=getpos tau, name=clas} + tcon = TCon{pos=getpos rho.tau, name=clas} --- note: type must not contain bound Metas substSigma :: TreeMap String (TauT t) -> SigmaT t -> SigmaT t substSigma t (ForAll bndrs rho) = ForAll bndrs (substRho t' rho) - where t' = fold TreeMap.delete t (map Tau.var bndrs) + where t' = fold TreeMap.delete t (map _.var bndrs) -substRho t (RhoFun ctx sig rho) = let - ctx' = map (substCtx t) ctx - sig' = substSigma t sig - rho' = substRho t rho - in (RhoFun ctx' sig' rho') -substRho t (RhoTau ctx tau) = RhoTau (map (substCtx t) ctx) (substTau t tau) +substRho :: TreeMap String (TauT t) -> RhoT t -> RhoT t +substRho t (RhoT.Fun r) = RhoT.Fun + r.{ context <- map (substCtx t) + , sigma <- substSigma t + , rho <- substRho t + } +substRho t (RhoT.Tau r) = RhoT.Tau + r.{ context <- map (substCtx t) + , tau <- substTau t + } - -substTau t (tau@TCon{}) = tau +substTau :: TreeMap String (TauT t) -> TauT t -> TauT t +substTau t (tau@TauT.Con _) = tau substTau t (TApp a b) = TApp (substTau t a) (substTau t b) substTau t (typ@Meta _) = typ -- Meta must be unbound -substTau t (typ@TVar {var}) = case TreeMap.lookupS t var of - Just (Meta tv) = Meta tv.{kind ← substKind t var (Meta tv.{kind=KVar})} +substTau t (TauT.Var typ) = case TreeMap.lookupS t typ.var of + Just (Meta tv) = Meta tv.{kind <- substKind t typ.var (Meta tv.{kind=KVar})} Just tau -> tau - Nothing -> typ.{kind ← substKind t var typ.{kind=KVar}} + Nothing -> TauT.Var typ.{kind <- substKind t typ.var $ TauT.Var typ.{kind=KVar}} substTau t (typ@TSig s) = TSig (substSigma t s) +--- 'substTau' restricted to 'TVar'. Note that the type of 'TreeMap' differs +substTVar :: TreeMap String (TVar t) -> TVar t -> TVar t +substTVar t typ = case TreeMap.lookupS t typ.var of + Just tau -> tau + Nothing -> typ.{kind <- substKind (fmap TauT.Var t) typ.var $ TauT.Var typ.{kind=KVar}} + {-- Substitute the 'Tau' in a 'Kind' Because this could be recursive, there is the extra elements, which must be a @@ -207,17 +231,17 @@ substCtx t x = x.{tau <- substTau t} -} tauKind :: Tau -> Kind tauKind app = case app.flat of - TVar{pos, kind, var}:_ → kind - Meta Flexi{uid, hint, kind}:_ → kind - other → KType + TauT.Var TVar{kind}:_ -> kind + Meta Flexi{kind}:_ -> kind + other -> KType --- kindedness of a 'Sigma', based on enclosed 'Tau', see 'tauKind' sigmaKind (ForAll _ rho) = rhoKind rho --- kindedness of a 'Rho', based on enclosed 'Tau', see 'tauKind' --- A 'RhoFun' will always be 'KType', as it is equivalent to application of @(->)@ -rhoKind RhoFun{} = KType -rhoKind RhoTau{tau} = tauKind tau +rhoKind (RhoT.Fun _) = KType +rhoKind (RhoT.Tau r) = tauKind r.tau {-- Alpha conversion of a sigma. @@ -270,24 +294,27 @@ avoidSigma avoid (ForAll tvs rho) = ForAll ntvs (avoidRho (\s -> avoid s || s ` reps = Map.fromList (zip bads binders) -- a substitution for variable names ntvs = map (rnTVar reps) tvs -- renamed affected type variables new = map _.var ntvs -- the variable names of the new Sigma - subst = Map.fromList (zip bads [ tv | tv ← ntvs, tv.var `elem` binders ]) + subst = Map.fromList (zip bads [ TauT.Var tv | tv <- ntvs, tv.var `elem` binders ]) rho' = substRho subst rho -- substitute the new tvars in the rest of the type avoidRho :: (String → Bool) -> Rho -> Rho -avoidRho avoid (rhofun@RhoFun{}) = rhofun.{sigma ← avoidSigma avoid, rho ← avoidRho avoid} -avoidRho avoid (rhotau@RhoTau{}) = rhotau - -rnTVar :: TreeMap String String → Tau → Tau -rnTVar tree (TApp a b) = TApp (rnTVar tree a) (rnTVar tree b) -rnTVar tree (t@TCon{}) = t -rnTVar tree (t@TVar{}) = case lookup t.var tree of - Just v → t.{kind ← rnKind tree, var=v} - Nothing → t -rnTVar tree (t@TSig _) = t -rnTVar tree (t@Meta _) = t +avoidRho avoid (RhoT.Fun r) = RhoT.Fun r.{sigma <- avoidSigma avoid, rho <- avoidRho avoid} +avoidRho _ (rhotau@RhoT.Tau _) = rhotau + +rnTVar :: TreeMap String String -> TVar QName -> TVar QName +rnTVar tree t = case lookup t.var tree of + Just v -> t.{kind <- rnKind tree, var=v} + Nothing -> t + +rnTau :: TreeMap String String -> Tau -> Tau +rnTau tree (TApp a b) = TApp (rnTau tree a) (rnTau tree b) +rnTau _ (t@TauT.Con _) = t +rnTau tree (TauT.Var v) = TauT.Var $ rnTVar tree v +rnTau _ (t@TSig _) = t +rnTau _ (t@Meta _) = t rnKind :: TreeMap String String → Kind → Kind -rnKind tree (KGen ts) = KGen (map (rnTVar tree) ts) +rnKind tree (KGen ts) = KGen (map (rnTau tree) ts) rnKind tree (KApp k1 k2) = KApp (rnKind tree k1) (rnKind tree k2) rnKind tree k = k @@ -312,9 +339,11 @@ varInst subst names = [ tau | nm ← names, tau ← TreeMap.lookupS subst nm ] make @RhoTau (TFun a b)@ into @RhoFun (RhoTau a) (unTau (RhoTau b))@ -} unTau ∷ Rho → Rho -unTau (RhoTau ctx fun) - | Just (a,b) <- fun.getFun = RhoFun ctx (ForAll [] (RhoTau [] a)) (unTau (RhoTau [] b)) -unTau (RhoFun ctx sig rho) = RhoFun ctx sig (unTau rho) +unTau (RhoT.Tau (RhoTau ctx fun)) + | Just (a,b) <- fun.getFun = RhoT.Fun $ RhoFun ctx (ForAll [] (rhotau a)) (unTau (rhotau b)) + where + rhotau x = RhoT.Tau $ RhoTau [] x +unTau (RhoT.Fun (RhoFun ctx sig rho)) = RhoT.Fun $ RhoFun ctx sig (unTau rho) unTau rho = rho @@ -327,34 +356,31 @@ unTau rho = rho * * > unifySigma (forall a b. Maybe a -> [b]) (Maybe Int -> [Float]) ==> [(a,Int), (b, Float)] -} -unifySigma ∷ Global → Sigma → Sigma → TreeMap String Tau -unifySigma g (ForAll [] _) _ = empty -unifySigma g s1 (ForAll _ rho) = unifyRho g empty s1.rho rho - - -unifyRho :: Global -> TreeMap String Tau -> Rho -> Rho -> TreeMap String Tau -unifyRho g t (rho1@RhoFun{}) rho2 - | RhoFun{} <- rho2 = result - | rfun@RhoFun{} <- unTau rho2 = unifyRho g t rho1 rfun - | otherwise = t -- no match - where - result = unifyRho g t2 rho1.rho rho2.rho - t2 = unifyRho g t rho1.sigma.rho rho2.sigma.rho --- rho1 must be a RhoTau as the first clause catches all cases where it is a RhoFun -unifyRho g t rho1 rho2 - | RhoTau{} <- rho2 = unifyTau t rho1.tau rho2.tau - | rtau@RhoTau{} <- tauRho rho2 = unifyRho g t rho1 rtau -unifyRho g t _ _ = t +unifySigma :: Sigma -> Sigma -> TreeMap String Tau +unifySigma (ForAll [] _) _ = empty +unifySigma s1 (ForAll _ rho) = unifyRho empty s1.rho rho + +unifyRho :: TreeMap String Tau -> Rho -> Rho -> TreeMap String Tau +unifyRho t (RhoT.Fun rho1) (RhoT.Fun rho2) = result + where + result = unifyRho t2 rho1.rho rho2.rho + t2 = unifyRho t rho1.sigma.rho rho2.sigma.rho +unifyRho t (RhoT.Fun rho1) rho2 + | rfun@RhoT.Fun _ <- unTau rho2 = unifyRho t (RhoT.Fun rho1) rfun + | otherwise = t -- no match +unifyRho t (RhoT.Tau rho1) rho2 + | Just rtau <- tauRho rho2 = unifyTau t rho1.tau rtau.tau + | otherwise = t unifyTau ∷ TreeMap String Tau → Tau → Tau → TreeMap String (Tau) -unifyTau t (TVar {var}) b = insert var b t +unifyTau t (TauT.Var TVar{var}) b = insert var b t unifyTau t (tau1@TApp a b) (tau2@TApp c d) = unifyApp a c where -- do not match unequals! - unifyApp TVar{} _ + unifyApp (TauT.Var _) _ = unifyTau (unifyTau t a c) b d - unifyApp TCon{name=n1} TCon{name=n2} + unifyApp (TauT.Con TCon{name=n1}) (TauT.Con TCon{name=n2}) | n1 == n2 = unifyTau (unifyTau t a c) b d | otherwise = t unifyApp (TApp x _) (TApp y _) = unifyApp x y @@ -368,8 +394,6 @@ unifyTau t _ _ = t * the bounded variables of @sigma1@ in @sigma2@ * which must be a valid substitution of the former (up to contexts). -} -sigmaInst g sigma1 sigma2 = [ s | Just s <- map (TreeMap.lookupS tree) (Sigma.vars sigma1) ] - where tree = unifySigma g sigma1 sigma2 - - - +sigmaInst :: Sigma -> Sigma -> [Tau] +sigmaInst sigma1 sigma2 = [ s | Just s <- map (TreeMap.lookupS tree) (Sigma.vars sigma1) ] + where tree = unifySigma sigma1 sigma2 diff --git a/frege/compiler/common/UnAlias.fr b/frege/compiler/common/UnAlias.fr index 7ad54c9a..f2aa81b9 100644 --- a/frege/compiler/common/UnAlias.fr +++ b/frege/compiler/common/UnAlias.fr @@ -6,6 +6,7 @@ import frege.Prelude hiding(error, print, println, break, <+>) import frege.data.TreeMap as TM(TreeMap, lookup, each, insert, union, including, contains, keys, values, fromKeys) import frege.compiler.enums.Flags import frege.compiler.types.Positions +import frege.compiler.types.QNames (QName) import frege.compiler.types.Types import frege.compiler.types.Symbols import frege.compiler.types.Global as G @@ -35,15 +36,18 @@ unAlias g tau where -- make sure we work on a 'TauT' 'QName' fake ∷ QNameMatcher a => Global → TauT a → Tau - fake g (TApp a b) = TApp (fake g a) (fake g b) - fake g TVar{pos,var,kind} = TVar Position.null (kmap g kind) var - fake g (Meta Rigid{hint, kind}) = TVar Position.null (kmap g kind) hint + fake g (TApp a b) = TApp (fake g a) (fake g b) + fake g (TauT.Var t) = TauT.Var $ fakeTVar g t + fake g (Meta Rigid{hint, kind}) = TauT.Var $ TVar {pos=Position.null, kind=kmap g kind, var=hint} fake g (Meta x) = case g.bound x of Just tau -> tau - otherwise -> TVar Position.null (kmap g x.kind) ("t" ++ show x.uid) - fake g TCon{pos, name} = TCon{pos, name = fakeQName name} + otherwise -> TauT.Var $ TVar {pos=Position.null, kind=kmap g x.kind, var="t" ++ show x.uid} + fake g (TauT.Con TCon{pos, name}) = TauT.Con TCon{pos, name = fakeQName name} fake g (TSig s) = TSig (fakeSigma g s) + fakeTVar :: QNameMatcher a => Global -> TVar a -> TVar QName + fakeTVar g TVar{var, kind} = TVar{pos=Position.null, kind=kmap g kind, var} + kmap ∷ QNameMatcher a => Global -> KindT a → Kind kmap g (KGen t) = KGen (map (fake g) t) kmap g KType = KType @@ -51,14 +55,14 @@ unAlias g tau kmap g KVar = KVar fakeSigma ∷ QNameMatcher a => Global -> SigmaT a → Sigma - fakeSigma g (ForAll{bound, rho}) = ForAll (map (fake g) bound) (fakeRho g rho) + fakeSigma g (ForAll{bound, rho}) = ForAll (map (fakeTVar g) bound) (fakeRho g rho) fakeRho ∷ QNameMatcher a => Global -> RhoT a → Rho - fakeRho g (r@RhoFun{context, sigma, rho}) - = RhoFun{context = map (fakeCtx g) r.context, - sigma = fakeSigma g r.sigma, + fakeRho g (RhoT.Fun r) = RhoT.Fun + $ RhoFun{context = map (fakeCtx g) r.context, + sigma = fakeSigma g r.sigma, rho = fakeRho g r.rho} - fakeRho g (r@RhoTau{context, tau}) - = RhoTau{context = map (fakeCtx g) context, tau = fake g tau} + fakeRho g (RhoT.Tau r) = RhoT.Tau + $ RhoTau{context = map (fakeCtx g) r.context, tau = fake g r.tau} fakeCtx ∷ QNameMatcher a => Global -> ContextT a → Context fakeCtx g ctx = Ctx{tau = fake g ctx.tau, cname = fakeQName ctx.cname, pos = ctx.pos} @@ -73,26 +77,26 @@ unAlias g tau aliased (tau1@TApp a b) (SymA{pos,name,typ,vars}) = case rho of -- the expansion of the type alias must be more than a tvar - RhoTau [] tau2 | not (isTvApp tau2) -> case unify empty tau2 tau1 of + RhoT.Tau RhoTau{tau=tau2} | not (isTvApp tau2) -> case unify empty tau2 tau1 of Just subst -> Just (substTau env aApp) where env = fmap unAlias subst Nothing -> Nothing _ -> Nothing where rho = typ.rho - vs = map Tau.var vars + vs = map _.var vars aApp :: Tau - aApp = fold TApp (TCon pos name) (map (TVar pos KVar) vs) + aApp = fold TApp (TauT.Con TCon{pos, name}) (map (\var -> TauT.Var TVar{pos, kind=KVar, var}) vs) aliased _ _ = Nothing - aliases = [ sym | any <- values g.thisTab, sym@SymA{} <- g.follow any ] + aliases = [ sym | any <- values g.thisTab, SymbolT.A sym <- g.follow any ] -- substTau env (TFun a b) = TFun (substTau env a) (substTau env b) substTau :: TreeMap String (TauT β) -> TauT β -> TauT β substTau env (TApp a b) = TApp (substTau env a) (substTau env b) - substTau env (TVar{var}) + substTau env (TauT.Var TVar{var}) | Just tau <- lookup var env = tau substTau env tau = tau @@ -102,12 +106,12 @@ unAlias g tau -- t2 <- unify t1 b d -- return t2 unify t (Meta x) (Meta y) | x.uid == y.uid = Just t - unify t TCon{name=name1} TCon{name=name2} | match g name1 name2 = Just t + unify t (TauT.Con c1) (TauT.Con c2) | match g c1.name c2.name = Just t unify t (TApp a b) (TApp c d) = do t1 <- unify t a c t2 <- unify t1 b d return t2 - unify t TVar{var} tau = case lookup var t of + unify t (TauT.Var TVar{var}) tau = case lookup var t of Nothing -> Just (insert var tau t) -- extend substitution Just old -> case unify empty old tau of -- check if previous substitution matches current Just sub | all varSelf (each sub) = Just t @@ -115,8 +119,8 @@ unAlias g tau where -- checks whether each variable would be substituted by itself -- if all substitutions are of this form, then we have type equality - varSelf (s, TVar{var}) = s == var - varSelf _ = false + varSelf (s, TauT.Var TVar{var}) = s == var + varSelf _ = false unify t _ _ = Nothing diff --git a/frege/compiler/gen/java/Common.fr b/frege/compiler/gen/java/Common.fr index e9fb8af8..c0f00cbb 100644 --- a/frege/compiler/gen/java/Common.fr +++ b/frege/compiler/gen/java/Common.fr @@ -5,7 +5,7 @@ module frege.compiler.gen.java.Common where import frege.Prelude hiding (<+>) import Data.TreeMap(values, insert, lookup, TreeMap Map, fromList) -import Data.Bits(BitSet.member) +import Data.Bits(BitSet, BitSet.member) import Lib.PP(pretty, text, <+>, ) import Data.List (zip4) @@ -18,14 +18,14 @@ import Compiler.common.JavaName import Compiler.common.Mangle(mangled) import Compiler.enums.Flags(TRACEZ, TRACEG) -import Compiler.enums.RFlag(RValue) +import Compiler.enums.RFlag(RFlag, RValue) import Compiler.types.Global(StIO, StG, Symbol, SymInfo8, Global(), GenSt(), getST, changeST, uniqid, javaLangNames, primitiveTypes, isReserved) import Compiler.enums.TokenID(QUALIFIER) -import Compiler.types.Symbols(SymD, SymT, SymV, SymC, SymI) +import Compiler.types.Symbols(SymD, SymT, SymV, SymC, SymI, SymMeth, SymVal, SymbolT) import Compiler.types.JNames(JName, memberOf) import Compiler.types.QNames(TName) import Compiler.types.Packs(pPreludeIO, pPreludeArrays, pPreludeList) @@ -33,7 +33,7 @@ import Compiler.types.ConstructorField(ConField) import Compiler.types.Tokens(Token) import Compiler.types.QNames(QName) import Compiler.types.Strictness(Strictness) -import Compiler.types.Types(Sigma, Rho, Tau, Context, MetaTvT, Kind, KindT, +import Compiler.types.Types(Sigma, Rho, RhoT, Tau, TauT, Context, MetaTvT, Kind, KindT, ForAll, RhoFun, RhoTau, TApp, TCon, TVar, Meta, TSig, Ctx) @@ -109,7 +109,7 @@ inThunk t = nativ thunkMarker [boxed t] Check if argument is 'Mutable' @a b@, and if so, return @b@ -} isMutable (TApp (TApp con _) b) - | TCon{name = TName pack "Mutable"} <- con, + | TauT.Con TCon{name = TName pack "Mutable"} <- con, pack == pPreludeIO = Just b | otherwise = Nothing isMutable _ = Nothing @@ -128,8 +128,7 @@ isMutable _ = Nothing arrayTau :: Global -> Tau -> Maybe JType arrayTau g tau | Just t <- isMutable tau = arrayTau g t - | TApp con b <- tau, - TCon{name = TName pack "JArray"} <- con, + | TApp (TauT.Con TCon{name = TName pack "JArray"}) b <- tau, pack == pPreludeArrays = case arrayTau g b of Just (sub@Nativ{typ, gargs}) -> Just Nativ{typ="[]", gargs=[sub], generic = false} _ -> case tauJT g b of @@ -146,24 +145,28 @@ arrayTau g tau argType :: Global -> (JType -> JType) -> Sigma -> JType argType g f = f . sigmaJT g +argTypeB :: Global -> Bool -> Sigma -> JType argTypeB g b = argType g (if b then strict else lazy) {-- - If the 'RValue' flag is on, the return type will be @int@, @String@ or @TList@ - Otherwise, it will be lazy -} +returnJType :: BitSet RFlag -> JType -> JType returnJType mode rjt = if RValue `member` mode then strict rjt else lazy rjt --- a constraint is unsatisfied when its 'Tau' is an application of 'TVar's +unsatisfiedCtx_ :: Context -> Bool unsatisfiedCtx_ Ctx{tau} - | TCon{} ← head tau.flat = false - | otherwise = true + | TauT.Con _ <- head tau.flat = false + | otherwise = true --- Compute the 'JType' for a given 'Sigma' type --- If there are type variables, we have a higher order value which is just 'Something' --- Instantiation of such a value will need a cast! +sigmaJT :: Global -> Sigma -> JType sigmaJT g (ForAll bnd rho) | null bnd = rhojt | otherwise = substJT subst rhojt @@ -180,6 +183,7 @@ sigmaJT g (ForAll bnd rho) a corresponding 'Kinded'. -} -- instKinded KType = Something +instKinded :: Kind -> JType instKinded kind | k > 0 = Func (Something:take k wilds) | otherwise = Something @@ -187,14 +191,15 @@ instKinded kind k = kArity kind --- Compute the 'JType' for a given 'Rho' type -rhoJT g (fun@RhoFun ctxs a b) +rhoJT :: Global -> Rho -> JType +rhoJT g (RhoT.Fun (RhoFun ctxs a b)) | null ctxjts = func | otherwise = lambdaType Func{gargs = ctxjts ++ [func]} where ctxjts = map (ctxJT g) ctxs -- (filter unsatisfiedCtx ctxs) func = lambdaType Func{gargs = map autoboxed [sigmaJT g a, rhoJT g b]} -rhoJT g (RhoTau {context, tau}) +rhoJT g (RhoT.Tau RhoTau{context, tau}) | null ctxs = jtau --Func{} ← jtau = lambdaType Func{gargs = map (ctxJT g) ctxs ++ [jtau]} | otherwise = lambdaType Func{gargs = map (ctxJT g) ctxs ++ [jtau]} @@ -203,12 +208,14 @@ rhoJT g (RhoTau {context, tau}) jtau = tauJT g tau --- Compute the 'JType' for a given 'Context' +ctxJT :: Global -> Context -> JType ctxJT g (Ctx{pos, cname, tau}) | isArrayClassName cname = Constr (javaName g cname) [Nativ "[]" [strict taujt] false, taujt] | otherwise = Constr (javaName g cname) [taujt] where taujt = boxed (tauJT g tau) --- Compute the 'JType' for a given 'Tau' type +tauJT :: Global -> Tau -> JType tauJT g (app@TApp a b) | Just (a,b) ← app.getFun = Func{gargs = [boxed (tauJT g a), autoboxed (tauJT g b)]} @@ -218,8 +225,8 @@ tauJT g (app@TApp a b) -- (_, other) = Func {gargs = [boxed (tauJT g a), autoboxed other]} | Just array <- arrayTau g app = array | otherwise = case app.flat of - (TCon {pos,name}):rest → taujtApp g name rest app - TVar{var,kind}:ts → Kinded{arity = k, + TauT.Con TCon{name}:rest -> taujtApp g name rest + TauT.Var TVar{var,kind}:ts -> Kinded{arity = k, gargs = TArg var : take k (map (boxed . tauJT g) ts ++ wilds)} where k = kArity kind Meta Flexi{kind}:ts → Kinded{arity = k, @@ -230,11 +237,11 @@ tauJT g (app@TApp a b) where k = kArity kind _ → error "empty app.flat" -tauJT g (ty@TCon {pos, name}) = taujtApp g name [] ty +tauJT g (TauT.Con c) = taujtApp g c.name [] -tauJT g (TVar {var=">", kind = KGen ts}) = Wild (SUPER jt) where jt = tauJT g (head ts) -tauJT g (TVar {var="<", kind = KGen ts}) = Wild (EXTENDS jts) where jts = map (tauJT g) ts -tauJT g (TVar {var,kind}) = TArg (var) +tauJT g (TauT.Var TVar{var=">", kind=KGen ts}) = Wild (SUPER jt) where jt = tauJT g (head ts) +tauJT g (TauT.Var TVar{var="<", kind=KGen ts}) = Wild (EXTENDS jts) where jts = map (tauJT g) ts +tauJT _ (TauT.Var TVar{var}) = TArg var tauJT g (Meta meta) = case meta of Flexi{kind=KGen (t:ts)} = tauJT g t @@ -246,35 +253,33 @@ tauJT g (Meta meta) = case meta of tauJT g (TSig sig) = sigmaJT g sig -taujtApp g qname rest app - | Just (sym@SymT{}) <- g.findit qname = case sym of - SymT {product=true, kind, newt=true} -> - let sigmas = [ ConField.typ f | sym@SymD {flds} <- values sym.env, f <- flds ] +taujtApp :: Global -> QName -> [Tau] -> JType +taujtApp g qname rest + | Just (SymbolT.T symt) <- g.findit qname = case symt of + SymT{product=true, kind, newt=true} -> + let sigmas = [ ConField.typ f | SymbolT.D SymD{flds} <- values symt.env, f <- flds ] in case sigmas of - [] -> Prelude.error (nice sym g ++ " has no fields") + [] -> Prelude.error (nice symt g ++ " has no fields") (s:_) -> case (substJT subst . lambdaType . sigmaJT g) s of other → other where - -- k = kArity kind - subst = fromList (zip sym.typ.vars (map (boxed . tauJT g) rest ++ wilds)) - -- rsig = ForAll [] (RhoTau [] app) + subst = fromList (zip symt.typ.vars (map (boxed . tauJT g) rest ++ wilds)) SymT {product,nativ,enum,pur} -- U.pri | Just s <- nativ = if s `elem` primitiveTypes then Nativ {typ=s, gargs=[], generic=true} - else if null sym.gargs + else if null symt.gargs then Nativ {typ=s, gargs=args, generic=false} else Nativ {typ=s, gargs, generic=true} | enum = jtEnum | qname.base == "->" = Func args - | otherwise = Ref {jname = symJavaName g sym, gargs = args} + | otherwise = Ref {jname = symJavaName g $ SymbolT.T symt, gargs = args} where restPlusWilds = (map (boxed . tauJT g) rest ++ wilds) - args = map fst (zip restPlusWilds sym.typ.bound) - subst = fromList (zip sym.typ.vars restPlusWilds) - gargs = mapMaybe (subst.lookup . _.var) sym.gargs - other -> undefined -- can not happen because catched in U.findT + args = map fst (zip restPlusWilds symt.typ.bound) + subst = fromList (zip symt.typ.vars restPlusWilds) + gargs = mapMaybe (subst.lookup . _.var) symt.gargs | otherwise = Prelude.error (nice qname g ++ " not a type") @@ -583,7 +588,7 @@ sComment = (JLocal • JComment) {-- Get 'SymInfo' for given symbol from cache or produce it and put it there -} -symInfo :: Symbol -> StG SymInfo8 +symInfo :: SymVal Global -> StG SymInfo8 symInfo sym = do g <- getST case g.gen.symi8.lookup sym of @@ -596,32 +601,31 @@ symInfo sym = do ) return si other -> case sym of - SymV{} -> do - let (r, as) = U.returnTypeN sym.depth sym.typ.rho + SymVal.V symv -> do + let (r, as) = U.returnTypeN symv.depth symv.typ.rho rjt = lambdaType (rhoJT g r) - sjts = zipWith (argType g) (strictFuns sym.strsig) as + sjts = zipWith (argType g) (strictFuns symv.strsig) as fjts = map lambdaType sjts - si = SI8{returnJT = returnJType sym.rkind rjt, retSig = ForAll [] r, argJTs = fjts, argSigs = as} + si = SI8{returnJT = returnJType symv.rkind rjt, retSig = ForAll [] r, argJTs = fjts, argSigs = as} changeST Global.{gen <- GenSt.{symi8 <- insert sym si}} - E.logmsg TRACEG sym.pos ( - text "put symInfo:" <+> text (nice sym g) <+> text (show sym.sid) + E.logmsg TRACEG symv.pos ( + text "put symInfo:" <+> text (nice sym g) <+> text (show symv.sid) text "si.returnJT" <+> annoG g si.returnJT text "si.retSig " <+> text (nice si.retSig g) -- text " ) - zipWithM_ (\s j → E.logmsg TRACEG sym.pos ( + zipWithM_ (\s j -> E.logmsg TRACEG symv.pos ( text "arg :: " <+> text (nicer s g) <+> text " @@ " <+> text (show j) )) si.argSigs si.argJTs return si - SymD{} -> do - let (r, as) = U.returnType sym.typ.rho + SymVal.D symd -> do + let (r, as) = U.returnType symd.typ.rho rjt = lambdaType (tauJT g r) - sjts = zipWith (argType g) (map (bool strict lazy . ConField.strict) sym.flds) as + sjts = zipWith (argType g) (map (bool strict lazy . ConField.strict) symd.flds) as fjts = map lambdaType sjts - si = SI8{returnJT = rjt, argJTs = fjts, argSigs = as, retSig = ForAll [] (RhoTau [] r)} + si = SI8{returnJT = rjt, argJTs = fjts, argSigs = as, retSig = ForAll{bound=[], rho=RhoT.Tau RhoTau{context=[], tau=r}}} changeST Global.{gen <- GenSt.{symi8 <- insert sym si}} return si - _ -> error ("symInfo for " ++ nicer sym g ++ ", allowed only for functions/variables") --- map a strictness signature to a (infinite) list of 'Bool' boolS :: Strictness -> [Bool] @@ -655,7 +659,6 @@ getArgs ∷ Global → [String] getArgs g = drop used argNames where used = sum (map _.depth g.genEnv) - --- Compute a list of context names we can use for a new function --- This drops the ones from 'ctxNames' that are currently used in outer scopes. @@ -681,7 +684,7 @@ constraintDef g ctx s = -} constraintArg ∷ Global → Context → String → FormalArg constraintArg g ctx s = (def.attr, - (ForAll [] (RhoTau [ctx] ctx.tau)), + (ForAll [] (RhoT.Tau RhoTau{context=[ctx], tau=ctx.tau})), def.jtype, def.name) where !def = constraintDef g ctx s @@ -779,10 +782,9 @@ thunkWhenNeeded jt jx --- the type that remains when something is applied to a function of this type reducedSigma ∷ Global → Sigma → Sigma reducedSigma g ForAll{bound, rho} - | RhoFun{rho=it} ← rho = ForAll [] it - | RhoTau{tau} ← rho, Just (a,b) ← tau.getFun = U.tauAsSigma b - - | otherwise = error ("genExpr.reduceSigma: " ++ nicer rho g) + | RhoT.Fun r <- rho = ForAll [] r.rho + | RhoT.Tau r <- rho, Just (_, b) <- r.tau.getFun = U.tauAsSigma b + | otherwise = error ("genExpr.reduceSigma: " ++ nicer rho g) --- substitute 'Tau' types in 'JType' substJT ∷ Map String JType → JType → JType @@ -821,9 +823,9 @@ specialClassNames = ["ListEmpty", "ListMonoid", "ListSemigroup", "ListView", "Li isSpecialClassName TName{pack, base} = pack == pPreludeList && base `elem` specialClassNames isSpecialClassName other = false ---- checks if a 'Symbol' is a special class +--- checks if a 'SymC' is a special class +isSpecialClass :: SymC g -> Bool isSpecialClass SymC{name} = isSpecialClassName name -isSpecialClass other = false --- names of the type classes for arrays arrayClassNames = ["ArrayElement", "PrimitiveArrayElement"] @@ -831,15 +833,14 @@ arrayClassNames = ["ArrayElement", "PrimitiveArrayElement"] isArrayClassName TName{pack, base} = pack == pPreludeArrays && base `elem` arrayClassNames isArrayClassName _ = false +isArrayClass :: SymC g -> Bool isArrayClass SymC{name} = isArrayClassName name -isArrayClass _ = false --- check if a type class is higher kinded -isHigherKindedClass ∷ Symbols.SymbolT α → Bool -isHigherKindedClass SymC{tau} = case tau.kind of +isHigherKindedClass :: SymC g -> Bool +isHigherKindedClass (SymC{clvar}) = case clvar.kind of KApp{} → true other → false -isHigherKindedClass other = false {-- The (abstract) instance functions for some class members need a @@ -871,14 +872,14 @@ needsUnchecked which cmem jty = case cmem `lookup` haveDoubleCast of Nothing = false --- check if this is an implementation for a class method, and must suppress unsafe cast warnings -unsafeCast :: Global -> Symbol -> Bool +unsafeCast :: Global -> SymV Global -> Bool unsafeCast g sym = case sym.name of MName{tynm, base} - | Just SymI{clas} ← g.findit tynm, - Just SymC{supers} ← g.findit clas, - mems ← [ cmem | Just (symc@SymC{}) ← map g.findit (clas:supers), - cmem ← symc.env.lookupS base, - needsUnchecked snd cmem.name Something] + | Just (SymbolT.I SymI{clas}) <- g.findit tynm + , Just (SymbolT.C SymC{supers}) <- g.findit clas + , mems <- [ cmem | Just (SymbolT.C symc) <- map g.findit (clas:supers) + , cmem <- symc.meth.lookupS base + , needsUnchecked snd cmem.name Something] = not (null mems) _ = false diff --git a/frege/compiler/gen/java/DataCode.fr b/frege/compiler/gen/java/DataCode.fr index 62ed023d..56b32619 100644 --- a/frege/compiler/gen/java/DataCode.fr +++ b/frege/compiler/gen/java/DataCode.fr @@ -20,8 +20,7 @@ import Compiler.gen.java.Bindings(assign) import Compiler.enums.Flags(TRACEG) --- Generate code for @data@ definitions -dataCode :: Symbol → StG [JDecl] --- dataCode (sym@SymT{}) = return [] +dataCode :: SymT Global -> StG [JDecl] {-- Enumerations (that is, data types where no constructor has any fields) @@ -45,7 +44,7 @@ dataCode (sym@SymT{enum = true}) = do constrs = [JMember{attr = attrTop, jtype = jtEnum, name = (javaName g s.name).base, - init = Just (JAtom (show s.cid))} | s@SymD{} ← values sym.env] + init = Just (JAtom (show s.cid))} | SymbolT.D s <- values sym.env] comment = JComment ("data " ++ sym.name.base ++ " :: " ++ show sym.kind) pure [comment, result] @@ -80,7 +79,7 @@ dataCode (sym@SymT{ product = true }) = do g ← getST E.logmsg TRACEG sym.pos (text ("dataCode for product " ++ nicer sym g)) - con <- conDecls $ head [ con | con@SymD{} ← values sym.env ] + con <- conDecls $ head [ con | SymbolT.D con <- values sym.env ] sub <- subDecls sym let jtype = rhoJT g sym.typ.rho @@ -134,10 +133,10 @@ dataCode (sym@SymT{ nativ = Nothing, product = false, newt = false }) = do E.logmsg TRACEG sym.pos (text ("dataCode for native " ++ nicer sym g)) -- constructors - let csyms = [ con | con@SymD{} ← values sym.env ] + let csyms = [ con | SymbolT.D con <- values sym.env ] - sub ← subDecls sym - cons ← mapM conDecls csyms + sub <- subDecls sym + cons <- mapM conDecls csyms let jtype = rhoJT g sym.typ.rho kindeds = map (asKinded jtype) [1..kArity sym.kind] @@ -148,7 +147,7 @@ dataCode (sym@SymT{ nativ = Nothing, product = false, newt = false }) = do -- public isXXX() { return null; } asMethod what con = JMethod{attr=attrs [JPublic], gvars=[], - jtype = variantType g jtype con, + jtype = variantType g jtype (SymbolT.D con), name = conGetter con.name, args = [], body = JBlock{stmts = [JReturn (JAtom what)]}} @@ -182,7 +181,7 @@ dataCode (sym@SymT{ nativ = Just _ }) = do -- nati g ← getST E.logmsg TRACEG sym.pos (text ("dataCode for native " ++ nicer sym g)) - sub ← subDecls sym + sub <- subDecls sym -- lazyDefs <- lazyDeclarations vals let result @@ -223,7 +222,7 @@ dataCode sym = do Of course, Java forbids this cast. It works by first casting to @Object@, yet it raises the "unchecked" warning. Hence we do it with magic. -} -simsalabim ∷ Global → Symbol → JType → [JTVar] → JDecl +simsalabim :: Global -> SymT Global -> JType -> [JTVar] -> JDecl simsalabim g sym jt gvars = JMethod{attr = attrs [JUnchecked, JPublic, JFinal], gvars = unusedvars, jtype = newtyp, @@ -235,9 +234,9 @@ simsalabim g sym jt gvars = JMethod{attr = attrs [JUnchecked, JPublic, JFinal], newtyp = jt.{gargs=map (TArg . _.var) unusedvars} -- just give the type variables different names for the return type, -- as this is an instance method - unusedvars = targs g sym.typ.{bound = zipWith _.{var=} + unusedvars = targs g sym.typ.{bound = zipWith _.{var=} sym.typ.bound - (filter (`notElem` sym.typ.vars) (allBinders g)) + (filter (`notElem` sym.typ.vars) (allBinders g)) } {-- Generate the method that coerces from a 'Kinded' representation @@ -263,10 +262,10 @@ coerceDecl gvars jt = - a private java constructor that initializes the arguments - a public "mk" method with the same argument list as the constructor -} -conDecls ∷ Symbol → StG [JDecl] -conDecls (sym@SymD{}) = do - si ← symInfo sym - g ← getST +conDecls :: SymD Global -> StG [JDecl] +conDecls sym = do + si <- symInfo (SymVal.D sym) + g <- getST let arity = length sym.flds decls = [comment, constr, constructorMethod sym.cid] ++ (if arity == 0 then [single, singleton] else [make]) @@ -274,7 +273,7 @@ conDecls (sym@SymD{}) = do ++ members comment = JComment (nice sym g) ttype = si.returnJT - ctype = variantType g si.returnJT sym + ctype = variantType g si.returnJT (SymbolT.D sym) constrargs = argDefs attrFinal si (getArgs g) args = take arity (map JAtom (getArgs g)) constr = JConstr {attr = attrs [JPrivate], @@ -305,7 +304,6 @@ conDecls (sym@SymD{}) = do body = JBlock [JReturn JCast{jt=ttype, jex=JAtom single.name}]} members = zipWith mkMember namedfields constrargs return decls -conDecls _ = error "no SymD" --- generate --- >final public int constructor() { return n; } @@ -333,15 +331,9 @@ asThunkMethod t = atomMethod "asThunk" (inThunk t) "null" Generate the code for everything in a namespace of a type that is not a constructor. --} -subDecls ∷ Symbol → StG [JDecl] -subDecls (sym@SymT{}) = do +subDecls :: SymT Global -> StG [JDecl] +subDecls sym = do g ← getST E.logmsg TRACEG sym.pos (text ("subDecls for " ++ nicer sym g)) - let subdefs = filter (not . _.{flds?}) (values sym.env) -- no constructors + let subdefs = mapMaybe SymMeth.fromSymbol (values sym.env) -- no constructors concat <$> mapM (varCode emptyTree) subdefs -subDecls sym = do - g ← getST - E.fatal sym.pos ( - text "subDecls: argument is " - <+> text (nice sym g) - ) \ No newline at end of file diff --git a/frege/compiler/gen/java/InstanceCode.fr b/frege/compiler/gen/java/InstanceCode.fr index e5d3e4a4..eb4775d5 100644 --- a/frege/compiler/gen/java/InstanceCode.fr +++ b/frege/compiler/gen/java/InstanceCode.fr @@ -16,18 +16,18 @@ import Compiler.enums.TokenID(VARID) import Compiler.types.AbstractJava import Compiler.types.Symbols import Compiler.types.Global -import Compiler.types.Types(Ctx, TVar, Tau, SigmaT, TauT, RhoT, Kind, KindT, pSigma) +import Compiler.types.Types(Ctx, TVar, TauT, SigmaT, RhoT, RhoTau, KindT, pSigma) import Compiler.types.Expression import Compiler.types.QNames(QName) import Compiler.types.Packs(pPreludeList) import Compiler.types.JNames(JName) import Compiler.common.Errors as E() -import Compiler.common.Types as CT(substSigma, substRho, substTau, tauRho, - sigmaKind, tauKind) +import Compiler.common.Types as CT(substRho, substTVar, tauRho) import Compiler.common.Binders(allBinders) import Compiler.common.SymbolTable(changeSym) import Compiler.common.JavaName(symJavaName, javaName) +import Compiler.common.Lens(over, set, view) import Compiler.classes.Nice (nice, nicer, nicest) @@ -74,16 +74,13 @@ import Compiler.gen.java.VarCode(varCode, compiling, genExpression, genExpr) the class operations, like (++) and 'length'. -} -classCode ∷ Symbol → StG [JDecl] - - - -classCode (sym@SymC{tau = TVar{var,kind}}) = do -- type class +classCode :: SymC Global -> StG [JDecl] +classCode (sym@SymC{clvar = TVar{var,kind}}) = do -- type class g <- getST - let vals = values sym.env + let vals = map symMethAsSymV $ values sym.meth special = isSpecialClass sym abstrFuns ← mapSt (abstractFun sym) vals - let name = (symJavaName g sym).base + let name = (symJavaName g (SymbolT.C sym)).base -- this = Constr (JName "" name) gargs gvars = if special then [targ g var KType] @@ -101,57 +98,56 @@ classCode (sym@SymC{tau = TVar{var,kind}}) = do -- type class defs = concat abstrFuns} stio [JComment (nice sym g), result] ---- If given something else than a type class this is a fatal compiler error -classCode sym = do - g ← getST - E.fatal sym.pos ( - text "classCode: argument is " - <+> text (nice sym g) - ) - --- Prepare abstract functions of special classes for code generation --- Returns the compiler state prior to this action, which must be restored afterwards. lowerKindSpecialClasses = do g ← getST - let items = [ (c,v) | n ← specialClassNames, - c ← g.findit (TName pPreludeList n), - v ← Map.values c.env ] - mapM_ (uncurry lowerKindAbstractFun) items + let items = [ (c,v) | n <- specialClassNames + , c <- findSpecialClass g n + , v <- notLink g <$> Map.values c.meth ] + mapM_ (\(c, v) -> lowerKindAbstractFun c v) items return g - -lowerKindAbstractFun ∷ Symbol → Symbol → StG () + where + findSpecialClass g n = case g.findit (TName pPreludeList n) of + Just (SymbolT.C symc) -> Just symc + Just _ -> error $ "lowerKindSpecialClasses: non-class name in specialClassNames: " ++ show n + Nothing -> Nothing + notLink _ (SymMeth.V s) = SymVal.V s + notLink g (SymMeth.L s) = error $ "lowerKindSpecialClasses: SymL in special class: " ++ s.nice g + +lowerKindAbstractFun :: SymC Global -> SymVal Global -> StG () lowerKindAbstractFun symc sym = do - let classvar = symc.tau.var - newsym = sym.{typ <- lowerKind classvar} - changeSym newsym + let classvar = symc.clvar.var + newsym = over SymVal._typ (lowerKind classvar) sym + changeSym newsym.toSymbol -- force syminfo to regenerate information, if already present changeST Global.{gen ← _.{symi8 ← delete sym}} return () where lowerKind cv sigma = sigma.{rho <- lowerRhoKind cv} - lowerRhoKind cv (rho@RhoFun{}) = rho.{sigma ← lowerKind cv, rho ← lowerRhoKind cv} - lowerRhoKind cv (rho@RhoTau{}) = rho.{tau ← lowerTauKind cv} - lowerTauKind cv (TSig s) = TSig . lowerKind cv $ s + lowerRhoKind cv (RhoT.Fun rho) = RhoT.Fun rho.{sigma <- lowerKind cv, rho <- lowerRhoKind cv} + lowerRhoKind cv (RhoT.Tau rho) = RhoT.Tau rho.{tau <- lowerTauKind cv} + lowerTauKind cv (TSig s) = TSig . lowerKind cv $ s lowerTauKind cv (app@TApp a b) = case app.flat of - TVar{pos, kind, var}:_ | var == cv = TVar{pos, kind=KType, var} - other = TApp (lowerTauKind cv a) (lowerTauKind cv b) - lowerTauKind cv t = t + TauT.Var t:_ | t.var == cv = TauT.Var t.{kind=KType} + _ = TApp (lowerTauKind cv a) (lowerTauKind cv b) + lowerTauKind _ t = t --- declare abstract class Member function -abstractFun ∷ Symbol → Symbol → StG [JDecl] -abstractFun symc (sym@SymV{}) = do +abstractFun :: SymC Global -> SymV Global -> StG [JDecl] +abstractFun symc sym = do g <- getST - si <- symInfo sym + si <- symInfo (SymVal.V sym) let !classCtx = Ctx {pos=symc.pos, - cname = Symbol.name symc, - tau = Symbol.tau symc } + cname = symc.name, + tau = TauT.Var symc.clvar } !ctxs = filter (not . sameCtx classCtx) sym.typ.rho.context -- special = isSpecialClass symc arrays = isArrayClass symc -- are we compiling one of the array classes? - gvars = targs g sym.typ.{bound ← filter ((!= symc.tau.var) . _.var)} + gvars = targs g sym.typ.{bound <- filter ((!= symc.clvar.var) . _.var)} let formalctxs = zipWith (constraintArg g) ctxs (getCtxs g) @@ -167,23 +163,12 @@ abstractFun symc (sym@SymV{}) = do formalargs = argDefs attrFinal lazysi (getArgs g) let !result = JMethod {attr = attrs [JPublic], gvars, - jtype = (strict . adapt . tauJT g . fst . returnType . _.{context=ctxs} . _.rho) sym.typ, - name = latinF ++ (symJavaName g sym).base, + jtype = (strict . adapt . tauJT g . fst . returnType . set RhoT._context ctxs . _.rho) sym.typ, + name = latinF ++ (symJavaName g (SymbolT.V sym)).base, args = formalctxs ++ formalargs, body = JEmpty} pure [JComment ((nicer sym g) ++ " :: " ++ nicer sym.typ g), result] -abstractFun symc symx = do - g ← getST - E.fatal symx.pos ( - text "abstractFun: argument is " - <+> text (nice symx g) - <+> text " for " - <+> text (nice symc g) - ) - - - {-- Code for instances @@ -209,7 +194,8 @@ abstractFun symc symx = do > public Eq_Maybe(CEq ctx) { ... } > } -} -instanceCode (sym@SymI {sid}) = do -- instance definition +instanceCode :: SymI Global -> StG [JDecl] +instanceCode sym = do -- instance definition g <- getST csym <- findC sym.clas @@ -217,24 +203,25 @@ instanceCode (sym@SymI {sid}) = do -- instance definition special = isSpecialClass csym -- the functions we must provide in the instance superMethods = [ m.name.base | c <- classes, - SymC{env} <- g.findit c, - m@SymV{} <- values env ] + SymbolT.C SymC{meth} <- g.findit c, + SymMeth.V m <- values meth ] -- links in types that point to instance members of this class and its superclasses -- The goal is to have (links to) implementations of all super class methods. - methods2 = case instTSym (Symbol.typ sym) g of - Just (tsym@SymT {pos}) -> [ alias | - SymL {name, alias} <- values tsym.env, alias.{tynm?}, -- links + methods2 = case instTSym sym.typ g of + Just tsym -> [ alias | + SymbolT.L SymL{name, alias} <- values tsym.env, + alias.{tynm?}, -- links alias `notElem` methods1, -- avoid duplicates alias.base `elem` superMethods, -- mentioning one of our methods name.base `notElem` map QName.base methods1, - SymI {clas} <- g.findit alias.tynm, -- pointing to an instance - SymC {supers} <- g.findit clas, -- of a class that is in our hierarchy + SymbolT.I SymI{clas} <- g.findit alias.tynm, -- pointing to an instance + SymbolT.C SymC{supers} <- g.findit clas, -- of a class that is in our hierarchy clas `elem` classes || any (`elem` classes) supers] _ -> error "unexpected result from instTSym" - methods1 = map Symbol.name (values sym.env) + methods1 = map (_.name) (values sym.meth) -- methods of super classes that are implemented in the type itself - methods3 = case instTSym (Symbol.typ sym) g of - Just (tsym@SymT {pos}) -> [ sym.name | + methods3 = case instTSym sym.typ g of + Just tsym -> [ sym.name | sym <- values tsym.env, sym.name.base `elem` superMethods, sym.name.base `notElem` methods] where @@ -242,18 +229,18 @@ instanceCode (sym@SymI {sid}) = do -- instance definition _ -> error "unexpected result from instTSym" methods = methods1 ++ methods2 ++ methods3 - let vals = values sym.env + let vals = values sym.meth let constraints = zipWith (constraintDef g) sym.typ.rho.context (getCtxs g) constrargs = zipWith (constraintArg g) sym.typ.rho.context (getArgs g) - let instName = symJavaName g sym - instjt = boxed (rhoJT g sym.typ.rho.{context=[]}) + let instName = symJavaName g $ SymbolT.I sym + instjt = boxed (rhoJT g (set RhoT._context [] sym.typ.rho)) array = Nativ{typ="[]", gargs=[strict instjt], generic=false} rawinst = rawType instjt jtype = Ref instName [] - etype = Ref (symJavaName g csym) (if special + etype = Ref (symJavaName g $ SymbolT.C csym) (if special then [rawinst] else if isArrayClass csym then [array, instjt] @@ -275,7 +262,7 @@ instanceCode (sym@SymI {sid}) = do -- instance definition | null constrargs, special = [JMethod{ attr = attrs [JUnchecked, JPublic, JFinal, JStatic], gvars = [JTVar{var="r", bounds=UNBOUNDED}], - jtype = Constr (symJavaName g csym) [TArg "r"], + jtype = Constr (symJavaName g $ SymbolT.C csym) [TArg "r"], name = "mk", args = [], body = JBlock{stmts = stmtssp}}] @@ -290,7 +277,7 @@ instanceCode (sym@SymI {sid}) = do -- instance definition where gargs = map (TArg . _.var) gvars stmts = [JReturn (JCast jtype.{gargs} (JAtom "it"))] - stmtssp = [JReturn (JCast (Constr (symJavaName g csym) [TArg "r"]) (JAtom "it"))] + stmtssp = [JReturn (JCast (Constr (symJavaName g $ SymbolT.C csym) [TArg "r"]) (JAtom "it"))] singleton | null constrargs = [JMember{attr = attrTop, jtype = jtype.{gargs}, name="it", @@ -300,14 +287,14 @@ instanceCode (sym@SymI {sid}) = do -- instance definition gargs = take (length gvars) wilds -- check for implementation restriction - let k = kArity csym.tau.kind + let k = kArity csym.clvar.kind kindJT = (("frege.run."++) . show . _.jname . rawType $ Kinded k []) jt = head etype.gargs implementationRestriction = not special && isHigherKindedClass csym && not (implementsKinded g k jt) when (implementationRestriction) do case jt of Nativ{typ} | not (subTypeOf g typ kindJT) = E.error sym.pos ( - text "The type " <+> nicest g sym.typ.rho.{context=[]} + text "The type " <+> nicest g (set RhoT._context [] sym.typ.rho) <+> text "cannot be an instance of" <+> text (csym.name.nicer g) <+/> text "because the corresponding java type" <+> text jt.show <+/> text "does not implement the interface " <+> text kindJT <> text "," @@ -315,7 +302,7 @@ instanceCode (sym@SymI {sid}) = do -- instance definition ) other → E.error sym.pos ( text "Implementation restriction: the type" - <+> nicest g sym.typ.rho.{context=[]} + <+> nicest g (set RhoT._context [] sym.typ.rho) <+> text "cannot be an instance of" <+> text (csym.name.nicer g) <+/> text "because attempting to represent" <+/> text "it as a higher kinded type" @@ -346,28 +333,22 @@ instanceCode (sym@SymI {sid}) = do -- instance definition ++ concat instImpls} pure [JComment (nice sym g ++ " :: " ++ nice sym.typ g), result] ---- If given something else than a type class this is a fatal compiler error -instanceCode sym = do - g ← getST - E.fatal sym.pos ( - text "instanceCode: argument is " - <+> text (nice sym g) - ) - -instFun :: Symbol → Symbol → QName → StG JDecl +instFun :: SymC Global -> SymI Global -> QName -> StG JDecl instFun symc symi mname = do - g ← getST - sym ← findV mname + g <- getST + sym <- findV mname let classnames = symc.name:symc.supers special = isSpecialClass symc - cmems = [ m | cln ← classnames, SymC{env} ← g.findit cln, - m ← env.lookupS mname.base ] + cmems = [ symMethAsSymV m + | cln <- classnames + , SymbolT.C SymC{meth} <- g.findit cln + , m <- meth.lookupS mname.base ] case cmems of [] → E.fatal symi.pos (text "trying to instFun " <+> text (nicer mname g) <+> text " but no class member found.") cmem:_ → do -- replace symc with class where method was introduced - symc ← findC cmem.name.tynm + symc <- findC cmem.name.tynm E.logmsg TRACEG symi.pos (text "instFun" <+> text (nicer sym g) <+> text "for" <+> text (nicer cmem g)) -- We need to tweek the types a bit so that java type variables won't conflict. @@ -390,27 +371,27 @@ instFun symc symi mname = do text (nicer sym.name g) <+> text " :: " <+> text (nicer sym.typ g) text (nicer cmem.name g) <+> text " :: " <+> text (nicer cmem.typ g) ) - let otvs = filter ((`elem` symi.typ.vars) . Tau.var) cmem.typ.tvars + let otvs = filter ((`elem` symi.typ.vars) . _.var) cmem.typ.tvars orep = filter (`notElem` (cmem.typ.vars)) (allBinders g) - substBound :: TreeMap String Tau -> [Tau] -> [Tau] + substBound :: TreeMap String (TVar QName) -> [TVar QName] -> [TVar QName] substBound subst xs = map (\tv -> maybe tv _.{kind=tv.kind} (lookup tv.var subst)) xs subst1 = Map.fromList [ (tv.var, tv.{var=s}) | (s,tv) ← zip orep otvs] - typ1 = ForAll (substBound subst1 cmem.typ.bound) (substRho subst1 cmem.typ.rho) + typ1 = ForAll (substBound subst1 cmem.typ.bound) (substRho (fmap TauT.Var subst1) cmem.typ.rho) E.logmsg TRACEG symi.pos ( text "(1) renamed type :: " <+> text (nicer typ1 g) ) - let cvar = substTau subst1 symc.tau + let cvar = substTVar subst1 symc.clvar withoutCVar = filter ((!=) cvar.var . _.var) E.logmsg TRACEG symi.pos ( text "(2) class var is now " <+> text (nicer cvar g) ) let classCtx = Ctx {pos=symc.pos, cname = symc.name, - tau = cvar } + tau = TauT.Var cvar } ctxs = filter (not . sameCtx classCtx) typ1.rho.context - rho3 = typ1.rho.{context = ctxs} + rho3 = set RhoT._context ctxs typ1.rho bound3 = withoutCVar typ1.bound typ3 = ForAll bound3 rho3 E.logmsg TRACEG symi.pos ( @@ -422,13 +403,12 @@ instFun symc symi mname = do text "(3j) java type of (3) :: " <+> text (show jty3)) let othertv = head (filter ((!=cvar.var) . _.var) typ3.tvars) - instTau0 = (tauRho symi.typ.rho.{context=[]}).tau - instTau = if special then TApp instTau0 othertv else instTau0 + instTau0 = (symItau symi).tau + instTau = if special then TApp instTau0 (TauT.Var othertv) else instTau0 subst4 = Map.singleton cvar.var instTau methty = ForAll typ3.bound (substRho subst4 typ3.rho) raw = if special then rawType else id instjt = (boxed . lambdaType . tauJT g) instTau - -- jsubst = Map.singleton cvar.var instjt jsubstr = Map.singleton cvar.var (raw instjt) jty4m = boxed (rhoJT g methty.rho) -- substJT jsubstr (lambdaType jty3) jty4r = substJT jsubstr (lambdaType jty3) @@ -456,7 +436,7 @@ instFun symc symi mname = do let fakety = methty.{ bound ← (symi.typ.bound ++), -- make sure ctx will be recognized - rho ← _.{context ← (symi.typ.rho.context++)}} + rho <- over RhoT._context (symi.typ.rho.context++)} E.logmsg TRACEG symi.pos ( text "(5) add extra contexts to (4), final type :: " <+> text (nicer fakety g) @@ -512,7 +492,7 @@ instFun symc symi mname = do | (uid, sig, atom, jt) ← zip4 uids sigs atoms rgargs, ex = JCast (lazy jt) (JCast Something atom) ] | otherwise = binds - result ← compiling sym.{typ=fakety} (genExpr true retJT ex rawbinds) + result <- compiling sym.{typ=fakety} (genExpr true retJT ex rawbinds) let rex | special, retJTr != retJT = JCast retJTr (JCast Something result.jex) | otherwise = result.jex @@ -536,12 +516,12 @@ instFun symc symi mname = do -- finally make the function pure JMethod{attr = if special || unchecked rex - || needsUnchecked fst cmem.name (Map.lookupDefault Something cvar.var jsubstr) + || needsUnchecked fst cmem.name (Map.lookupDefault Something cvar.var jsubstr) then attrs [JUnchecked, JPublic, JFinal, JOverride] else attrs [JPublic, JFinal, JOverride], gvars = targs g methty, jtype = retJTr, - name = latinF ++ (symJavaName g sym).base, + name = latinF ++ (symJavaName g (SymbolT.V sym)).base, args = [(attrFinal, pSigma, ctx, name) | (ctx,name) ← zip cgargs (drop (length symi.typ.rho.context) @@ -549,3 +529,19 @@ instFun symc symi mname = do ++ [(attrFinal, pSigma, lazy jt, name) | (jt,name) ← zip vgargs args], body = JBlock{stmts=[JReturn rex]}} + +private symMethAsSymV :: SymMeth Global -> SymV Global +private symMethAsSymV (SymMeth.V symv) = symv +private symMethAsSymV _ = error "InstanceCode: all methods should have been resolved" + +{-- + @symItau sym@ extracts @RhoTau@ from @sym.typ@. + + @SymI.typ@ really is a pair of @[Context]@ and @Tau@ but the @Sigma@ type is (ab)used to represent it. + So it can be assumed that @tauRho SymI.typ.rho@ is @RhoTau@. + We have to take care of functions being an instance (e.g. @instance ArrayElement (a -> b)@) hence @tauRho@. + -} +symItau :: SymI a -> RhoTau QName +symItau symi = case tauRho symi.typ.rho of + Just t -> t + _ -> error "cannot happen, tauRho SymI.typ.rho can never be RhoFun" diff --git a/frege/compiler/gen/java/Instantiation.fr b/frege/compiler/gen/java/Instantiation.fr index b465dcf4..ca752de7 100644 --- a/frege/compiler/gen/java/Instantiation.fr +++ b/frege/compiler/gen/java/Instantiation.fr @@ -14,7 +14,7 @@ import Compiler.instances.Nicer(nicectx, nicerctx) import Compiler.types.Positions(Position) import Compiler.types.Global(Global, Symbol, StG, SymInfo8, getST) -import Compiler.types.Types(Ctx, Context, TauT, SigmaT, RhoT, Tau, Sigma, Rho, pSigma) +import Compiler.types.Types(Ctx, Context, TCon, TVar, TauT, SigmaT, RhoT, RhoTau, Tau, Sigma, Rho, pSigma) -- import Compiler.types.Expression(Expr) import Compiler.types.QNames import Compiler.types.Symbols @@ -24,6 +24,7 @@ import Compiler.types.AbstractJava import Compiler.common.Errors as E() import Compiler.common.Types as CT import Compiler.common.JavaName +import Compiler.common.Lens (set) import Compiler.tc.Util(impliesG, reducedCtx) import Compiler.Utilities as U() @@ -32,9 +33,9 @@ import Compiler.gen.java.Common import Compiler.gen.java.Bindings -envCtxs g = [ ctx | s <- reverse (Global.genEnv g), - -- not (null (Symbol.typ s).bound), - ctx <- (Symbol.typ s).rho.context ] +envCtxs :: Global -> [Context] +envCtxs g = [ ctx | s <- reverse g.genEnv + , ctx <- s.typ.rho.context ] --- takes a list of contexts and returns the ones that are resolvable resolvableCtxs ∷ Global → [Context] → [Context] @@ -49,7 +50,7 @@ resolveConstraint pos (ctx@Ctx {cname, tau}) = do where tauflat = tau.flat tcon = head tauflat - make | TCon {name} <- tcon = true + make | TauT.Con _ <- tcon = true | otherwise = false findCtx | Meta tv <- tau, tv.isFlexi = do @@ -83,11 +84,11 @@ resolveConstraint pos (ctx@Ctx {cname, tau}) = do csym <- U.findC cname let special = isSpecialClassName cname case tcon of - TCon {name} -> case filter ((name ==) • fst) csym.insts of + TauT.Con TCon{name} -> case filter ((name ==) . fst) csym.insts of (_,iname):_ -> do inst <- U.findI iname g <- getST - let crho = RhoTau [] tau + let crho = RhoT.Tau $ RhoTau [] tau csig = ForAll [] crho E.logmsg TRACEG pos (text ("makeCtx: unify " ++ nice inst.typ g ++ " with " ++ nice csig g)) @@ -98,16 +99,16 @@ resolveConstraint pos (ctx@Ctx {cname, tau}) = do <+> text (show taujt) <> text "[]" <+> text " is unfortunately impossible." ) - let tree = unifySigma g inst.typ csig + let tree = unifySigma inst.typ csig rho = substRho tree inst.typ.rho - gargs = map (boxed . tauJT g . substTau tree) - (filter ((`member` tree) . _.var) + gargs = map (boxed . tauJT g . substTau tree . TauT.Var) + (filter ((`member` tree) . _.var) inst.typ.tvars) -- rhojt <- rhoJT rho E.logmsg TRACEG pos (text ("makeCtx substituted: " ++ nice rho g)) -- let subctx = map (TC.reducedCtx g) rho.context args <- mapM (resolveConstraint pos) rho.context - let jiname = symJavaName g inst + let jiname = symJavaName g $ SymbolT.I inst let jit = Constr jiname gargs -- jitjts jex | special, null args = JInvoke (JX.static "mk" jit).{targs=[boxed taujt]} [] @@ -152,7 +153,7 @@ instPatternBound pos bindns sigma = do let bind = strictBind g bindns -- make sure we don't hit a Lazy varjt = lambdaType (sigmaJT g sigma) -- Func<....> casted = convertHigher bind.jex varjt - higherCtx Ctx{tau=TVar{var}} = var `elem` sigma.vars + higherCtx Ctx{tau=TauT.Var TVar{var}} = var `elem` sigma.vars higherCtx _ = false contexts = [ ctx | ctx ← sigma.rho.context, not (higherCtx ctx) ] hctxs = filter higherCtx sigma.rho.context @@ -164,7 +165,7 @@ instPatternBound pos bindns sigma = do [c]) ctxs jctxs if (null ctxs) then pure (newBind g sigma casted).{jtype = varjt} - else pure (newBind g sigma.{rho ← _.{context=hctxs}} casted).{ + else pure (newBind g sigma.{rho <- set RhoT._context hctxs} casted).{ jex ← JX.invoke thctxs . JX.xmem "apply", jtype ← lazy } diff --git a/frege/compiler/gen/java/Match.fr b/frege/compiler/gen/java/Match.fr index 72782e43..fd288714 100644 --- a/frege/compiler/gen/java/Match.fr +++ b/frege/compiler/gen/java/Match.fr @@ -33,7 +33,6 @@ import Compiler.common.Errors as E() import Compiler.common.Types as CT import Compiler.common.JavaName - import Compiler.classes.Nice import Compiler.enums.Flags(TRACEG) @@ -108,7 +107,7 @@ match assert (PVar {pos,uid,var}) bind cont binds = do (rbind, code) <- if strict then realize (jname g) sbind else pure (sbind, []) let stmt | var == "_" = code - | otherwise = sComment ("bind " ++ sls ++ " var " ++ nice (Symbol.name vsym) g + | otherwise = sComment ("bind " ++ sls ++ " var " ++ nice vsym.name g ++ " to " ++ show rbind) : code nbinds = insert uid rbind binds rest <- cont nbinds @@ -164,11 +163,11 @@ match assert (pat@PLit {kind=LBool, value}) bind cont binds = do match assert (pat@PCon {pos,qname,pats}) bind cont binds = do -- g <- getST symd <- U.findD qname -- forall a.a -> List a -> List a - symt <- U.findT symd.name.tynm -- forall a.List a - if symt.enum then matchEnum symd symt + symt <- U.findT symd.name.tynm -- forall a.List a + if symt.enum then matchEnum symd else if symt.product then if symt.newt - then matchNew symd symt + then matchNew symd symt else matchProd symd symt -- pat bind cont binds else matchVariant symd symt -- pat bind cont binds where @@ -178,24 +177,25 @@ match assert (pat@PCon {pos,qname,pats}) bind cont binds = do other → kbnd comment g = sComment ("match " ++ nice pat g ++ " with " ++ show bind) - -- matchNewt :: Symbol -> Symbol -> StG (Binding, [JStmt]) - -- matchNewt symd symt = match (head pats) bind cont binds - matchEnum :: Symbol -> Symbol -> StG (Binding, [JStmt]) - matchEnum symd symt = do + matchEnum :: SymD Global -> StG (Binding, [JStmt]) + matchEnum symd = do g <- getST let sbnd = unKindedStrict g bind -- (bind, code1) <- realize "$" sbnd body <- cont binds - let comp = JBin sbnd.jex "==" (JX.staticMember (symJavaName g symd)) + let comp = JBin sbnd.jex "==" (JX.staticMember (symJavaName g $ SymbolT.D symd)) ifc = if assert then JAssert comp : body else [JCond "if" comp body] stio (sbnd, comment g : ifc) - matchNew :: Symbol -> Symbol -> StG (Binding, [JStmt]) + -- @symd@ must be a constructor of a newtype + matchNew :: SymD Global -> SymT Global -> StG (Binding, [JStmt]) matchNew symd symt = do g <- getST let -- box0 = adaptSigma g bind - arg = symd.typ.rho.sigma -- first arg of data con - tree = unifySigma g symt.typ bind.ftype -- instantiate type args a -> Int + arg = case symd.typ.rho of + RhoT.Fun RhoFun{sigma} -> sigma -- first arg of data con + _ -> error "cannot happen; a newtype must have one argument" + tree = unifySigma symt.typ bind.ftype -- instantiate type args a -> Int sig = substSigma tree arg -- substitute in arg E.logmsg TRACEG (getpos pat) ( text "matchNew:" <+> text (nicer pat g) PP.nest 4 ( @@ -208,7 +208,7 @@ match assert (pat@PCon {pos,qname,pats}) bind cont binds = do let box1 = (newBind g sig bind.jex).{jtype = bind.jtype} match assert (head pats) box1 cont binds - matchVariant :: Symbol -> Symbol -> StG (Binding, [JStmt]) + matchVariant :: SymD Global -> SymT Global -> StG (Binding, [JStmt]) matchVariant symd symt = do g <- getST E.logmsg TRACEG (getpos pat) (text "match pattern " @@ -216,7 +216,7 @@ match assert (pat@PCon {pos,qname,pats}) bind cont binds = do <+> text " with " <+> (text . show) bind) let box1 = unKindedStrict g bind -- List Int - tree = unifySigma g symt.typ bind.ftype -- a -> Int + tree = unifySigma symt.typ bind.ftype -- a -> Int rho = substRho tree symd.typ.rho -- Int -> List Int -> List Int (boxd, code1) <- realize "$" box1 -- TList $1 = ..... @@ -224,7 +224,7 @@ match assert (pat@PCon {pos,qname,pats}) bind cont binds = do cname = if symt.product then "" else conGetter qname -- _DCons vbind = if symt.product then boxd else Bind boxd.stype boxd.ftype - (variantType g boxd.jtype symd) + (variantType g boxd.jtype $ SymbolT.D symd) (JInvoke (JX.jexmem boxd.jex cname) []) (varb, code2) <- if symt.product then return (boxd, []) @@ -264,7 +264,7 @@ match assert (pat@PCon {pos,qname,pats}) bind cont binds = do stio (boxd, (comment g : code1) ++ code2 ++ ifn) - matchProd :: Symbol -> Symbol -> StG (Binding, [JStmt]) + matchProd :: SymD Global -> SymT Global -> StG (Binding, [JStmt]) matchProd symd symt = matchVariant symd symt -- for the time being @@ -370,10 +370,11 @@ match _ pat b c bs = do * @pat@ must be a constructor application whose constructor is the same * as given in @con@ -} +matchCon :: Bool -> Pattern -> Symbol -> [Binding] -> (TreeMap Int Binding -> StG [JStmt]) -> TreeMap Int Binding -> StG [JStmt] matchCon assert (PCon {pos,qname, pats}) con bexs cont binds = do g <- getST sym <- U.findD qname - if sym.sid != Symbol.sid con + if sym.sid != con.sid then do E.fatal pos (text ("matchCon: " ++ nice qname g ++ " against " ++ nice con g)) else do diff --git a/frege/compiler/gen/java/MethodCall.fr b/frege/compiler/gen/java/MethodCall.fr index 3e018362..f7163db6 100644 --- a/frege/compiler/gen/java/MethodCall.fr +++ b/frege/compiler/gen/java/MethodCall.fr @@ -4,16 +4,20 @@ module frege.compiler.gen.java.MethodCall where import Data.TreeMap(TreeMap, values) import Data.List(elemBy) +import frege.data.Monoid (First) +import frege.compiler.common.Lens (Getting, _Just, preview) + import Compiler.Utilities as U() import Compiler.classes.Nice(nice, nicer) import Compiler.types.AbstractJava -import Compiler.types.Types(unST, Sigma, Tau, TauT, ForAll, RhoTau, RhoFun) -import Compiler.types.Symbols(SymbolT) +import Compiler.types.Types(unST, Sigma, TVar, Tau, TauT, ForAll, RhoT, RhoTau, RhoFun) +import Compiler.types.Symbols(SymD, SymV, SymVal, SymbolT) import Compiler.types.Global import Compiler.types.JNames(JName, memberOf) import Compiler.types.Strictness() +import Compiler.types.QNames(QName) import Compiler.common.Types as CT import Compiler.common.JavaName @@ -23,11 +27,6 @@ import frege.compiler.tc.Methods (NIKind, niKind) import Compiler.gen.java.Common import Compiler.gen.java.Bindings -returnTau sigma = (fst • U.returnType) (Sigma.rho sigma) -sigmaTau f (ForAll [] (RhoTau [] ty)) = f ty -sigmaTau f (ForAll [] rhofun) = sigmaTau f (ForAll [] (tauRho rhofun)) -sigmaTau f _ = Nothing - niSpecial g ty | Just _ <- U.isUnit ty = true | Just _ <- U.isMaybe ty = true @@ -37,39 +36,38 @@ niSpecial g ty --- Tells if a native symbol is wrapped -wrapped g (sym@SymV {nativ = Just item, throwing}) = not (null throwing) - || niSpecial g rty - || not (null (wildReturn g sym)) +wrapped :: Global -> SymV Global -> Bool +wrapped g (sym@SymV{nativ = Just item, throwing}) = + not (null throwing) + || niSpecial g rty + || not (null (wildReturn g sym)) where (rty, _) = U.returnType sym.typ.rho -wrapped g SymV {} = false -wrapped g SymD {} = false -wrapped g _ = error "wrapped: no symv" - +wrapped _ _ = false + {-- Tell if a native function must be called through its wrapper. This is the case when it is wrapped for some other reason than that the return type is 'Maybe'. -} -wrappedOnly g (sym@SymV {nativ = Just _, throwing}) +wrappedOnly g (SymbolT.V (symv@SymV {nativ = Just _, throwing})) = not (null throwing) || niSpecial g rty && isNothing (U.isMaybe rty) - || not (null (wildReturn g sym)) + || not (null (wildReturn g symv)) where - (rty, _) = U.returnType sym.typ.rho -wrappedOnly g sym = error "wrappedOnly - no native function" --- --- + (rty, _) = U.returnType symv.typ.rho +wrappedOnly _ sym = error "wrappedOnly - no native function" + --- returns a binding for a direct call of a native method -nativeCall ∷ Global → Symbol → TreeMap String Tau → [JExpr] → Binding -nativeCall g (sym@SymV {nativ = Just item, gargs}) subst aexs = newBind g bsig (call jrty args) +nativeCall :: Global -> SymV Global -> TreeMap String Tau -> [JExpr] -> Binding +nativeCall g (symv@SymV{nativ = Just item, gargs}) subst aexs = newBind g bsig (call jrty args) where - (rty, sigmas) = U.returnType sym.typ.rho + (rty, sigmas) = U.returnType symv.typ.rho taus = [ tau | Just tau <- map U.sigmaAsTau sigmas ] brty = substTau subst (baserty rty) bsig = U.tauAsSigma brty - targs = map (boxed . tauJT g . substTau subst) gargs + targs = map (boxed . tauJT g . substTau subst . TauT.Var) gargs args | [tau] <- taus, Just _ <- U.isUnit tau = [] -- no arguments | otherwise = zipWith (argEx g) aexs taus bjt = tauJT g brty @@ -104,17 +102,20 @@ nativeCall g (sym@SymV {nativ = Just item, gargs}) subst aexs = newBind g bsig ( let evalStG :: Global -> StG a -> a evalStG g st = fst $ st.run g x = do g <- getST - si <- symInfo sym - let name = (head si.argSigs).rho.tau.name + si <- symInfo $ SymVal.V symv + -- this part is an unfinished, prototyped one. See PR #361, #363 + let unsafePartialView :: Getting (First a) s a -> s -> a + unsafePartialView l = unJust . preview l + let name = (unsafePartialView TauT._Con (unsafePartialView RhoT._Tau (head si.argSigs).rho).tau).name irsym = unJust $ g.findit name - nms = mapMaybe (_.name) [ fld | x@SymD{} <- values irsym.env, fld <- x.flds ] + nms = mapMaybe (_.name) [ fld | SymbolT.D x <- values (unsafePartialView _Just irsym.env'), fld <- x.flds ] return $ flip mapMaybe nms $ \fldnm -> do - nativrsym <- g.findit $ si.retSig.rho.tau.name - nativsym <- TreeMap.lookup fldnm nativrsym.env - nativnm <- nativsym.nativ - let nativsi = evalStG g $ symInfo nativsym - fldsym <- TreeMap.lookup fldnm irsym.env - pure $ wrapIRMethod g (head args) (head si.argJTs) nativsi nativnm fldnm fldsym + nativrsym <- g.findit $ (unsafePartialView TauT._Con (unsafePartialView RhoT._Tau si.retSig.rho).tau).name + nativsym <- TreeMap.lookup fldnm (unsafePartialView _Just nativrsym.env') + nativnm <- unsafePartialView SymbolT._nativ nativsym + let nativsi = evalStG g $ symInfo $ unsafePartialView SymbolT._Val nativsym + fldsym <- TreeMap.lookup fldnm (unsafePartialView _Just irsym.env') + pure $ wrapIRMethod g (head args) (head si.argJTs) nativsi nativnm fldnm (unsafePartialView Symbol._Val fldsym) in JNewClass jrty [] (evalStG g x) NICast -> case args of [a] -> JInvoke (JAtom item) args -- was: JCast (Ref (JName "" item) []) a @@ -147,15 +148,16 @@ nativeCall g (sym@SymV {nativ = Just item, gargs}) subst aexs = newBind g bsig ( NIArraySet -> case args of [a,b,c] -> JBin (JArrayGet a b) "=" c _ -> JAtom "bad array set" -- error was flagged before -nativeCall g sym subst aexs = error ("nativeCall: no function " +nativeCall g sym subst aexs = error ("nativeCall: no function " ++ show sym.pos.first.line ++ ", " ++ nicer sym g) --- + +wrapCode :: Global -> (JExpr -> JStmt) -> Tau -> SymV Global -> TreeMap String Tau -> [JExpr] -> [JStmt] wrapCode g jreturn rtau (sym@SymV {nativ = Just item, throwing}) subst aexs | Just (stau, atau) <- unST rtau = let sjt = tauJT g stau -- type #1 for parameterization of ST s a ajt = tauJT g atau -- return type of the ST action - ssig = ForAll [] (RhoTau [] stau) + ssig = ForAll [] $ RhoT.Tau $ RhoTau [] stau mktup x = JReturn (mkpure sjt ajt x) code = wrapCode g mktup atau sym subst aexs try = JBlockX "try" code @@ -217,42 +219,42 @@ wrapCode g jreturn rtau (sym@SymV {nativ = Just item, throwing}) subst aexs catch rty = case tauJT g rty of Nativ{typ, gargs} -> "catch (" ++ typ ++ " ex)" other -> error ("bad exception type " ++ show other) -wrapCode g jreturn rtau sym _ _ = error "wrapCode: no SymV" - - +wrapCode _ _ _ _ _ _ = error "wrapCode - no native function" + + {-- code for native functions and/or members -} -methCode :: Global -> Symbol -> SymInfo8 -> [JDecl] -methCode g (sym@SymV {nativ = Just item}) si = [ - JComment ((nice sym g) ++ " " ++ show sym.strsig ++ " " ++ show sym.rkind), - JComment (nicer sym.typ g), +methCode :: Global -> SymV Global -> SymInfo8 -> [JDecl] +methCode g (symv@SymV {nativ = Just item}) si = [ + JComment ((nice symv g) ++ " " ++ show symv.strsig ++ " " ++ show symv.rkind), + JComment (nicer symv.typ g), JComment ("the following type variables are probably wildcards: " ++ joined ", " (map _.var wildr)), JComment item] ++ (if arity then defs - else if wrapped g sym || niKind item != NIStatic + else if wrapped g symv || niKind item != NIStatic then [member] else []) where rjt = tauJT g rty rArgs = lambdaArgDef g attrFinal si.argSigs (getArgs g) wArgs = argDefs attrFinal si (getArgs g) - wildr = wildReturn g sym - name = symJavaName g sym -- X.foo - ftargs = targs g sym.typ -- + wildr = wildReturn g symv + name = symJavaName g (SymbolT.V symv) -- X.foo + ftargs = targs g symv.typ -- args = if haswrapper then wArgs else rArgs - haswrapper = arity && wrapped g sym -- (not (null bnds)) + haswrapper = arity && wrapped g symv -- (not (null bnds)) jreturn = if arity then JReturn else JEx - bndWcode x = newBind g (ForAll [] (RhoTau [] rty)) x + bndWcode = newBind g $ ForAll [] $ RhoT.Tau $ RhoTau [] rty attr - | not (null wildr) = attrs [JUnchecked, JPublic, JStatic, JFinal] - | unsafeCast g sym = attrs [JUnchecked, JPublic, JStatic, JFinal] - | otherwise = attrTop + | not (null wildr) = attrs [JUnchecked, JPublic, JStatic, JFinal] + | unsafeCast g symv = attrs [JUnchecked, JPublic, JStatic, JFinal] + | otherwise = attrTop - wcode = if wrapped g sym - then wrapCode g jreturn rty sym TreeMap.empty (map (_.jex . instArg g) args) + wcode = if wrapped g symv + then wrapCode g jreturn rty symv TreeMap.empty (map (_.jex . instArg g) args) else let - bind = nativeCall g sym TreeMap.empty (map (_.jex . instArg g) args) + bind = nativeCall g symv TreeMap.empty (map (_.jex . instArg g) args) in [jreturn bind.jex] wrappers = if haswrapper then [{- inst, -} wrapper] else [{-inst-}] wrapper = JMethod {attr, @@ -264,13 +266,13 @@ methCode g (sym@SymV {nativ = Just item}) si = [ member = JMember {attr = attrTop, jtype = rjt, - name = (symJavaName g sym).base, + name = (symJavaName g (SymbolT.V symv)).base, init = Just (unex wcode)} - (rty, atys) = U.returnType sym.typ.rho - arity = not (null atys) || not (null sym.typ.bound) - -methCode g sym _ = Prelude.error ("line " ++ show sym.pos.first.line + (rty, atys) = U.returnType symv.typ.rho + arity = not (null atys) || not (null symv.typ.bound) + +methCode g sym _ = Prelude.error ("line " ++ show sym.pos.first.line ++ ": can not compile " ++ nice sym g) {-- @@ -283,24 +285,24 @@ methCode g sym _ = Prelude.error ("line " ++ show sym.pos.first.line and we need to cast the result. -} -wildReturn ∷ Global → Symbol → [Tau] -wildReturn g (symv@SymV{}) = [ v | v@TVar{} ← values (U.freeTauTVars [] TreeMap.empty ret), - not (stvar v.var), - not (elemBy (using _.var) v sigvars), - not (elemBy (using _.var) v itemvars) - ] +wildReturn :: Global -> SymV Global -> [TVar QName] +wildReturn g symv = + [ v | v <- values (U.freeTauTVars [] TreeMap.empty ret) + , not (stvar v.var) + , not (elemBy (using _.var) v sigvars) + , not (elemBy (using _.var) v itemvars) + ] where (ret, sigs) = U.returnType symv.typ.rho -- identify ST phantom type variable, if any stvar = case unST ret of - Just (tv@TVar{}, _) → (tv.var ==) + Just (TauT.Var tv, _) → (tv.var ==) other → const false sigvars = concatMap (values . U.freeRhoTVars [] TreeMap.empty . _.rho) sigs - itemvars = concatMap (values . U.freeTauTVars [] TreeMap.empty) symv.gargs -wildReturn _ _ = [] + itemvars = concatMap (values . U.freeTauTVars [] TreeMap.empty . TauT.Var) symv.gargs -wrapIRMethod :: Global -> JExpr -> JType -> SymInfo8 -> String -> String -> Symbol -> JDecl +wrapIRMethod :: Global -> JExpr -> JType -> SymInfo8 -> String -> String -> SymVal Global -> JDecl wrapIRMethod g this irjt nativsi nativnm fldnm fldsym = let nativargs = argDefs attrFinal (nativsi.{ argSigs <- tail, argJTs <- tail }) (getArgs g) fldstri = case fldsym.strsig of diff --git a/frege/compiler/gen/java/VarCode.fr b/frege/compiler/gen/java/VarCode.fr index a4c4f7ef..c9060271 100644 --- a/frege/compiler/gen/java/VarCode.fr +++ b/frege/compiler/gen/java/VarCode.fr @@ -9,6 +9,8 @@ import Lib.PP(text, <>, <+>, <+/>, ) import Data.Bits(BitSet, BitSet.member, BitSet.unionE, BitSet.differenceE) import Data.List(partitioned, zip4) +import frege.compiler.common.Lens (preview, set) + import Compiler.enums.Flags(TRACEG) import Compiler.enums.RFlag as RF(RFlag) import Compiler.enums.Literals @@ -21,11 +23,11 @@ import Compiler.instances.Nicer(nicerctx, nicectx) import Compiler.types.Global(Symbol, StG, Global(), getST, changeST, uniqid) -import Compiler.types.Symbols(SymV, SymL, SymD, SymT, SymC, SymI) +import Compiler.types.Symbols(SymV, SymL, SymD, SymT, SymC, SymI, SymMeth, SymVal, SymbolT) import Compiler.types.Expression(Expr, ExprT, CAlt, CAltT, flatx) import Compiler.types.Patterns(Pattern, PatternT) import Compiler.types.Positions(Positioned) -import Compiler.types.Types(RhoT, SigmaT, TauT, Rho, Sigma, Tau, Context, Ctx, pSigma) +import Compiler.types.Types(RhoT, RhoTau, SigmaT, TauT, Rho, Sigma, Tau, Context, Ctx, pSigma) import Compiler.types.Strictness(allLazy, Strictness) import Compiler.types.QNames(QName) import Compiler.types.JNames(JName, memberOf) @@ -58,39 +60,39 @@ import Compiler.gen.java.Constants(findConst, staticConst) import Compiler.gen.java.Instantiation(instPatternBound, resolveConstraint, envCtxs, resolvableCtxs) import Compiler.gen.java.PrettyJava(lambda7, thunkMarker) -varCode ∷ TreeMap Int Binding → Symbol → StG [JDecl] -varCode _ (SymL{sid, pos, vis, name, alias}) = do +varCode :: TreeMap Int Binding -> SymMeth Global -> StG [JDecl] +varCode _ (SymMeth.L SymL{sid, pos, vis, name, alias}) = do g ← getST pure [JComment ("alias " ++ name.base ++ " for " ++ show (javaName g alias))] -varCode binds sym = do +varCode binds (SymMeth.V symv) = do g <- getST - E.logmsg TRACEG sym.pos (text ("varCode for " ++ nicer sym g)) - si <- symInfo sym - case sym of - SymV{expr = Just{}} - | null si.argSigs = cafCode sym binds -- nust be CAF - | otherwise = funDef sym binds - SymV {nativ = Just _, over} + E.logmsg TRACEG symv.pos (text ("varCode for " ++ nicer symv g)) + si <- symInfo $ SymVal.V symv + case symv of + SymV{expr = Just _} + | null si.argSigs = cafCode symv binds -- nust be CAF + | otherwise = funDef symv binds + SymV{nativ = Just _, over} | null over = do g ← getST - E.logmsg TRACEG sym.pos (text "native var:" - <+> text (nice sym.name g) <+> text "∷" - <+> text (nicer sym.typ.rho g) - <> text ", depth=" <> anno sym.depth - <> text ", rstate=" <> (text • show) sym.rkind) - si ← symInfo sym - return (comment : methCode g sym si) + E.logmsg TRACEG symv.pos (text "native var:" + <+> text (nice symv.name g) <+> text "∷" + <+> text (nicer symv.typ.rho g) + <> text ", depth=" <> anno symv.depth + <> text ", rstate=" <> (text • show) symv.rkind) + si <- symInfo $ SymVal.V symv + return (comment : methCode g symv si) | otherwise = return [] -- there is no code for overloads where - comment = JComment (nicer sym g) - _ = error ("varCode: no SymV? " ++ nicer sym g) + comment = JComment (nicer symv g) + _ -> error ("varCode: bad SymV " ++ nicer symv g) --- Generate code for a function with arguments -funDef ∷ Symbol → TreeMap Int Binding → StG [JDecl] +funDef :: SymV Global -> TreeMap Int Binding -> StG [JDecl] funDef sym binds = do g ← getST if g.toplevel @@ -98,7 +100,7 @@ funDef sym binds = do else localFun sym binds --- Generate code for a top level function -topFun ∷ Symbol → TreeMap Int Binding → StG [JDecl] +topFun :: SymV Global -> TreeMap Int Binding -> StG [JDecl] topFun (sym@SymV {expr = Just dx}) binds = do g ← getST E.logmsg TRACEG sym.pos (text "topFun:" @@ -108,7 +110,7 @@ topFun (sym@SymV {expr = Just dx}) binds = do <> text ", rstate=" <> (text • show) sym.rkind) -- x ← dx -- get expression - si ← symInfo sym + si <- symInfo $ SymVal.V sym let !arity = length si.argSigs when (arity != sym.depth) do @@ -124,7 +126,7 @@ topFun (sym@SymV {expr = Just dx}) binds = do argAttr = if isTailRec then empty else attrFinal ctxArgs = map (unFinal isTailRec) (zipWith (constraintArg g) sym.typ.rho.context ctxNames) methArgs = argDefs argAttr si argNames - methName = (symJavaName g sym).base + methName = (symJavaName g $ SymbolT.V sym).base attr | unsafe = attrs [JUnchecked, JFinal, JPublic, JStatic] | otherwise = attrs [JFinal, JPublic, JStatic] @@ -180,7 +182,7 @@ topFun sym binds = do as well as other let bound items the code may reference. -} -localFun ∷ Symbol → TreeMap Int Binding → StG [JDecl] +localFun :: SymV Global -> TreeMap Int Binding -> StG [JDecl] localFun (sym@SymV {expr = Just dx}) binds = do g ← getST E.logmsg TRACEG sym.pos (text "localFun:" @@ -189,7 +191,7 @@ localFun (sym@SymV {expr = Just dx}) binds = do <> text ", depth=" <> anno sym.depth <> text ", rstate=" <> (text • show) sym.rkind) - si ← symInfo sym + si <- symInfo $ SymVal.V sym let !arity = length si.argSigs when (arity != sym.depth) do @@ -238,7 +240,7 @@ unFinal s (arg@(a,b,c,d)) Results in a simple java lambda. -} innerFun ∷ Symbol → TreeMap Int Binding → StG [JDecl] -innerFun (sym@SymV {expr = Just dx}) binds = do +innerFun (SymbolT.V (sym@SymV {expr = Just dx})) binds = do g ← getST E.logmsg TRACEG sym.pos (text "innerFun:" <+> text (nice sym.name g) <+> text "∷" @@ -252,11 +254,11 @@ innerFun (sym@SymV {expr = Just dx}) binds = do argNames = getArgs g methArgs = [ (attrFinal, sig, lazy jt, nm) | (sig,jt,nm) <- zip3 sigs (take arity funcjt.gargs) argNames ] - methName = (symJavaName g sym).base + methName = (symJavaName g $ SymbolT.V sym).base funcjt = lambdaType (rhoJT g sym.typ.rho) symx = sym.{rkind ← _.differenceE RValue} - changeSym symx -- remember this + changeSym $ SymbolT.V symx -- remember this when (arity != length funcjt.gargs - 1) do E.error sym.pos ( text "lambda depth" <+> anno arity <+> text "does not match function type " @@ -307,7 +309,7 @@ cafCode (sym@SymV {name, depth = 0, expr = Just dx}) binds = do use7 = outer || self ctxs = if null bnds then [] else sym.typ.rho.context cargs = zipWith (constraintArg g) ctxs ctxNames - jtype = rhoJT g sym.typ.rho.{context=[]} + jtype = rhoJT g $ set RhoT._context [] sym.typ.rho rtype = returnType sym.rkind jtype stype = if inmethod || rsimple then rtype else jtype inmethod = not (null sym.typ.bound) || not (null sym.typ.rho.context) @@ -315,13 +317,13 @@ cafCode (sym@SymV {name, depth = 0, expr = Just dx}) binds = do then sym.rkind.unionE RMethod else sym.rkind.differenceE RMethod - changeSym sym.{rkind=xkind} + changeSym $ SymbolT.V sym.{rkind=xkind} let comments = [ JComment ((nicer sym g) ++ " " ++ show sym.strsig ++ " " ++ show xkind), JComment (nicer sym.typ g), JComment (nicer x g)] - name = symJavaName g sym -- P.foo + name = symJavaName g (SymbolT.V sym) -- P.foo if not inmethod && rsimple && not self then do @@ -382,13 +384,13 @@ cafCode (sym@SymV {name, depth = 0, expr = Just dx}) binds = do cafCode _ binds = error "cafCode: no caf" -innerCaf ∷ Symbol → TreeMap Int Binding → Bool → StG [JDecl] +innerCaf :: SymV Global -> TreeMap Int Binding -> Bool -> StG [JDecl] innerCaf sym binds mutual = do g ← getST E.logmsg TRACEG sym.pos (text ("compiling inner " ++ sym.nice g)) - let memName = (symJavaName g sym).base + let memName = (symJavaName g (SymbolT.V sym)).base memAttrs = attrs [JFinal] tweak :: JDecl -> JDecl tweak decl @@ -403,7 +405,7 @@ innerCaf sym binds mutual = do run @action@ with @symbol@ in the current compiling environment -} -compiling ∷ Symbol → StG 𝖆 → StG 𝖆 +compiling :: SymV Global -> StG a -> StG a compiling sym action = do changeST Global.{genEnv ← (sym:)} r ← action @@ -516,7 +518,7 @@ genStmts jret rm (x@Let {env, ex}) binds = do | symv.depth == 0, symv.strsig.isStrict, RSimple `member` symv.rkind, - RhoTau [] t <- symv.typ.rho = do + RhoT.Tau (RhoTau [] t) <- symv.typ.rho = do vx <- vx genCaseStmt jret rm (cas vx) binds where @@ -543,8 +545,8 @@ genStmts jret rm ex binds case ex of App _ _ _ | Vbl {name}:args <- map fst (flatx ex), - Just (sym@SymV {sid}) <- g.findit name, - sid == (head (g.genEnv)).sid, + Just (SymbolT.V (sym@SymV{sid})) <- g.findit name, + sid == (head g.genEnv).sid, length args == sym.depth = do -- tail call let argNames = map (++"f") @@ -749,11 +751,11 @@ genCaseStmt jret rm (x@Case {ckind,ex=cex,alts=calts}) binds = do case pat of PCon {qname} -> do sym <- U.findD qname - if sym.sid == Symbol.sid con then do + if sym.sid == con.sid then do let nbexs = case stri of S ss -> zipWith (bexStr g) bexs (ss ++ allLazy) _ -> bexs - code <- matchCon noif pat con nbexs (genStmts jret rm ex) binds + code <- matchCon noif pat (SymbolT.D con) nbexs (genStmts jret rm ex) binds g <- getST pure ((altComm g:code):codes, nbexs) else do @@ -811,7 +813,7 @@ genCaseStmt jret rm nocase binds = error "genCaseStmt: no case" - Functions, i.e. things that have 'Symbol.depth' greater than 0 or a type with constraints or bound type variables. -} -needClassForLet ∷ [Symbol] → Bool +needClassForLet :: [SymV Global] -> Bool needClassForLet [SymV{typ, depth, rkind}] = RSelfRec `member` rkind || depth > 0 || not (null typ.bound) @@ -862,14 +864,14 @@ genLet jret rm x binds = do incls = concat (take (length envxx - length after) envxx) genLetEnvs jret rm before incls after letex binds where - toSym = mapM U.findV + toSym = mapM U.findV (letex, envqq) = collect x [] -- collect the environments of nested lets in reverse order collect ∷ ExprT → [[QName]] → (ExprT,[[QName]]) collect (x@Let {env,ex}) acc = collect ex (env:acc) collect x acc = (x, acc) -genLetEnvs ∷ (JExpr→[JStmt]) → JType → [Symbol] → [Symbol] → [Symbol] → ExprT → TreeMap Int Binding → StG [JStmt] +genLetEnvs :: (JExpr -> [JStmt]) -> JType -> [SymV Global] -> [SymV Global] -> [SymV Global] -> ExprT -> TreeMap Int Binding -> StG [JStmt] genLetEnvs jret rm before inclass after ex binds = do g ← getST let bbinds = fold (mkbind g JAtom) binds before @@ -882,21 +884,20 @@ genLetEnvs jret rm before inclass after ex binds = do where -- generate declaration of inner function or caf - gen ∷ Bool → TreeMap Int Binding → Symbol → StG [JDecl] + gen :: Bool -> TreeMap Int Binding -> SymV Global -> StG [JDecl] gen mutual binds sym | sym.depth == 0 = innerCaf sym binds mutual - | otherwise = localFun sym binds - --otherwise = innerFun sym binds + | otherwise = localFun sym binds -- set up simple bindings, generate the mutually dependent items in a class -- instantiate that class and make bindings that access the bindings from outside - genLetClass ∷ TreeMap Int Binding → [Symbol] → StG (TreeMap Int Binding,[JStmt]) + genLetClass ∷ TreeMap Int Binding → [SymV Global] → StG (TreeMap Int Binding,[JStmt]) genLetClass binds [] = pure (binds, []) genLetClass binds syms = do g <- getST - forM syms (changeSym . _.{rkind ← (BitSet.`unionE` RMethod)}) + forM syms (changeSym . SymbolT.V . _.{rkind <- (BitSet.`unionE` RMethod)}) -- refresh the symbols - syms ← mapM U.findV (map _.name syms) + syms <- mapM U.findV (map _.name syms) u <- uniqid let base = "Let$" ++ show u name = "let$" ++ show u @@ -915,7 +916,7 @@ genLetEnvs jret rm before inclass after ex binds = do -- stmts <- genStmts jret rm ex letbinds pure (letbinds, [JLocal letcl, JLocal var]) - mkbind :: Global -> (String -> JX) -> TreeMap Int Binding -> Symbol -> TreeMap Int Binding + mkbind :: Global -> (String -> JX) -> TreeMap Int Binding -> SymV Global -> TreeMap Int Binding mkbind g prefix binds sym = insert sym.sid bind binds where bind = Bind{stype=nicer sym.typ g, @@ -926,7 +927,7 @@ genLetEnvs jret rm before inclass after ex binds = do mode = if sym.depth > 0 then strict else if RValue `member` sym.rkind then strict else lazy - name = (symJavaName g sym).base + name = (symJavaName g $ SymbolT.V sym).base --- genExpression returnexpression f expr binds @@ -937,14 +938,15 @@ genExpression ret stri x binds = do g <- getST let nt = case x.typ of Just sigma - | null sigma.bound = rhoJT g (sigma.rho.{context=[]}) + | null sigma.bound = rhoJT g $ set RhoT._context [] sigma.rho | otherwise = sigmaJT g sigma _ → error ("untyped expr " ++ nicer x g ++ " in genExpression") genExpr ret (stri nt) x binds --- Avoid change of arity when a function is substituted for b --- > forall a b .ctx => (a->b) ==> forall a b. ctx => a -> b -rhoTauInSigma (ForAll bs (RhoTau ctx fun)) = ForAll bs (U.rhoTau fun).{context=ctx} +rhoTauInSigma :: Sigma -> Sigma +rhoTauInSigma (ForAll bs (RhoT.Tau (RhoTau ctx fun))) = ForAll bs $ set RhoT._context ctx $ U.rhoTau fun rhoTauInSigma sig = sig --- Adapt result from 'genExpr' and do some logging @@ -970,9 +972,11 @@ etaShrink rflg rm ex n binds = do unEta 0 args app = getST >>= \g → genExpr false (subrm g) app binds >>= unwind args . strictBind g where - subrm g - | App{} ← app = (rhoJT g . _.{context = []} . _.rho . unJust . _.typ) app - | otherwise = (rhoJT g . _.rho . unJust . _.typ) app + subrm g = + let f = case app of + App{} -> set RhoT._context [] + _ -> id + in (rhoJT g . f . _.rho . unJust . _.typ) app unEta n args (App{fun,arg}) = unEta (n-1) (arg:args) fun unEta n args noapp = do g ← getST @@ -1040,7 +1044,7 @@ etaWrap ex sigs binds (rm@Func{gargs}) = do [x] -> lazy x gs -> Func gs fake = (U.patLocal (getpos ex) 0 "\\lambda").{depth=a,typ=ft} - mapM_ SymTab.enter syms + mapM_ (SymTab.enter . SymbolT.V) syms call ← compiling fake (genExpr false subrm nex newbinds) let lambda = JCast (boxed rm) JLambda{fargs = cargs ++ fargs, code} apply @@ -1136,12 +1140,12 @@ genExpr rflg rm ex binds = do Just ft ← aex.typ = case aex of (exx@Vbl{name = Local{uid}}) | Just bind <- lookup uid binds, - Nothing <- g.findit exx.name >>= _.expr, -- pattern bound + Nothing <- g.findit exx.name >>= preview SymbolT._V >>= _.expr, -- pattern bound not bind.ftype.bound.null, -- forall a. .... -- make sure the contexts are in the right order -- we can't pass forall a b. (Num a, Num b) => -- when (Num b, Num a) is expected - uni <- substRho (unifySigma g bind.ftype ft) bind.ftype.rho, + uni <- substRho (unifySigma bind.ftype ft) bind.ftype.rho, and (zipWith TU.sameCtx uni.context ft.rho.context) = do E.logmsg TRACEG (getpos exx) (text( @@ -1151,11 +1155,11 @@ genExpr rflg rm ex binds = do ++ " @@ " ++ nice ft g )) exprResult arm aex bind -- just pass on function - other = wrapHigher false aex binds sctxs ft.{rho ← _.{context=sctxs}} + other = wrapHigher false aex binds sctxs ft.{rho <- set RhoT._context sctxs} >>= exprResult arm aex where -- build the context expected by the caller of the function - subst = unifySigma g sig ft + subst = unifySigma sig ft srho = substRho subst sig.rho sctxs = srho.context | otherwise = genExpr false arm aex binds @@ -1216,7 +1220,7 @@ genExpr rflg rm ex binds = do -- make sure the contexts are in the right order -- we can't pass forall a b. (Num a, Num b) => -- when (Num b, Num a) is expected - uni <- substRho (unifySigma g bind.ftype ft) bind.ftype.rho, + uni <- substRho (unifySigma bind.ftype ft) bind.ftype.rho, and (zipWith TU.sameCtx uni.context ft.rho.context) = do E.logmsg TRACEG (getpos exx) (text( @@ -1231,32 +1235,24 @@ genExpr rflg rm ex binds = do -- Local Variables are being looked up in the bindings Vbl{name=Local{uid, base}, pos, typ} | Just b ← lookup uid binds = do - --E.logmsg TRACEG pos (text "genExpr bound at " <+> nicest g b.ftype) - --E.logmsg TRACEG pos (text "not (null bound) " <+> (text . show) (not (null b.ftype.bound))) - --let mbsym = g.findit ex.name - --E.logmsg TRACEG pos (text "g.findit ex.name " <+> (text . show . fmap (const ())) mbsym) - --let cond = case mbsym of - -- Just sym -> not (isJust sym.expr && sym.depth > 0 && RMethod `member` sym.rkind) - -- _ -> false - --E.logmsg TRACEG pos (text "not local method " <+> (text . show) cond) case b.ftype of ForAll{bound, rho} | not (null bound), - Just sym ← g.findit ex.name, + Just (SymbolT.V sym) <- g.findit ex.name, -- exclude local methods not (isJust sym.expr && sym.depth > 0 && RMethod `member` sym.rkind), - b' ← if sym.depth == 0 && RMethod `member` sym.rkind + b' <- if sym.depth == 0 && RMethod `member` sym.rkind then b.{jex ← JX.invoke []} -- evaluate method CAFs else b = instPatternBound pos b' ft >>= result ForAll{bound, rho} | not (null bound), - Nothing ← g.findit ex.name >>= _.expr, -- pattern bound + Nothing <- g.findit ex.name >>= preview SymbolT._V >>= _.expr, -- pattern bound = instPatternBound pos b ft >>= result _ | Func{} ← b.jtype, - Just sym ← g.findit ex.name, + Just (SymbolT.V sym) <- g.findit ex.name, RMethod `member` sym.rkind, sym.depth > 0 = etaWrap (snd (U.returnType ft.rho)) @@ -1268,23 +1264,25 @@ genExpr rflg rm ex binds = do sym <- U.findV ex.name result (newBind g sym.typ (JAtom ("UNBOUND." ++ ex.name.base))) Con{pos, name} - | Just (sym@SymD{cid, flds}) ← g.findit name = + | Just (SymbolT.D (sym@SymD{cid, flds})) <- g.findit name = if (length flds > 0) then etaWrap (snd (U.returnType ft.rho)) - else if maybe false _.enum (g.findit name.tynm) + else if case g.findit name.tynm of + Just (SymbolT.T symt) -> symt.enum + _ -> false then do - let item = symJavaName g sym + let item = symJavaName g (SymbolT.D sym) stref = JX.staticMember item result (newBind g ft stref) else do - let subst = unifySigma g sym.typ ft + let subst = unifySigma sym.typ ft -- rhoctx = substRho subst sym.typ.rho - targs = map (boxed . tauJT g . substTau subst) sym.typ.tvars + targs = map (boxed . tauJT g . substTau subst . TauT.Var) sym.typ.tvars -- contexts = map (reducedCtx g) rhoctx.context - item = Ref (symJavaName g sym) targs + item = Ref (symJavaName g (SymbolT.D sym)) targs mk = JX.static "mk" item call = JInvoke mk [] - result (newBind g ft.{rho ← _.{context=[]}} call) + result $ newBind g (ft.{rho <- set RhoT._context []}) call | otherwise = do E.error pos ( text "FATAL COMPILER ERROR " @@ -1300,25 +1298,23 @@ genExpr rflg rm ex binds = do -- bind = (newBind g ret inst).{jtype = retjt, jex ← coerce} -- pure bind Vbl{pos,name} - --| Just (sym@SymV{depth = 0, nativ = Just _}) = do - -- nativeCall g sym TreeMap.empty [] - | Just (sym@SymV{}) ← g.findit name = do - let subst = unifySigma g sym.typ ft + | Just (SymbolT.V sym) <- g.findit name = do + let subst = unifySigma sym.typ ft rhoctx = substRho subst sym.typ.rho - targs = map (boxed . tauJT g . substTau subst) sym.typ.tvars - ret = ft.{rho ← Rho.{context = []}} + targs = map (boxed . tauJT g . substTau subst . TauT.Var) sym.typ.tvars + ret = ft.{rho <- set RhoT._context []} if (sym.depth > 0) then etaWrap (snd (U.returnType (rhoTauInSigma ft).rho)) else if isJust sym.nativ - then if wrappedOnly g sym + then if wrappedOnly g (SymbolT.V sym) then do - let method = symJavaName g sym + let method = symJavaName g (SymbolT.V sym) stref = (JX.staticMember method).{targs} call = newBind g ret (JInvoke stref []) bind = if isStrictJT rm then call else delayBind call result bind - else result (nativeCall g sym subst []) + else result (nativeCall g sym subst []) else do let contexts = map (reducedCtx g) rhoctx.context kret = kArity (sigmaKind sym.typ) @@ -1330,7 +1326,7 @@ genExpr rflg rm ex binds = do ctxs ← mapM (resolveConstraint pos) contexts case sym.name of MName{tynm,base} - | Just (SymC {tau}) <- g.findit tynm, prevtargs ← targs + | Just (SymbolT.C SymC{clvar}) <- g.findit tynm, prevtargs <- targs = do let spec = isSpecialClassName tynm -- Our class member will have a phantom type var if from a special class @@ -1338,8 +1334,8 @@ genExpr rflg rm ex binds = do -- It is ok to not have it, since the actual type arguments will have been applied -- to the context resolved above, so javac is able to infer it for us. tvars = if spec then freeTVars [] sym.typ.rho else sym.typ.tvars - targs = map (boxed . tauJT g . substTau subst) - (filter ((!= tau.var) . _.var) tvars) + targs = map (boxed . tauJT g . substTau subst . TauT.Var) + (filter ((!= clvar.var) . _.var) tvars) inst = JInvoke get (tail ctxs) get = JExMem (head ctxs) (latinF ++ mangled base) targs bind = (newBind g ret inst).{jtype = retjt} @@ -1351,7 +1347,7 @@ genExpr rflg rm ex binds = do <+> text (show retjt) PP.stack (map (\(k,v) → text k <+> nicest g v) (each subst)) text "item type " <+> nicest g sym.typ - <+> text "with class var" <+> nicest g tau + <+> text "with class var" <+> nicest g clvar text "previously computed generics " <+> PP.spread (map (text . show) prevtargs) text "generics after substitution " @@ -1359,7 +1355,7 @@ genExpr rflg rm ex binds = do ) result bind other = do - let item = symJavaName g sym + let item = symJavaName g (SymbolT.V sym) stref = (JX.staticMember item).{targs} call0 | null targs, null ctxs = newBind g ft stref @@ -1397,10 +1393,10 @@ genExpr rflg rm ex binds = do args = tail flat -- is this a getter of a product type?? getter fun = case fun of - Vbl{name} - | Just SymV{name=MName{tynm, base}} ← g.findit name, - Just SymT{env,product=true} ← g.findit tynm = - base `elem` [ s | SymD{flds} ← values env, f ← flds, s ← f.name ] + Vbl{name} + | Just (SymbolT.V SymV{name=MName{tynm, base}}) <- g.findit name, + Just (SymbolT.T SymT{env, product=true}) <- g.findit tynm -> + base `elem` [ s | SymbolT.D symd <- values env, f <- symd.flds, s <- f.name ] other -> false -- determine whether result so far needs nesting, and which one @@ -1416,8 +1412,8 @@ genExpr rflg rm ex binds = do | otherwise = result (delayBind bind) -- possibly nested! -- constructors genApp (con@Con {pos, name, typ = Just csigma}) args = do - sym ← U.findD name - symt ← U.findT sym.name.tynm + sym <- U.findD name + symt <- U.findT sym.name.tynm () ← E.logmsg TRACEG pos ( text "genApp: constructor " <+> text name.base <+> text " :: " <+> text (nice sym.typ g) @@ -1426,7 +1422,7 @@ genExpr rflg rm ex binds = do ) let ari = length sym.flds nargs = length args - subst = unifySigma g sym.typ csigma + subst = unifySigma sym.typ csigma jsubst = fmap (boxed . tauJT g) subst origjt = rhoJT g sym.typ.rho instjt = substJT jsubst origjt @@ -1472,7 +1468,7 @@ genExpr rflg rm ex binds = do <> text "´ :: " <+> text (nicer sym.typ g) text "Possible workaround: restrict the type of `" <> text sym.name.base - <> text "´ to " <+> text (nicer csigma.rho.{context=[]} g) + <> text "´ to " <+> text (nicer (set RhoT._context [] csigma.rho) g) ) _ -> pure () @@ -1483,7 +1479,7 @@ genExpr rflg rm ex binds = do where nargs = length args SymT{newt = true, product = true} = genExpr rflg rm (head args) binds - SymT{} + _ = do -- resolve the contexts, if any ctxs ← mapM (resolveConstraint pos) contexts @@ -1491,22 +1487,21 @@ genExpr rflg rm ex binds = do abinds ← sequence (zipWith3 genArgBind sigs argjts args) let arguments = ctxs ++ map _.jex abinds - let cons = symJavaName g sym + let cons = symJavaName g (SymbolT.D sym) jref = Ref{jname = cons, gargs = targs} make = JX.static "mk" jref call = JInvoke make arguments bind = (newBind g ft call).{jtype = retjt} appResult true bind - _ = noGenApp "not yet" con args genApp (vbl@Vbl {pos, name, typ = Just vsigma}) args = do - symv ← U.findV name + symv <- U.findV name --vsigma ← (_.{bound=[]} . fst) <$> kiSigma [] [] xsigma --ft ← (_.{bound=[]} . fst) <$> kiSigma [] [] ft let symtyp = rhoTauInSigma symv.typ (orty, _) = U.returnType symtyp.rho - fixret | TCon{} ← orty = true - | otherwise = false + fixret | TauT.Con _ <- orty = true + | otherwise = false nargs = length args E.logmsg TRACEG pos ( text "genApp: function " @@ -1527,7 +1522,7 @@ genExpr rflg rm ex binds = do not (RMethod `member` symv.rkind) || symv.depth == 0) safetc = RSafeTC `member` symv.rkind - subst = unifySigma g symtyp vsigma + subst = unifySigma symtyp vsigma jsubst = fmap (boxed . tauJT g) subst origjt = rhoJT g symtyp.rho instjt = substJT jsubst origjt @@ -1559,7 +1554,7 @@ genExpr rflg rm ex binds = do | Local{uid} ← symv.name, Just b ← lookup uid binds = do - let subrm = rhoJT g vsigma.rho.{context=[]} + let subrm = rhoJT g $ set RhoT._context [] vsigma.rho fun ← genExpr false subrm vbl binds case fun.jtype of Func [ajty, rjty] → do @@ -1601,7 +1596,7 @@ genExpr rflg rm ex binds = do <> text "´ :: " <+> text (nicer symtyp g) text "Possible workaround: restrict the type of `" <> text symv.name.base - <> text "´ to " <+> text (nicer vsigma.rho.{context=[]} g) + <> text "´ to " <+> text (nicer (set RhoT._context [] vsigma.rho) g) ) _ -> pure () -- resolve the contexts, if any @@ -1653,25 +1648,21 @@ genExpr rflg rm ex binds = do -- class operations SymV{name = MName{tynm,base}} - | Just (SymC {tau}) <- g.findit tynm + | Just (SymbolT.C SymC{clvar}) <- g.findit tynm = do let inst = JInvoke get.{targs} (tail arguments) targs = map (substJT jsubst . TArg) (filter (TreeMap.`member` jsubst) - (filter (!= tau.var) (symtyp.vars))) + (filter (!= clvar.var) (symtyp.vars))) get = JX.jexmem (head ctxs) (latinF ++ mangled base) bind = (newBind g ret inst).{jtype = retjt} appResult safetc bind - --| Nothing ← g.findit tynm = noGenApp (nicer tynm g ++ " not found") fun args - --| Just other ← g.findit tynm, - -- traceLn (tynm.base ++ " is a " ++ (nicer other g)) = undefined - -- native functions SymV{nativ = Just item} → do - if wrappedOnly g symv + if wrappedOnly g (SymbolT.V symv) then do - let method = symJavaName g symv + let method = symJavaName g (SymbolT.V symv) stref = (JX.staticMember method).{targs} call0 = newBind g ret (JInvoke stref arguments) @@ -1688,13 +1679,12 @@ genExpr rflg rm ex binds = do -- ordinary functions SymV{} → do - let method = symJavaName g symv + let method = symJavaName g $ SymbolT.V symv stref = (JX.staticMember method).{targs} call0 = newBind g ret (JInvoke stref arguments) call = call0.{jtype = retjt} appResult safetc call - _ → noGenApp "unknown SymV" vbl args genApp bad args = noGenApp "no Con or Vbl" bad args noGenApp why bad args = do E.error (getpos ex) (text "Cannot genApp" diff --git a/frege/compiler/grammar/Frege.fr b/frege/compiler/grammar/Frege.fr index e92aadd7..6e61bf37 100644 --- a/frege/compiler/grammar/Frege.fr +++ b/frege/compiler/grammar/Frege.fr @@ -71,6 +71,7 @@ import Compiler.types.Global as G; import Compiler.common.Mangle; import Compiler.common.Errors as E(); +import Compiler.common.Lens (set); import Compiler.common.Resolve as R(enclosed); import Lib.PP (group, break, msgdoc); @@ -108,14 +109,14 @@ data YYsi res tok = | YYNTalias Token | YYNTannoitem Token | YYNTannoitems [Token] - | YYNTannotation [Def] + | YYNTannotation [AnnDcl] | YYNTapats [Exp] | YYNTappex Exp | YYNTbinex Exp | YYNTcalt CAltS | YYNTcalts [CAltS] | YYNTccontext [ContextS] - | YYNTclassdef Def + | YYNTclassdef ClaDcl | YYNTcommata Int | YYNTconfld [ConField SName] | YYNTconflds [ConField SName] @@ -123,17 +124,19 @@ data YYsi res tok = | YYNTcontypes [ConField SName] | YYNTdalt DConS | YYNTdalts [DConS] - | YYNTdatadef Def - | YYNTdatainit Def + | YYNTdatadef DatDcl + | YYNTdatainit DatDcl + | YYNTdatajavadef JavDcl + | YYNTdatajavainit JavDcl | YYNTdefinition [Def] | YYNTdefinitions [Def] - | YYNTderivedef Def + | YYNTderivedef DrvDcl | YYNTdocs String | YYNTdocsO (Maybe String) - | YYNTdocumentation Def + | YYNTdocumentation DocDcl | YYNTdodefs [Qual] | YYNTdplocaldef [Def] - | YYNTdvars [TauS] + | YYNTdvars [TVar SName] | YYNTelsex Token | YYNTexpr Exp | YYNTexprSC [Exp] @@ -141,13 +144,14 @@ data YYsi res tok = | YYNTfield (String, Exp) | YYNTfields [(String, Exp)] | YYNTfitem Token - | YYNTfixity Def + | YYNTfixity FixDcl | YYNTfldid (SigmaS -> ConField SName) | YYNTfldids [SigmaS -> ConField SName] | YYNTforall SigmaS - | YYNTfundef [Def] + | YYNTfundef FunDcl | YYNTfunhead (Exp, [Pat]) - | YYNTgargs [TauS] + | YYNTgargs [TVar SName] + | YYNTgargvars [TVar SName] | YYNTgetfield (Token, Bool,Exp) | YYNTgetfields [(Token,Bool,Exp)] | YYNTgqual Qual @@ -155,15 +159,15 @@ data YYsi res tok = | YYNTguard Guard | YYNTguards [Guard] | YYNTicontext [ContextS] - | YYNTimport Def + | YYNTimport ImpDcl | YYNTimportitem ImportItem | YYNTimportliste ImportList | YYNTimportspec ImportItem | YYNTimportspecs [ImportItem] - | YYNTimpurenativedef Def - | YYNTinfix Def - | YYNTinstdef Def - | YYNTinsthead Def + | YYNTimpurenativedef NatDcl + | YYNTinfix FixDcl + | YYNTinstdef InsDcl + | YYNTinsthead InsDcl | YYNTinterfaces [TauS] | YYNTjitem String | YYNTjtoken Token @@ -173,24 +177,24 @@ data YYsi res tok = | YYNTlambdabody Exp | YYNTlcqual Qual | YYNTlcquals [Qual] - | YYNTletdef [Def] - | YYNTletdefs [Def] + | YYNTletdef [LetMemberS] + | YYNTletdefs [LetMemberS] | YYNTliteral Exp | YYNTlocaldef [Def] | YYNTlocaldefs [Def] | YYNTmbdot Token | YYNTmemspec ImportItem | YYNTmemspecs [ImportItem] - | YYNTmethodspec (Token, String, Maybe [TauS]) + | YYNTmethodspec (Token, String, Maybe [TVar SName]) | YYNTmodule ParseResult | YYNTmoduleclause (String, Position) - | YYNTmoduledefinition Def + | YYNTmoduledefinition ModDcl | YYNTmodulename (String, Position) | YYNTmodulename1 (String, Position) - | YYNTnativedef Def + | YYNTnativedef NatDcl | YYNTnativename String | YYNTnativepur Bool - | YYNTnativespec (String, Maybe [TauS]) + | YYNTnativespec (String, Maybe [TVar SName]) | YYNToperator Token | YYNToperators [String] | YYNTopstring String @@ -231,8 +235,8 @@ data YYsi res tok = | YYNTtopex Exp | YYNTtyname SName | YYNTtypeclause (Maybe TauS) - | YYNTtypedef Def - | YYNTtyvar TauS + | YYNTtypedef TypDcl + | YYNTtyvar (TVar SName) | YYNTunex Exp | YYNTunop Token | YYNTvarid Token @@ -241,7 +245,7 @@ data YYsi res tok = | YYNTvisdalt DConS | YYNTvisibledefinition [Def] | YYNTwheredef [Def] - | YYNTwherelet [Def] + | YYNTwherelet [LetMemberS] | YYNTwheretokens [Token] | YYNTword String | YYNTwords [String]; @@ -269,6 +273,8 @@ showsi (YYStart _) = "%start "; showsi (YYNTdalts _) = ""; showsi (YYNTdatadef _) = ""; showsi (YYNTdatainit _) = ""; + showsi (YYNTdatajavadef _) = ""; + showsi (YYNTdatajavainit _) = ""; showsi (YYNTdefinition _) = ""; showsi (YYNTdefinitions _) = ""; showsi (YYNTderivedef _) = ""; @@ -292,6 +298,7 @@ showsi (YYStart _) = "%start "; showsi (YYNTfundef _) = ""; showsi (YYNTfunhead _) = ""; showsi (YYNTgargs _) = ""; + showsi (YYNTgargvars _) = ""; showsi (YYNTgetfield _) = ""; showsi (YYNTgetfields _) = ""; showsi (YYNTgqual _) = ""; @@ -494,14 +501,14 @@ private yyaction8 t = case yychar t of { }; }; private yyaction9 t = case yychar t of { - ';' -> YYAction 104; + ';' -> YYAction 106; _ -> case yytoken t of { - VARID -> YYAction 102; - WHERE -> YYAction 103; + VARID -> YYAction 104; + WHERE -> YYAction 105; _ -> YYAction yyErr; }; }; -private yyaction10 t = YYAction (-169); +private yyaction10 t = YYAction (-170); private yyaction11 t = YYAction (-12); private yyaction12 t = case yytoken t of { VARID -> YYAction 10; @@ -515,15 +522,15 @@ private yyaction12 t = case yytoken t of { PURE -> YYAction 18; _ -> YYAction yyErr; }; -private yyaction13 t = YYAction (-174); -private yyaction14 t = YYAction (-175); -private yyaction15 t = YYAction (-172); -private yyaction16 t = YYAction (-170); -private yyaction17 t = YYAction (-171); -private yyaction18 t = YYAction (-173); +private yyaction13 t = YYAction (-175); +private yyaction14 t = YYAction (-176); +private yyaction15 t = YYAction (-173); +private yyaction16 t = YYAction (-171); +private yyaction17 t = YYAction (-172); +private yyaction18 t = YYAction (-174); private yyaction19 t = YYAction (-15); private yyaction20 t = case yychar t of { - '.' -> YYAction 108; + '.' -> YYAction 110; _ -> YYAction yyErr; }; private yyaction21 t = YYAction (-20); @@ -540,46 +547,46 @@ private yyaction22 t = case yytoken t of { _ -> YYAction yyErr; }; private yyaction23 t = case yychar t of { - '-' -> YYAction (-180); - '.' -> YYAction (-180); - '(' -> YYAction (-180); - ',' -> YYAction (-168); - '|' -> YYAction (-180); - '[' -> YYAction (-180); - '?' -> YYAction (-180); - '!' -> YYAction (-180); - '=' -> YYAction (-180); - '_' -> YYAction (-180); - _ -> case yytoken t of { - VARID -> YYAction (-180); - CONID -> YYAction (-180); - QUALIFIER -> YYAction (-180); - TRUE -> YYAction (-180); - FALSE -> YYAction (-180); - DO -> YYAction (-180); - INTCONST -> YYAction (-180); - STRCONST -> YYAction (-180); - LONGCONST -> YYAction (-180); - FLTCONST -> YYAction (-180); - DBLCONST -> YYAction (-180); - DECCONST -> YYAction (-180); - CHRCONST -> YYAction (-180); - REGEXP -> YYAction (-180); - BIGCONST -> YYAction (-180); - DCOLON -> YYAction (-168); - SOMEOP -> YYAction (-180); - _ -> YYAction yyErr; - }; -}; -private yyaction24 t = YYAction (-183); + '-' -> YYAction (-181); + '.' -> YYAction (-181); + '(' -> YYAction (-181); + ',' -> YYAction (-169); + '|' -> YYAction (-181); + '[' -> YYAction (-181); + '?' -> YYAction (-181); + '!' -> YYAction (-181); + '=' -> YYAction (-181); + '_' -> YYAction (-181); + _ -> case yytoken t of { + VARID -> YYAction (-181); + CONID -> YYAction (-181); + QUALIFIER -> YYAction (-181); + TRUE -> YYAction (-181); + FALSE -> YYAction (-181); + DO -> YYAction (-181); + INTCONST -> YYAction (-181); + STRCONST -> YYAction (-181); + LONGCONST -> YYAction (-181); + FLTCONST -> YYAction (-181); + DBLCONST -> YYAction (-181); + DECCONST -> YYAction (-181); + CHRCONST -> YYAction (-181); + REGEXP -> YYAction (-181); + BIGCONST -> YYAction (-181); + DCOLON -> YYAction (-169); + SOMEOP -> YYAction (-181); + _ -> YYAction yyErr; + }; +}; +private yyaction24 t = YYAction (-184); private yyaction25 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; - '{' -> YYAction (-408); + '{' -> YYAction (-412); _ -> case yytoken t of { - VARID -> YYAction 110; - CONID -> YYAction 111; - QUALIFIER -> YYAction 112; + VARID -> YYAction 112; + CONID -> YYAction 113; + QUALIFIER -> YYAction 114; _ -> YYAction yyErr; }; }; @@ -597,74 +604,74 @@ private yyaction27 t = case yytoken t of { _ -> YYAction yyErr; }; private yyaction28 t = case yytoken t of { - INTCONST -> YYAction 116; + INTCONST -> YYAction 118; _ -> YYAction yyErr; }; private yyaction29 t = case yytoken t of { - INTCONST -> YYAction 117; + INTCONST -> YYAction 119; _ -> YYAction yyErr; }; private yyaction30 t = case yytoken t of { - INTCONST -> YYAction 118; + INTCONST -> YYAction 120; _ -> YYAction yyErr; }; private yyaction31 t = case yychar t of { - '-' -> YYAction 122; - '(' -> YYAction 123; + '-' -> YYAction 124; + '(' -> YYAction 125; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 119; - PACKAGE -> YYAction 120; - SOMEOP -> YYAction 121; + VARID -> YYAction 121; + PACKAGE -> YYAction 122; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; private yyaction32 t = case yytoken t of { - CONID -> YYAction 129; + CONID -> YYAction 131; _ -> YYAction yyErr; }; private yyaction33 t = case yytoken t of { - CONID -> YYAction 130; + CONID -> YYAction 132; _ -> YYAction yyErr; }; private yyaction34 t = case yychar t of { - '(' -> YYAction 132; + '(' -> YYAction 134; _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; private yyaction35 t = case yychar t of { - '(' -> YYAction 136; + '(' -> YYAction 138; _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; private yyaction36 t = case yytoken t of { NEWTYPE -> YYAction 32; - DATA -> YYAction 33; + DATA -> YYAction 143; _ -> YYAction yyErr; }; private yyaction37 t = case yytoken t of { - CONID -> YYAction 142; + CONID -> YYAction 145; _ -> YYAction yyErr; }; -private yyaction38 t = YYAction (-347); -private yyaction39 t = YYAction (-348); +private yyaction38 t = YYAction (-351); +private yyaction39 t = YYAction (-352); private yyaction40 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -687,14 +694,14 @@ private yyaction40 t = case yychar t of { }; private yyaction41 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -716,19 +723,19 @@ private yyaction41 t = case yychar t of { }; }; private yyaction42 t = case yychar t of { - '(' -> YYAction 136; + '(' -> YYAction 138; _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; private yyaction43 t = case yychar t of { - '{' -> YYAction 149; + '{' -> YYAction 152; _ -> YYAction yyErr; }; private yyaction44 t = case yychar t of { - '{' -> YYAction 150; + '{' -> YYAction 153; _ -> YYAction yyErr; }; private yyaction45 t = case yychar t of { @@ -743,7 +750,7 @@ private yyaction45 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; NEWTYPE -> YYAction 32; DATA -> YYAction 33; CLASS -> YYAction 34; @@ -781,7 +788,7 @@ private yyaction46 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; NEWTYPE -> YYAction 32; DATA -> YYAction 33; CLASS -> YYAction 34; @@ -819,7 +826,7 @@ private yyaction47 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; NEWTYPE -> YYAction 32; DATA -> YYAction 33; CLASS -> YYAction 34; @@ -846,27 +853,27 @@ private yyaction47 t = case yychar t of { }; }; private yyaction48 t = case yytoken t of { - NATIVE -> YYAction 151; - _ -> YYAction yyErr; - }; -private yyaction49 t = YYAction (-351); -private yyaction50 t = YYAction (-350); -private yyaction51 t = YYAction (-353); -private yyaction52 t = YYAction (-354); -private yyaction53 t = YYAction (-355); -private yyaction54 t = YYAction (-356); -private yyaction55 t = YYAction (-349); -private yyaction56 t = YYAction (-357); -private yyaction57 t = YYAction (-352); + NATIVE -> YYAction 154; + _ -> YYAction yyErr; + }; +private yyaction49 t = YYAction (-355); +private yyaction50 t = YYAction (-354); +private yyaction51 t = YYAction (-357); +private yyaction52 t = YYAction (-358); +private yyaction53 t = YYAction (-359); +private yyaction54 t = YYAction (-360); +private yyaction55 t = YYAction (-353); +private yyaction56 t = YYAction (-361); +private yyaction57 t = YYAction (-356); private yyaction58 t = case yychar t of { - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -888,17 +895,17 @@ private yyaction58 t = case yychar t of { }; }; private yyaction59 t = case yychar t of { - '-' -> YYAction 157; - '(' -> YYAction 144; - ')' -> YYAction 158; - ',' -> YYAction 159; + '-' -> YYAction 160; + '(' -> YYAction 147; + ')' -> YYAction 161; + ',' -> YYAction 162; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -916,21 +923,21 @@ private yyaction59 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - SOMEOP -> YYAction 121; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; private yyaction60 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; - ']' -> YYAction 165; + ']' -> YYAction 168; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -951,16 +958,16 @@ private yyaction60 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction61 t = YYAction (-192); -private yyaction62 t = YYAction (-191); +private yyaction61 t = YYAction (-193); +private yyaction62 t = YYAction (-192); private yyaction63 t = case yychar t of { - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -978,13 +985,13 @@ private yyaction63 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction64 t = YYAction (-426); +private yyaction64 t = YYAction (-430); private yyaction65 t = case yychar t of { - '}' -> YYAction 170; + '}' -> YYAction 173; _ -> YYAction yyBrace; }; private yyaction66 t = case yychar t of { - ';' -> YYAction 171; + ';' -> YYAction 174; '}' -> YYAction (-26); _ -> YYAction yyBrace; }; @@ -1001,71 +1008,72 @@ private yyaction76 t = YYAction (-117); private yyaction77 t = YYAction (-118); private yyaction78 t = YYAction (-119); private yyaction79 t = YYAction (-120); -private yyaction80 t = YYAction (-124); +private yyaction80 t = YYAction (-121); private yyaction81 t = YYAction (-125); -private yyaction82 t = case yychar t of { - ';' -> YYAction (-126); - '}' -> YYAction (-126); +private yyaction82 t = YYAction (-126); +private yyaction83 t = case yychar t of { + ';' -> YYAction (-127); + '}' -> YYAction (-127); _ -> case yytoken t of { - WHERE -> YYAction 172; + WHERE -> YYAction 175; _ -> YYAction yyBrace; }; }; -private yyaction83 t = YYAction (-203); -private yyaction84 t = YYAction (-424); -private yyaction85 t = case yychar t of { - '{' -> YYAction 174; - '-' -> YYAction (-427); - ';' -> YYAction (-427); - '}' -> YYAction (-427); - '.' -> YYAction (-427); - '(' -> YYAction (-427); - ')' -> YYAction (-427); - ',' -> YYAction (-427); - '|' -> YYAction (-427); - '[' -> YYAction (-427); - ']' -> YYAction (-427); - '?' -> YYAction (-427); - '!' -> YYAction (-427); - '=' -> YYAction (-427); - '\\' -> YYAction (-427); - '_' -> YYAction (-427); - _ -> case yytoken t of { - VARID -> YYAction (-427); - CONID -> YYAction (-427); - QUALIFIER -> YYAction (-427); - WHERE -> YYAction (-427); - TRUE -> YYAction (-427); - FALSE -> YYAction (-427); - THEN -> YYAction (-427); - ELSE -> YYAction (-427); - OF -> YYAction (-427); - DO -> YYAction (-427); - INTCONST -> YYAction (-427); - STRCONST -> YYAction (-427); - LONGCONST -> YYAction (-427); - FLTCONST -> YYAction (-427); - DBLCONST -> YYAction (-427); - DECCONST -> YYAction (-427); - CHRCONST -> YYAction (-427); - REGEXP -> YYAction (-427); - BIGCONST -> YYAction (-427); - ARROW -> YYAction (-427); - DCOLON -> YYAction (-427); - GETS -> YYAction (-427); - DOTDOT -> YYAction (-427); - SOMEOP -> YYAction (-427); +private yyaction84 t = YYAction (-204); +private yyaction85 t = YYAction (-428); +private yyaction86 t = case yychar t of { + '{' -> YYAction 177; + '-' -> YYAction (-431); + ';' -> YYAction (-431); + '}' -> YYAction (-431); + '.' -> YYAction (-431); + '(' -> YYAction (-431); + ')' -> YYAction (-431); + ',' -> YYAction (-431); + '|' -> YYAction (-431); + '[' -> YYAction (-431); + ']' -> YYAction (-431); + '?' -> YYAction (-431); + '!' -> YYAction (-431); + '=' -> YYAction (-431); + '\\' -> YYAction (-431); + '_' -> YYAction (-431); + _ -> case yytoken t of { + VARID -> YYAction (-431); + CONID -> YYAction (-431); + QUALIFIER -> YYAction (-431); + WHERE -> YYAction (-431); + TRUE -> YYAction (-431); + FALSE -> YYAction (-431); + THEN -> YYAction (-431); + ELSE -> YYAction (-431); + OF -> YYAction (-431); + DO -> YYAction (-431); + INTCONST -> YYAction (-431); + STRCONST -> YYAction (-431); + LONGCONST -> YYAction (-431); + FLTCONST -> YYAction (-431); + DBLCONST -> YYAction (-431); + DECCONST -> YYAction (-431); + CHRCONST -> YYAction (-431); + REGEXP -> YYAction (-431); + BIGCONST -> YYAction (-431); + ARROW -> YYAction (-431); + DCOLON -> YYAction (-431); + GETS -> YYAction (-431); + DOTDOT -> YYAction (-431); + SOMEOP -> YYAction (-431); _ -> YYAction yyBrace; }; }; -private yyaction86 t = case yychar t of { - '(' -> YYAction 144; +private yyaction87 t = case yychar t of { + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1083,67 +1091,75 @@ private yyaction86 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction87 t = case yychar t of { - '-' -> YYAction 177; +private yyaction88 t = case yychar t of { + '-' -> YYAction 180; _ -> case yytoken t of { - VARID -> YYAction 176; - SOMEOP -> YYAction 121; + VARID -> YYAction 179; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction88 t = case yytoken t of { - DCOLON -> YYAction 181; +private yyaction89 t = case yytoken t of { + DCOLON -> YYAction 184; _ -> YYAction yyErr; }; -private yyaction89 t = case yychar t of { - ',' -> YYAction 182; +private yyaction90 t = case yychar t of { + ',' -> YYAction 185; _ -> case yytoken t of { - DCOLON -> YYAction (-207); + DCOLON -> YYAction (-208); _ -> YYAction yyErr; }; }; -private yyaction90 t = YYAction (-210); -private yyaction91 t = case yychar t of { - ';' -> YYAction (-338); - '}' -> YYAction (-338); +private yyaction91 t = YYAction (-211); +private yyaction92 t = case yychar t of { + ';' -> YYAction (-342); + '}' -> YYAction (-342); _ -> case yytoken t of { - WHERE -> YYAction 183; + WHERE -> YYAction 186; _ -> YYAction yyBrace; }; }; -private yyaction92 t = case yychar t of { - '|' -> YYAction 185; - '=' -> YYAction 186; +private yyaction93 t = case yychar t of { + ';' -> YYAction (-342); + '}' -> YYAction (-342); + _ -> case yytoken t of { + WHERE -> YYAction 186; + _ -> YYAction yyBrace; + }; +}; +private yyaction94 t = case yychar t of { + '|' -> YYAction 189; + '=' -> YYAction 190; _ -> YYAction yyErr; }; -private yyaction93 t = case yychar t of { - '-' -> YYAction 190; - '|' -> YYAction (-346); - '=' -> YYAction (-346); +private yyaction95 t = case yychar t of { + '-' -> YYAction 194; + '|' -> YYAction (-350); + '=' -> YYAction (-350); _ -> case yytoken t of { - SOMEOP -> YYAction 189; + SOMEOP -> YYAction 193; _ -> YYAction yyErr; }; }; -private yyaction94 t = YYAction (-425); -private yyaction95 t = YYAction (-400); -private yyaction96 t = YYAction (-396); -private yyaction97 t = case yychar t of { - '(' -> YYAction 144; +private yyaction96 t = YYAction (-429); +private yyaction97 t = YYAction (-404); +private yyaction98 t = YYAction (-400); +private yyaction99 t = case yychar t of { + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; - '-' -> YYAction (-401); - ';' -> YYAction (-401); - '}' -> YYAction (-401); - ')' -> YYAction (-401); - ',' -> YYAction (-401); - '|' -> YYAction (-401); - ']' -> YYAction (-401); - '=' -> YYAction (-401); - _ -> case yytoken t of { - VARID -> YYAction 143; + '-' -> YYAction (-405); + ';' -> YYAction (-405); + '}' -> YYAction (-405); + ')' -> YYAction (-405); + ',' -> YYAction (-405); + '|' -> YYAction (-405); + ']' -> YYAction (-405); + '=' -> YYAction (-405); + _ -> case yytoken t of { + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1158,74 +1174,74 @@ private yyaction97 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - WHERE -> YYAction (-401); - THEN -> YYAction (-401); - ELSE -> YYAction (-401); - OF -> YYAction (-401); - ARROW -> YYAction (-401); - DCOLON -> YYAction (-401); - GETS -> YYAction (-401); - DOTDOT -> YYAction (-401); - SOMEOP -> YYAction (-401); + WHERE -> YYAction (-405); + THEN -> YYAction (-405); + ELSE -> YYAction (-405); + OF -> YYAction (-405); + ARROW -> YYAction (-405); + DCOLON -> YYAction (-405); + GETS -> YYAction (-405); + DOTDOT -> YYAction (-405); + SOMEOP -> YYAction (-405); _ -> YYAction yyBrace; }; }; -private yyaction98 t = YYAction (-402); -private yyaction99 t = case yychar t of { - '.' -> YYAction 192; - '-' -> YYAction (-404); - ';' -> YYAction (-404); - '}' -> YYAction (-404); - '(' -> YYAction (-404); - ')' -> YYAction (-404); - ',' -> YYAction (-404); - '|' -> YYAction (-404); - '[' -> YYAction (-404); - ']' -> YYAction (-404); - '?' -> YYAction (-404); - '!' -> YYAction (-404); - '=' -> YYAction (-404); - '\\' -> YYAction (-404); - '_' -> YYAction (-404); - _ -> case yytoken t of { - VARID -> YYAction (-404); - CONID -> YYAction (-404); - QUALIFIER -> YYAction (-404); - WHERE -> YYAction (-404); - TRUE -> YYAction (-404); - FALSE -> YYAction (-404); - THEN -> YYAction (-404); - ELSE -> YYAction (-404); - OF -> YYAction (-404); - DO -> YYAction (-404); - INTCONST -> YYAction (-404); - STRCONST -> YYAction (-404); - LONGCONST -> YYAction (-404); - FLTCONST -> YYAction (-404); - DBLCONST -> YYAction (-404); - DECCONST -> YYAction (-404); - CHRCONST -> YYAction (-404); - REGEXP -> YYAction (-404); - BIGCONST -> YYAction (-404); - ARROW -> YYAction (-404); - DCOLON -> YYAction (-404); - GETS -> YYAction (-404); - DOTDOT -> YYAction (-404); - SOMEOP -> YYAction (-404); +private yyaction100 t = YYAction (-406); +private yyaction101 t = case yychar t of { + '.' -> YYAction 196; + '-' -> YYAction (-408); + ';' -> YYAction (-408); + '}' -> YYAction (-408); + '(' -> YYAction (-408); + ')' -> YYAction (-408); + ',' -> YYAction (-408); + '|' -> YYAction (-408); + '[' -> YYAction (-408); + ']' -> YYAction (-408); + '?' -> YYAction (-408); + '!' -> YYAction (-408); + '=' -> YYAction (-408); + '\\' -> YYAction (-408); + '_' -> YYAction (-408); + _ -> case yytoken t of { + VARID -> YYAction (-408); + CONID -> YYAction (-408); + QUALIFIER -> YYAction (-408); + WHERE -> YYAction (-408); + TRUE -> YYAction (-408); + FALSE -> YYAction (-408); + THEN -> YYAction (-408); + ELSE -> YYAction (-408); + OF -> YYAction (-408); + DO -> YYAction (-408); + INTCONST -> YYAction (-408); + STRCONST -> YYAction (-408); + LONGCONST -> YYAction (-408); + FLTCONST -> YYAction (-408); + DBLCONST -> YYAction (-408); + DECCONST -> YYAction (-408); + CHRCONST -> YYAction (-408); + REGEXP -> YYAction (-408); + BIGCONST -> YYAction (-408); + ARROW -> YYAction (-408); + DCOLON -> YYAction (-408); + GETS -> YYAction (-408); + DOTDOT -> YYAction (-408); + SOMEOP -> YYAction (-408); _ -> YYAction yyBrace; }; }; -private yyaction100 t = case yychar t of { - '{' -> YYAction 193; +private yyaction102 t = case yychar t of { + '{' -> YYAction 197; _ -> YYAction yyErr; }; -private yyaction101 t = YYAction (-410); -private yyaction102 t = YYAction (-23); -private yyaction103 t = case yychar t of { - '{' -> YYAction 194; +private yyaction103 t = YYAction (-414); +private yyaction104 t = YYAction (-23); +private yyaction105 t = case yychar t of { + '{' -> YYAction 198; _ -> YYAction yyErr; }; -private yyaction104 t = case yychar t of { +private yyaction106 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -1272,19 +1288,19 @@ private yyaction104 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction105 t = case yychar t of { - '(' -> YYAction 196; +private yyaction107 t = case yychar t of { + '(' -> YYAction 200; _ -> YYAction yyErr; }; -private yyaction106 t = case yychar t of { +private yyaction108 t = case yychar t of { '(' -> YYAction (-24); _ -> case yytoken t of { - VARID -> YYAction 102; + VARID -> YYAction 104; _ -> YYAction yyErr; }; }; -private yyaction107 t = YYAction (-14); -private yyaction108 t = case yytoken t of { +private yyaction109 t = YYAction (-14); +private yyaction110 t = case yytoken t of { VARID -> YYAction 10; CONID -> YYAction 11; QUALIFIER -> YYAction 12; @@ -1296,176 +1312,180 @@ private yyaction108 t = case yytoken t of { PURE -> YYAction 18; _ -> YYAction yyErr; }; -private yyaction109 t = YYAction (-21); -private yyaction110 t = YYAction (-184); -private yyaction111 t = YYAction (-182); -private yyaction112 t = case yychar t of { +private yyaction111 t = YYAction (-21); +private yyaction112 t = YYAction (-185); +private yyaction113 t = YYAction (-183); +private yyaction114 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; - '{' -> YYAction (-409); + '{' -> YYAction (-413); _ -> case yytoken t of { - VARID -> YYAction 110; - CONID -> YYAction 199; + VARID -> YYAction 112; + CONID -> YYAction 203; _ -> YYAction yyErr; }; }; -private yyaction113 t = YYAction (-185); -private yyaction114 t = YYAction (-179); -private yyaction115 t = case yychar t of { - '(' -> YYAction 204; - ';' -> YYAction (-142); - '}' -> YYAction (-142); +private yyaction115 t = YYAction (-186); +private yyaction116 t = YYAction (-180); +private yyaction117 t = case yychar t of { + '(' -> YYAction 208; + ';' -> YYAction (-143); + '}' -> YYAction (-143); _ -> case yytoken t of { - VARID -> YYAction 201; - CONID -> YYAction 202; - PUBLIC -> YYAction 203; + VARID -> YYAction 205; + CONID -> YYAction 206; + PUBLIC -> YYAction 207; _ -> YYAction yyBrace; }; }; -private yyaction116 t = YYAction (-193); -private yyaction117 t = YYAction (-195); private yyaction118 t = YYAction (-194); -private yyaction119 t = YYAction (-168); -private yyaction120 t = case yytoken t of { - TYPE -> YYAction 207; +private yyaction119 t = YYAction (-196); +private yyaction120 t = YYAction (-195); +private yyaction121 t = YYAction (-169); +private yyaction122 t = case yytoken t of { + TYPE -> YYAction 211; WHERE -> YYAction (-41); CLASS -> YYAction (-41); _ -> YYAction yyErr; }; -private yyaction121 t = YYAction (-190); -private yyaction122 t = YYAction (-213); -private yyaction123 t = case yychar t of { - '-' -> YYAction 209; +private yyaction123 t = YYAction (-191); +private yyaction124 t = YYAction (-214); +private yyaction125 t = case yychar t of { + '-' -> YYAction 213; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - SOMEOP -> YYAction 121; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction124 t = YYAction (-214); -private yyaction125 t = YYAction (-212); -private yyaction126 t = YYAction (-211); -private yyaction127 t = case yychar t of { - '{' -> YYAction 217; +private yyaction126 t = YYAction (-215); +private yyaction127 t = YYAction (-213); +private yyaction128 t = YYAction (-212); +private yyaction129 t = case yychar t of { + '{' -> YYAction 221; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; - SOMEOP -> YYAction 121; - DCOLON -> YYAction (-221); + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; + SOMEOP -> YYAction 123; + DCOLON -> YYAction (-222); _ -> YYAction yyErr; }; }; -private yyaction128 t = case yytoken t of { - DCOLON -> YYAction 224; +private yyaction130 t = case yytoken t of { + DCOLON -> YYAction 228; _ -> YYAction yyErr; }; -private yyaction129 t = case yychar t of { - '(' -> YYAction 226; - '=' -> YYAction 227; +private yyaction131 t = case yychar t of { + '(' -> YYAction 230; + '=' -> YYAction 231; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; _ -> YYAction yyErr; }; }; -private yyaction130 t = case yychar t of { - '(' -> YYAction 226; - '=' -> YYAction 230; - ';' -> YYAction (-293); - '}' -> YYAction (-293); +private yyaction132 t = case yychar t of { + '(' -> YYAction 230; + '=' -> YYAction 234; + ';' -> YYAction (-295); + '}' -> YYAction (-295); _ -> case yytoken t of { - VARID -> YYAction 225; - WHERE -> YYAction (-293); + VARID -> YYAction 229; + WHERE -> YYAction (-295); _ -> YYAction yyBrace; }; }; -private yyaction131 t = case yytoken t of { - CONID -> YYAction 111; - QUALIFIER -> YYAction 232; +private yyaction133 t = case yytoken t of { + CONID -> YYAction 113; + QUALIFIER -> YYAction 236; _ -> YYAction yyErr; }; -private yyaction132 t = case yytoken t of { +private yyaction134 t = case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; -private yyaction133 t = case yychar t of { - '(' -> YYAction 226; +private yyaction135 t = case yychar t of { + '(' -> YYAction 230; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; _ -> YYAction yyErr; }; }; -private yyaction134 t = YYAction (-268); -private yyaction135 t = case yychar t of { - ';' -> YYAction (-338); - '}' -> YYAction (-338); +private yyaction136 t = YYAction (-269); +private yyaction137 t = case yychar t of { + ';' -> YYAction (-342); + '}' -> YYAction (-342); _ -> case yytoken t of { - WHERE -> YYAction 183; - EARROW -> YYAction 236; + WHERE -> YYAction 186; + EARROW -> YYAction 240; _ -> YYAction yyBrace; }; }; -private yyaction136 t = case yytoken t of { +private yyaction138 t = case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; -private yyaction137 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction139 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction138 t = YYAction (-276); -private yyaction139 t = case yychar t of { - ';' -> YYAction (-279); - '}' -> YYAction (-279); +private yyaction140 t = YYAction (-277); +private yyaction141 t = case yychar t of { + ';' -> YYAction (-280); + '}' -> YYAction (-280); _ -> case yytoken t of { - EARROW -> YYAction 246; - WHERE -> YYAction (-279); + EARROW -> YYAction 250; + WHERE -> YYAction (-280); _ -> YYAction yyBrace; }; }; -private yyaction140 t = case yychar t of { - ';' -> YYAction (-338); - '}' -> YYAction (-338); +private yyaction142 t = case yychar t of { + ';' -> YYAction (-342); + '}' -> YYAction (-342); _ -> case yytoken t of { - WHERE -> YYAction 183; + WHERE -> YYAction 186; _ -> YYAction yyBrace; }; }; -private yyaction141 t = YYAction (-35); -private yyaction142 t = case yychar t of { - '(' -> YYAction 226; - '=' -> YYAction 248; +private yyaction143 t = case yytoken t of { + CONID -> YYAction 252; + _ -> YYAction yyErr; + }; +private yyaction144 t = YYAction (-35); +private yyaction145 t = case yychar t of { + '(' -> YYAction 230; + '=' -> YYAction 253; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; _ -> YYAction yyErr; }; }; -private yyaction143 t = YYAction (-180); -private yyaction144 t = case yychar t of { - '-' -> YYAction 250; - '(' -> YYAction 144; - ')' -> YYAction 158; - ',' -> YYAction 159; +private yyaction146 t = YYAction (-181); +private yyaction147 t = case yychar t of { + '-' -> YYAction 255; + '(' -> YYAction 147; + ')' -> YYAction 161; + ',' -> YYAction 162; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1483,45 +1503,45 @@ private yyaction144 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - SOMEOP -> YYAction 121; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction145 t = case yychar t of { - ';' -> YYAction 254; - _ -> case yytoken t of { - THEN -> YYAction 253; - _ -> YYAction yyErr; - }; -}; -private yyaction146 t = case yychar t of { - '-' -> YYAction 190; - ';' -> YYAction (-388); - '}' -> YYAction (-388); - ')' -> YYAction (-388); - ',' -> YYAction (-388); - '|' -> YYAction (-388); - ']' -> YYAction (-388); - '=' -> YYAction (-388); - _ -> case yytoken t of { - DCOLON -> YYAction 256; - SOMEOP -> YYAction 189; - WHERE -> YYAction (-388); - THEN -> YYAction (-388); - ELSE -> YYAction (-388); - OF -> YYAction (-388); - ARROW -> YYAction (-388); - GETS -> YYAction (-388); - DOTDOT -> YYAction (-388); +private yyaction148 t = case yychar t of { + ';' -> YYAction 259; + _ -> case yytoken t of { + THEN -> YYAction 258; + _ -> YYAction yyErr; + }; +}; +private yyaction149 t = case yychar t of { + '-' -> YYAction 194; + ';' -> YYAction (-392); + '}' -> YYAction (-392); + ')' -> YYAction (-392); + ',' -> YYAction (-392); + '|' -> YYAction (-392); + ']' -> YYAction (-392); + '=' -> YYAction (-392); + _ -> case yytoken t of { + DCOLON -> YYAction 261; + SOMEOP -> YYAction 193; + WHERE -> YYAction (-392); + THEN -> YYAction (-392); + ELSE -> YYAction (-392); + OF -> YYAction (-392); + ARROW -> YYAction (-392); + GETS -> YYAction (-392); + DOTDOT -> YYAction (-392); _ -> YYAction yyBrace; }; }; -private yyaction147 t = case yytoken t of { - OF -> YYAction 257; +private yyaction150 t = case yytoken t of { + OF -> YYAction 262; _ -> YYAction yyErr; }; -private yyaction148 t = YYAction (-281); -private yyaction149 t = case yychar t of { +private yyaction151 t = YYAction (-282); +private yyaction152 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -1551,23 +1571,23 @@ private yyaction149 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction150 t = case yychar t of { +private yyaction153 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; - LET -> YYAction 262; + LET -> YYAction 267; DO -> YYAction 44; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -1581,32 +1601,32 @@ private yyaction150 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction151 t = case yychar t of { - '-' -> YYAction 122; - '(' -> YYAction 123; +private yyaction154 t = case yychar t of { + '-' -> YYAction 124; + '(' -> YYAction 125; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 119; - SOMEOP -> YYAction 121; + VARID -> YYAction 121; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction152 t = YYAction (-32); -private yyaction153 t = YYAction (-33); -private yyaction154 t = YYAction (-34); -private yyaction155 t = YYAction (-209); -private yyaction156 t = YYAction (-395); -private yyaction157 t = case yychar t of { - '(' -> YYAction 144; - ')' -> YYAction 267; +private yyaction155 t = YYAction (-32); +private yyaction156 t = YYAction (-33); +private yyaction157 t = YYAction (-34); +private yyaction158 t = YYAction (-210); +private yyaction159 t = YYAction (-399); +private yyaction160 t = case yychar t of { + '(' -> YYAction 147; + ')' -> YYAction 272; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1627,23 +1647,23 @@ private yyaction157 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction158 t = YYAction (-430); -private yyaction159 t = case yychar t of { - ',' -> YYAction 159; - ')' -> YYAction (-446); +private yyaction161 t = YYAction (-434); +private yyaction162 t = case yychar t of { + ',' -> YYAction 162; + ')' -> YYAction (-450); _ -> YYAction yyErr; }; -private yyaction160 t = case yychar t of { +private yyaction163 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; - ')' -> YYAction 269; + '(' -> YYAction 147; + ')' -> YYAction 274; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1664,15 +1684,15 @@ private yyaction160 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction161 t = case yychar t of { - '(' -> YYAction 144; - ')' -> YYAction 271; +private yyaction164 t = case yychar t of { + '(' -> YYAction 147; + ')' -> YYAction 276; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1690,60 +1710,60 @@ private yyaction161 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction162 t = case yychar t of { - ')' -> YYAction 272; +private yyaction165 t = case yychar t of { + ')' -> YYAction 277; _ -> YYAction yyErr; }; -private yyaction163 t = case yychar t of { - ';' -> YYAction 273; - ')' -> YYAction 274; - ',' -> YYAction 275; +private yyaction166 t = case yychar t of { + ';' -> YYAction 278; + ')' -> YYAction 279; + ',' -> YYAction 280; _ -> YYAction yyErr; }; -private yyaction164 t = case yychar t of { - '-' -> YYAction 277; - ';' -> YYAction (-388); - ')' -> YYAction (-388); - ',' -> YYAction (-388); +private yyaction167 t = case yychar t of { + '-' -> YYAction 282; + ';' -> YYAction (-392); + ')' -> YYAction (-392); + ',' -> YYAction (-392); _ -> case yytoken t of { - DCOLON -> YYAction 256; - SOMEOP -> YYAction 276; + DCOLON -> YYAction 261; + SOMEOP -> YYAction 281; _ -> YYAction yyErr; }; }; -private yyaction165 t = YYAction (-441); -private yyaction166 t = case yychar t of { - ',' -> YYAction 279; - '|' -> YYAction 280; - ']' -> YYAction (-459); +private yyaction168 t = YYAction (-445); +private yyaction169 t = case yychar t of { + ',' -> YYAction 284; + '|' -> YYAction 285; + ']' -> YYAction (-463); _ -> case yytoken t of { - DOTDOT -> YYAction (-459); + DOTDOT -> YYAction (-463); _ -> YYAction yyErr; }; }; -private yyaction167 t = case yychar t of { - ']' -> YYAction 282; +private yyaction170 t = case yychar t of { + ']' -> YYAction 287; _ -> case yytoken t of { - DOTDOT -> YYAction 281; + DOTDOT -> YYAction 286; _ -> YYAction yyErr; }; }; -private yyaction168 t = case yychar t of { +private yyaction171 t = case yychar t of { '\\' -> YYAction 63; _ -> case yytoken t of { - ARROW -> YYAction 283; + ARROW -> YYAction 288; _ -> YYAction yyErr; }; }; -private yyaction169 t = case yychar t of { - '(' -> YYAction 144; +private yyaction172 t = case yychar t of { + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; - '\\' -> YYAction (-406); + '\\' -> YYAction (-410); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1758,12 +1778,12 @@ private yyaction169 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - ARROW -> YYAction (-406); + ARROW -> YYAction (-410); _ -> YYAction yyErr; }; }; -private yyaction170 t = YYAction (-3); -private yyaction171 t = case yychar t of { +private yyaction173 t = YYAction (-3); +private yyaction174 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -1811,66 +1831,67 @@ private yyaction171 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction172 t = case yychar t of { - '{' -> YYAction 288; +private yyaction175 t = case yychar t of { + '{' -> YYAction 293; _ -> YYAction yyErr; }; -private yyaction173 t = YYAction (-345); -private yyaction174 t = case yychar t of { - '}' -> YYAction 289; +private yyaction176 t = YYAction (-349); +private yyaction177 t = case yychar t of { + '}' -> YYAction 294; _ -> case yytoken t of { - VARID -> YYAction 119; + VARID -> YYAction 121; _ -> YYAction yyBrace; }; }; -private yyaction175 t = YYAction (-405); -private yyaction176 t = YYAction (-197); -private yyaction177 t = YYAction (-198); -private yyaction178 t = YYAction (-196); -private yyaction179 t = case yychar t of { - '-' -> YYAction 177; - ';' -> YYAction (-199); - '}' -> YYAction (-199); +private yyaction178 t = YYAction (-409); +private yyaction179 t = YYAction (-198); +private yyaction180 t = YYAction (-199); +private yyaction181 t = YYAction (-197); +private yyaction182 t = case yychar t of { + '-' -> YYAction 180; + ';' -> YYAction (-200); + '}' -> YYAction (-200); _ -> case yytoken t of { - VARID -> YYAction 176; - SOMEOP -> YYAction 121; + VARID -> YYAction 179; + SOMEOP -> YYAction 123; _ -> YYAction yyBrace; }; }; -private yyaction180 t = YYAction (-201); -private yyaction181 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction183 t = YYAction (-202); +private yyaction184 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction182 t = case yychar t of { - '(' -> YYAction 123; +private yyaction185 t = case yychar t of { + '(' -> YYAction 125; _ -> case yytoken t of { - VARID -> YYAction 119; + VARID -> YYAction 121; _ -> YYAction yyErr; }; }; -private yyaction183 t = case yychar t of { - '{' -> YYAction 303; +private yyaction186 t = case yychar t of { + '{' -> YYAction 308; _ -> YYAction yyErr; }; -private yyaction184 t = YYAction (-282); -private yyaction185 t = case yychar t of { +private yyaction187 t = YYAction (-283); +private yyaction188 t = YYAction (-284); +private yyaction189 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1891,16 +1912,16 @@ private yyaction185 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction186 t = case yychar t of { +private yyaction190 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1921,26 +1942,26 @@ private yyaction186 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction187 t = YYAction (-344); -private yyaction188 t = case yychar t of { - '|' -> YYAction 185; - ';' -> YYAction (-376); - '}' -> YYAction (-376); +private yyaction191 t = YYAction (-348); +private yyaction192 t = case yychar t of { + '|' -> YYAction 189; + ';' -> YYAction (-380); + '}' -> YYAction (-380); _ -> case yytoken t of { - WHERE -> YYAction (-376); + WHERE -> YYAction (-380); _ -> YYAction yyBrace; }; }; -private yyaction189 t = case yychar t of { +private yyaction193 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1961,16 +1982,16 @@ private yyaction189 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction190 t = case yychar t of { +private yyaction194 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -1991,23 +2012,23 @@ private yyaction190 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction191 t = YYAction (-403); -private yyaction192 t = case yychar t of { - '{' -> YYAction 312; - '[' -> YYAction 313; +private yyaction195 t = YYAction (-407); +private yyaction196 t = case yychar t of { + '{' -> YYAction 317; + '[' -> YYAction 318; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 311; - SOMEOP -> YYAction 121; + VARID -> YYAction 316; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction193 t = case yytoken t of { - VARID -> YYAction 316; +private yyaction197 t = case yytoken t of { + VARID -> YYAction 321; _ -> YYAction yyErr; }; -private yyaction194 t = case yychar t of { +private yyaction198 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -2054,96 +2075,96 @@ private yyaction194 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction195 t = YYAction (-1); -private yyaction196 t = case yychar t of { +private yyaction199 t = YYAction (-1); +private yyaction200 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; - QUALIFIER -> YYAction 320; - SOMEOP -> YYAction 121; + VARID -> YYAction 112; + QUALIFIER -> YYAction 325; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction197 t = YYAction (-25); -private yyaction198 t = YYAction (-13); -private yyaction199 t = YYAction (-181); -private yyaction200 t = YYAction (-178); -private yyaction201 t = case yychar t of { - '(' -> YYAction (-168); +private yyaction201 t = YYAction (-25); +private yyaction202 t = YYAction (-13); +private yyaction203 t = YYAction (-182); +private yyaction204 t = YYAction (-179); +private yyaction205 t = case yychar t of { + '(' -> YYAction (-169); _ -> case yytoken t of { - CONID -> YYAction 325; + CONID -> YYAction 330; _ -> YYAction yyErr; }; }; -private yyaction202 t = case yychar t of { - '(' -> YYAction 204; - ';' -> YYAction (-142); - '}' -> YYAction (-142); +private yyaction206 t = case yychar t of { + '(' -> YYAction 208; + ';' -> YYAction (-143); + '}' -> YYAction (-143); _ -> case yytoken t of { - VARID -> YYAction 119; - PUBLIC -> YYAction 203; + VARID -> YYAction 121; + PUBLIC -> YYAction 207; _ -> YYAction yyBrace; }; }; -private yyaction203 t = case yychar t of { - '(' -> YYAction 204; - ';' -> YYAction (-142); - '}' -> YYAction (-142); +private yyaction207 t = case yychar t of { + '(' -> YYAction 208; + ';' -> YYAction (-143); + '}' -> YYAction (-143); _ -> case yytoken t of { - VARID -> YYAction 119; - PUBLIC -> YYAction 203; + VARID -> YYAction 121; + PUBLIC -> YYAction 207; _ -> YYAction yyBrace; }; }; -private yyaction204 t = case yychar t of { - ')' -> YYAction 331; +private yyaction208 t = case yychar t of { + ')' -> YYAction 336; '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 143; - CONID -> YYAction 328; - QUALIFIER -> YYAction 329; - PUBLIC -> YYAction 330; - SOMEOP -> YYAction 121; + VARID -> YYAction 146; + CONID -> YYAction 333; + QUALIFIER -> YYAction 334; + PUBLIC -> YYAction 335; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction205 t = YYAction (-139); -private yyaction206 t = case yychar t of { - '(' -> YYAction 339; +private yyaction209 t = YYAction (-140); +private yyaction210 t = case yychar t of { + '(' -> YYAction 344; _ -> YYAction yyErr; }; -private yyaction207 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction211 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction208 t = case yytoken t of { - CLASS -> YYAction 343; +private yyaction212 t = case yytoken t of { + CLASS -> YYAction 348; WHERE -> YYAction (-43); _ -> YYAction yyErr; }; -private yyaction209 t = case yychar t of { - ')' -> YYAction 345; +private yyaction213 t = case yychar t of { + ')' -> YYAction 350; _ -> YYAction yyErr; }; -private yyaction210 t = case yychar t of { - ')' -> YYAction 346; +private yyaction214 t = case yychar t of { + ')' -> YYAction 351; _ -> YYAction yyErr; }; -private yyaction211 t = case yychar t of { - ')' -> YYAction 347; +private yyaction215 t = case yychar t of { + ')' -> YYAction 352; _ -> YYAction yyErr; }; -private yyaction212 t = case yychar t of { - '.' -> YYAction 348; +private yyaction216 t = case yychar t of { + '.' -> YYAction 353; ';' -> YYAction (-5); '{' -> YYAction (-5); '}' -> YYAction (-5); @@ -2153,17 +2174,17 @@ private yyaction212 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction213 t = YYAction (-6); -private yyaction214 t = case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; +private yyaction217 t = YYAction (-6); +private yyaction218 t = case yytoken t of { + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; _ -> YYAction yyErr; }; -private yyaction215 t = case yychar t of { - '.' -> YYAction 350; +private yyaction219 t = case yychar t of { + '.' -> YYAction 355; ';' -> YYAction (-7); '{' -> YYAction (-7); '}' -> YYAction (-7); @@ -2173,188 +2194,195 @@ private yyaction215 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction216 t = YYAction (-11); -private yyaction217 t = case yychar t of { - '}' -> YYAction 351; - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction220 t = YYAction (-11); +private yyaction221 t = case yychar t of { + '}' -> YYAction 356; + '(' -> YYAction 230; _ -> case yytoken t of { - VARID -> YYAction 225; - CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + VARID -> YYAction 229; _ -> YYAction yyBrace; }; }; -private yyaction218 t = YYAction (-215); -private yyaction219 t = YYAction (-4); -private yyaction220 t = YYAction (-216); -private yyaction221 t = YYAction (-217); -private yyaction222 t = case yychar t of { - '{' -> YYAction 217; +private yyaction222 t = YYAction (-216); +private yyaction223 t = YYAction (-4); +private yyaction224 t = YYAction (-217); +private yyaction225 t = YYAction (-218); +private yyaction226 t = case yychar t of { + '{' -> YYAction 221; _ -> case yytoken t of { - DCOLON -> YYAction (-219); + DCOLON -> YYAction (-220); _ -> YYAction yyErr; }; }; -private yyaction223 t = YYAction (-220); -private yyaction224 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction227 t = YYAction (-221); +private yyaction228 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction225 t = YYAction (-250); -private yyaction226 t = case yytoken t of { - VARID -> YYAction 358; - EXTENDS -> YYAction 359; - SUPER -> YYAction 360; +private yyaction229 t = YYAction (-251); +private yyaction230 t = case yytoken t of { + VARID -> YYAction 363; + EXTENDS -> YYAction 364; + SUPER -> YYAction 365; _ -> YYAction yyErr; }; -private yyaction227 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction231 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - DOCUMENTATION -> YYAction 362; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; }; -private yyaction228 t = case yychar t of { - '=' -> YYAction 372; +private yyaction232 t = case yychar t of { + '=' -> YYAction 377; _ -> YYAction yyErr; }; -private yyaction229 t = case yychar t of { - '(' -> YYAction 226; - '.' -> YYAction (-296); - '=' -> YYAction (-296); +private yyaction233 t = case yychar t of { + '(' -> YYAction 230; + '.' -> YYAction (-300); + '=' -> YYAction (-300); _ -> case yytoken t of { - VARID -> YYAction 225; - SOMEOP -> YYAction (-296); + VARID -> YYAction 229; + SOMEOP -> YYAction (-300); _ -> YYAction yyErr; }; }; -private yyaction230 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction234 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - DOCUMENTATION -> YYAction 362; - NATIVE -> YYAction 374; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; - PURE -> YYAction 375; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + NATIVE -> YYAction 379; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; + PURE -> YYAction 380; _ -> YYAction yyErr; }; }; -private yyaction231 t = case yychar t of { - '=' -> YYAction 379; +private yyaction235 t = case yychar t of { + '=' -> YYAction 384; _ -> YYAction yyErr; }; -private yyaction232 t = case yytoken t of { - CONID -> YYAction 199; +private yyaction236 t = case yytoken t of { + CONID -> YYAction 203; _ -> YYAction yyErr; }; -private yyaction233 t = case yychar t of { - ',' -> YYAction 380; - ')' -> YYAction (-265); +private yyaction237 t = case yychar t of { + ',' -> YYAction 385; + ')' -> YYAction (-266); _ -> YYAction yyErr; }; -private yyaction234 t = case yychar t of { - ')' -> YYAction 381; +private yyaction238 t = case yychar t of { + ')' -> YYAction 386; _ -> YYAction yyErr; }; -private yyaction235 t = YYAction (-264); -private yyaction236 t = case yytoken t of { - CONID -> YYAction 382; +private yyaction239 t = YYAction (-265); +private yyaction240 t = case yytoken t of { + CONID -> YYAction 387; _ -> YYAction yyErr; }; -private yyaction237 t = YYAction (-271); -private yyaction238 t = case yychar t of { - ',' -> YYAction 383; - ')' -> YYAction (-273); +private yyaction241 t = YYAction (-272); +private yyaction242 t = case yychar t of { + ',' -> YYAction 388; + ')' -> YYAction (-274); _ -> YYAction yyErr; }; -private yyaction239 t = case yychar t of { - ')' -> YYAction 384; +private yyaction243 t = case yychar t of { + ')' -> YYAction 389; _ -> YYAction yyErr; }; -private yyaction240 t = case yychar t of { - '(' -> YYAction 240; - ')' -> YYAction 387; - ',' -> YYAction 159; - '[' -> YYAction 241; +private yyaction244 t = case yychar t of { + '(' -> YYAction 244; + ')' -> YYAction 392; + ',' -> YYAction 162; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 385; + VARID -> YYAction 390; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - EXTENDS -> YYAction 359; - SUPER -> YYAction 360; - FORALL -> YYAction 294; - ARROW -> YYAction 386; + QUALIFIER -> YYAction 133; + EXTENDS -> YYAction 364; + SUPER -> YYAction 365; + FORALL -> YYAction 299; + ARROW -> YYAction 391; _ -> YYAction yyErr; }; }; -private yyaction241 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; - ']' -> YYAction 390; +private yyaction245 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + ']' -> YYAction 395; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction242 t = YYAction (-255); -private yyaction243 t = YYAction (-272); -private yyaction244 t = YYAction (-244); -private yyaction245 t = YYAction (-245); -private yyaction246 t = case yychar t of { - '(' -> YYAction 392; - '[' -> YYAction 393; +private yyaction246 t = YYAction (-256); +private yyaction247 t = YYAction (-273); +private yyaction248 t = YYAction (-245); +private yyaction249 t = YYAction (-246); +private yyaction250 t = case yychar t of { + '(' -> YYAction 397; + '[' -> YYAction 398; _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction247 t = YYAction (-280); -private yyaction248 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction251 t = YYAction (-281); +private yyaction252 t = case yychar t of { + '(' -> YYAction 230; + '=' -> YYAction 400; + ';' -> YYAction (-295); + '}' -> YYAction (-295); _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; + WHERE -> YYAction (-295); + _ -> YYAction yyBrace; + }; +}; +private yyaction253 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + _ -> case yytoken t of { + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction249 t = case yychar t of { - '=' -> YYAction 396; +private yyaction254 t = case yychar t of { + '=' -> YYAction 403; _ -> YYAction yyErr; }; -private yyaction250 t = case yychar t of { - '(' -> YYAction 144; - ')' -> YYAction 397; +private yyaction255 t = case yychar t of { + '(' -> YYAction 147; + ')' -> YYAction 404; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2375,17 +2403,17 @@ private yyaction250 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction251 t = case yychar t of { +private yyaction256 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; - ')' -> YYAction 398; + '(' -> YYAction 147; + ')' -> YYAction 405; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2406,15 +2434,15 @@ private yyaction251 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction252 t = case yychar t of { - '(' -> YYAction 144; - ')' -> YYAction 399; +private yyaction257 t = case yychar t of { + '(' -> YYAction 147; + ')' -> YYAction 406; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2432,21 +2460,21 @@ private yyaction252 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction253 t = YYAction (-390); -private yyaction254 t = case yytoken t of { - THEN -> YYAction 400; +private yyaction258 t = YYAction (-394); +private yyaction259 t = case yytoken t of { + THEN -> YYAction 407; _ -> YYAction yyErr; }; -private yyaction255 t = case yychar t of { +private yyaction260 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2467,176 +2495,176 @@ private yyaction255 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction256 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction261 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction257 t = case yychar t of { - '{' -> YYAction 403; +private yyaction262 t = case yychar t of { + '{' -> YYAction 410; _ -> YYAction yyErr; }; -private yyaction258 t = YYAction (-134); -private yyaction259 t = case yychar t of { - ';' -> YYAction (-135); - '}' -> YYAction (-135); +private yyaction263 t = YYAction (-135); +private yyaction264 t = case yychar t of { + ';' -> YYAction (-136); + '}' -> YYAction (-136); _ -> case yytoken t of { - WHERE -> YYAction 172; + WHERE -> YYAction 175; _ -> YYAction yyBrace; }; }; -private yyaction260 t = case yychar t of { - ';' -> YYAction 404; - '}' -> YYAction (-136); +private yyaction265 t = case yychar t of { + ';' -> YYAction 411; + '}' -> YYAction (-137); _ -> YYAction yyBrace; }; -private yyaction261 t = case yychar t of { - '}' -> YYAction 405; +private yyaction266 t = case yychar t of { + '}' -> YYAction 412; _ -> YYAction yyBrace; }; -private yyaction262 t = case yychar t of { - '{' -> YYAction 406; +private yyaction267 t = case yychar t of { + '{' -> YYAction 413; _ -> YYAction yyErr; }; -private yyaction263 t = case yychar t of { - '=' -> YYAction 408; - ';' -> YYAction (-370); - '}' -> YYAction (-370); - ',' -> YYAction (-370); - ']' -> YYAction (-370); +private yyaction268 t = case yychar t of { + '=' -> YYAction 415; + ';' -> YYAction (-374); + '}' -> YYAction (-374); + ',' -> YYAction (-374); + ']' -> YYAction (-374); _ -> case yytoken t of { - GETS -> YYAction 407; + GETS -> YYAction 414; _ -> YYAction yyBrace; }; }; -private yyaction264 t = case yychar t of { - ';' -> YYAction 409; - '}' -> YYAction (-367); +private yyaction269 t = case yychar t of { + ';' -> YYAction 416; + '}' -> YYAction (-371); _ -> YYAction yyBrace; }; -private yyaction265 t = YYAction (-361); -private yyaction266 t = case yychar t of { - '}' -> YYAction 410; +private yyaction270 t = YYAction (-365); +private yyaction271 t = case yychar t of { + '}' -> YYAction 417; _ -> YYAction yyBrace; }; -private yyaction267 t = case yychar t of { - '-' -> YYAction (-434); - '.' -> YYAction (-434); - '(' -> YYAction (-434); - ',' -> YYAction (-206); - '|' -> YYAction (-434); - '[' -> YYAction (-434); - '?' -> YYAction (-434); - '!' -> YYAction (-434); - '=' -> YYAction (-434); - '_' -> YYAction (-434); - _ -> case yytoken t of { - VARID -> YYAction (-434); - CONID -> YYAction (-434); - QUALIFIER -> YYAction (-434); - TRUE -> YYAction (-434); - FALSE -> YYAction (-434); - DO -> YYAction (-434); - INTCONST -> YYAction (-434); - STRCONST -> YYAction (-434); - LONGCONST -> YYAction (-434); - FLTCONST -> YYAction (-434); - DBLCONST -> YYAction (-434); - DECCONST -> YYAction (-434); - CHRCONST -> YYAction (-434); - REGEXP -> YYAction (-434); - BIGCONST -> YYAction (-434); - DCOLON -> YYAction (-206); - SOMEOP -> YYAction (-434); +private yyaction272 t = case yychar t of { + '-' -> YYAction (-438); + '.' -> YYAction (-438); + '(' -> YYAction (-438); + ',' -> YYAction (-207); + '|' -> YYAction (-438); + '[' -> YYAction (-438); + '?' -> YYAction (-438); + '!' -> YYAction (-438); + '=' -> YYAction (-438); + '_' -> YYAction (-438); + _ -> case yytoken t of { + VARID -> YYAction (-438); + CONID -> YYAction (-438); + QUALIFIER -> YYAction (-438); + TRUE -> YYAction (-438); + FALSE -> YYAction (-438); + DO -> YYAction (-438); + INTCONST -> YYAction (-438); + STRCONST -> YYAction (-438); + LONGCONST -> YYAction (-438); + FLTCONST -> YYAction (-438); + DBLCONST -> YYAction (-438); + DECCONST -> YYAction (-438); + CHRCONST -> YYAction (-438); + REGEXP -> YYAction (-438); + BIGCONST -> YYAction (-438); + DCOLON -> YYAction (-207); + SOMEOP -> YYAction (-438); _ -> YYAction yyErr; }; }; -private yyaction268 t = YYAction (-447); -private yyaction269 t = case yychar t of { - '-' -> YYAction (-433); - '.' -> YYAction (-433); - '(' -> YYAction (-433); - ',' -> YYAction (-204); - '|' -> YYAction (-433); - '[' -> YYAction (-433); - '?' -> YYAction (-433); - '!' -> YYAction (-433); - '=' -> YYAction (-433); - '_' -> YYAction (-433); - _ -> case yytoken t of { - VARID -> YYAction (-433); - CONID -> YYAction (-433); - QUALIFIER -> YYAction (-433); - TRUE -> YYAction (-433); - FALSE -> YYAction (-433); - DO -> YYAction (-433); - INTCONST -> YYAction (-433); - STRCONST -> YYAction (-433); - LONGCONST -> YYAction (-433); - FLTCONST -> YYAction (-433); - DBLCONST -> YYAction (-433); - DECCONST -> YYAction (-433); - CHRCONST -> YYAction (-433); - REGEXP -> YYAction (-433); - BIGCONST -> YYAction (-433); - DCOLON -> YYAction (-204); - SOMEOP -> YYAction (-433); - _ -> YYAction yyErr; - }; -}; -private yyaction270 t = case yychar t of { - ')' -> YYAction 411; - _ -> YYAction yyErr; -}; -private yyaction271 t = case yychar t of { - '-' -> YYAction (-432); - '.' -> YYAction (-432); - '(' -> YYAction (-432); +private yyaction273 t = YYAction (-451); +private yyaction274 t = case yychar t of { + '-' -> YYAction (-437); + '.' -> YYAction (-437); + '(' -> YYAction (-437); ',' -> YYAction (-205); - '|' -> YYAction (-432); - '[' -> YYAction (-432); - '?' -> YYAction (-432); - '!' -> YYAction (-432); - '=' -> YYAction (-432); - '_' -> YYAction (-432); - _ -> case yytoken t of { - VARID -> YYAction (-432); - CONID -> YYAction (-432); - QUALIFIER -> YYAction (-432); - TRUE -> YYAction (-432); - FALSE -> YYAction (-432); - DO -> YYAction (-432); - INTCONST -> YYAction (-432); - STRCONST -> YYAction (-432); - LONGCONST -> YYAction (-432); - FLTCONST -> YYAction (-432); - DBLCONST -> YYAction (-432); - DECCONST -> YYAction (-432); - CHRCONST -> YYAction (-432); - REGEXP -> YYAction (-432); - BIGCONST -> YYAction (-432); + '|' -> YYAction (-437); + '[' -> YYAction (-437); + '?' -> YYAction (-437); + '!' -> YYAction (-437); + '=' -> YYAction (-437); + '_' -> YYAction (-437); + _ -> case yytoken t of { + VARID -> YYAction (-437); + CONID -> YYAction (-437); + QUALIFIER -> YYAction (-437); + TRUE -> YYAction (-437); + FALSE -> YYAction (-437); + DO -> YYAction (-437); + INTCONST -> YYAction (-437); + STRCONST -> YYAction (-437); + LONGCONST -> YYAction (-437); + FLTCONST -> YYAction (-437); + DBLCONST -> YYAction (-437); + DECCONST -> YYAction (-437); + CHRCONST -> YYAction (-437); + REGEXP -> YYAction (-437); + BIGCONST -> YYAction (-437); DCOLON -> YYAction (-205); - SOMEOP -> YYAction (-432); + SOMEOP -> YYAction (-437); + _ -> YYAction yyErr; + }; +}; +private yyaction275 t = case yychar t of { + ')' -> YYAction 418; + _ -> YYAction yyErr; +}; +private yyaction276 t = case yychar t of { + '-' -> YYAction (-436); + '.' -> YYAction (-436); + '(' -> YYAction (-436); + ',' -> YYAction (-206); + '|' -> YYAction (-436); + '[' -> YYAction (-436); + '?' -> YYAction (-436); + '!' -> YYAction (-436); + '=' -> YYAction (-436); + '_' -> YYAction (-436); + _ -> case yytoken t of { + VARID -> YYAction (-436); + CONID -> YYAction (-436); + QUALIFIER -> YYAction (-436); + TRUE -> YYAction (-436); + FALSE -> YYAction (-436); + DO -> YYAction (-436); + INTCONST -> YYAction (-436); + STRCONST -> YYAction (-436); + LONGCONST -> YYAction (-436); + FLTCONST -> YYAction (-436); + DBLCONST -> YYAction (-436); + DECCONST -> YYAction (-436); + CHRCONST -> YYAction (-436); + REGEXP -> YYAction (-436); + BIGCONST -> YYAction (-436); + DCOLON -> YYAction (-206); + SOMEOP -> YYAction (-436); _ -> YYAction yyErr; }; }; -private yyaction272 t = YYAction (-431); -private yyaction273 t = case yychar t of { +private yyaction277 t = YYAction (-435); +private yyaction278 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2657,17 +2685,17 @@ private yyaction273 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction274 t = YYAction (-440); -private yyaction275 t = case yychar t of { +private yyaction279 t = YYAction (-444); +private yyaction280 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2688,17 +2716,17 @@ private yyaction275 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction276 t = case yychar t of { +private yyaction281 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - ')' -> YYAction (-190); + ')' -> YYAction (-191); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2719,17 +2747,17 @@ private yyaction276 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction277 t = case yychar t of { +private yyaction282 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; - ')' -> YYAction 416; + '(' -> YYAction 147; + ')' -> YYAction 423; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2750,22 +2778,22 @@ private yyaction277 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction278 t = case yychar t of { - ')' -> YYAction 417; +private yyaction283 t = case yychar t of { + ')' -> YYAction 424; _ -> YYAction yyErr; }; -private yyaction279 t = case yychar t of { +private yyaction284 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - ')' -> YYAction (-461); - ']' -> YYAction (-461); + ')' -> YYAction (-465); + ']' -> YYAction (-465); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2783,27 +2811,27 @@ private yyaction279 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - DOTDOT -> YYAction (-461); + DOTDOT -> YYAction (-465); _ -> YYAction yyErr; }; }; -private yyaction280 t = case yychar t of { +private yyaction285 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; - LET -> YYAction 262; + LET -> YYAction 267; DO -> YYAction 44; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -2817,17 +2845,17 @@ private yyaction280 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction281 t = case yychar t of { +private yyaction286 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; - ']' -> YYAction 421; + ']' -> YYAction 428; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2848,17 +2876,17 @@ private yyaction281 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction282 t = YYAction (-442); -private yyaction283 t = case yychar t of { +private yyaction287 t = YYAction (-446); +private yyaction288 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -2879,13 +2907,13 @@ private yyaction283 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction284 t = YYAction (-385); -private yyaction285 t = YYAction (-384); -private yyaction286 t = YYAction (-407); -private yyaction287 t = YYAction (-28); -private yyaction288 t = case yychar t of { +private yyaction289 t = YYAction (-389); +private yyaction290 t = YYAction (-388); +private yyaction291 t = YYAction (-411); +private yyaction292 t = YYAction (-28); +private yyaction293 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 424; + '}' -> YYAction 431; '(' -> YYAction 59; '[' -> YYAction 60; '?' -> YYAction 61; @@ -2914,96 +2942,96 @@ private yyaction288 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction289 t = YYAction (-428); -private yyaction290 t = case yychar t of { - '=' -> YYAction 426; - '}' -> YYAction (-458); - ',' -> YYAction (-458); +private yyaction294 t = YYAction (-432); +private yyaction295 t = case yychar t of { + '=' -> YYAction 433; + '}' -> YYAction (-462); + ',' -> YYAction (-462); _ -> YYAction yyBrace; }; -private yyaction291 t = case yychar t of { - '}' -> YYAction 427; +private yyaction296 t = case yychar t of { + '}' -> YYAction 434; _ -> YYAction yyBrace; }; -private yyaction292 t = case yychar t of { - ',' -> YYAction 428; - '}' -> YYAction (-448); +private yyaction297 t = case yychar t of { + ',' -> YYAction 435; + '}' -> YYAction (-452); _ -> YYAction yyBrace; }; -private yyaction293 t = YYAction (-200); -private yyaction294 t = case yychar t of { - '(' -> YYAction 226; - _ -> case yytoken t of { - VARID -> YYAction 225; - _ -> YYAction yyErr; - }; -}; -private yyaction295 t = YYAction (-202); -private yyaction296 t = YYAction (-227); -private yyaction297 t = YYAction (-228); -private yyaction298 t = case yychar t of { - '-' -> YYAction (-234); - ';' -> YYAction (-234); - '}' -> YYAction (-234); - ')' -> YYAction (-234); - ',' -> YYAction (-234); - '|' -> YYAction (-234); - ']' -> YYAction (-234); - '=' -> YYAction (-234); - _ -> case yytoken t of { - ARROW -> YYAction 430; - EARROW -> YYAction 431; - DOCUMENTATION -> YYAction (-234); - WHERE -> YYAction (-234); - CLASS -> YYAction (-234); - THEN -> YYAction (-234); - ELSE -> YYAction (-234); - OF -> YYAction (-234); - THROWS -> YYAction (-234); - DCOLON -> YYAction (-234); - GETS -> YYAction (-234); - DOTDOT -> YYAction (-234); - SOMEOP -> YYAction (-234); +private yyaction298 t = YYAction (-201); +private yyaction299 t = case yychar t of { + '(' -> YYAction 230; + _ -> case yytoken t of { + VARID -> YYAction 229; + _ -> YYAction yyErr; + }; +}; +private yyaction300 t = YYAction (-203); +private yyaction301 t = YYAction (-228); +private yyaction302 t = YYAction (-229); +private yyaction303 t = case yychar t of { + '-' -> YYAction (-235); + ';' -> YYAction (-235); + '}' -> YYAction (-235); + ')' -> YYAction (-235); + ',' -> YYAction (-235); + '|' -> YYAction (-235); + ']' -> YYAction (-235); + '=' -> YYAction (-235); + _ -> case yytoken t of { + ARROW -> YYAction 437; + EARROW -> YYAction 438; + DOCUMENTATION -> YYAction (-235); + WHERE -> YYAction (-235); + CLASS -> YYAction (-235); + THEN -> YYAction (-235); + ELSE -> YYAction (-235); + OF -> YYAction (-235); + THROWS -> YYAction (-235); + DCOLON -> YYAction (-235); + GETS -> YYAction (-235); + DOTDOT -> YYAction (-235); + SOMEOP -> YYAction (-235); _ -> YYAction yyBrace; }; }; -private yyaction299 t = YYAction (-233); -private yyaction300 t = YYAction (-243); -private yyaction301 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; - '-' -> YYAction (-319); - ';' -> YYAction (-319); - '}' -> YYAction (-319); - ')' -> YYAction (-319); - ',' -> YYAction (-319); - '|' -> YYAction (-319); - ']' -> YYAction (-319); - '=' -> YYAction (-319); - _ -> case yytoken t of { - VARID -> YYAction 225; +private yyaction304 t = YYAction (-234); +private yyaction305 t = YYAction (-244); +private yyaction306 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + '-' -> YYAction (-323); + ';' -> YYAction (-323); + '}' -> YYAction (-323); + ')' -> YYAction (-323); + ',' -> YYAction (-323); + '|' -> YYAction (-323); + ']' -> YYAction (-323); + '=' -> YYAction (-323); + _ -> case yytoken t of { + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - DOCUMENTATION -> YYAction (-319); - WHERE -> YYAction (-319); - CLASS -> YYAction (-319); - THEN -> YYAction (-319); - ELSE -> YYAction (-319); - OF -> YYAction (-319); - THROWS -> YYAction (-319); - ARROW -> YYAction (-319); - DCOLON -> YYAction (-319); - GETS -> YYAction (-319); - EARROW -> YYAction (-319); - DOTDOT -> YYAction (-319); - SOMEOP -> YYAction (-319); + QUALIFIER -> YYAction 133; + DOCUMENTATION -> YYAction (-323); + WHERE -> YYAction (-323); + CLASS -> YYAction (-323); + THEN -> YYAction (-323); + ELSE -> YYAction (-323); + OF -> YYAction (-323); + THROWS -> YYAction (-323); + ARROW -> YYAction (-323); + DCOLON -> YYAction (-323); + GETS -> YYAction (-323); + EARROW -> YYAction (-323); + DOTDOT -> YYAction (-323); + SOMEOP -> YYAction (-323); _ -> YYAction yyBrace; }; }; -private yyaction302 t = YYAction (-208); -private yyaction303 t = case yychar t of { +private yyaction307 t = YYAction (-209); +private yyaction308 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 436; + '}' -> YYAction 443; '(' -> YYAction 59; '[' -> YYAction 60; '?' -> YYAction 61; @@ -3015,16 +3043,16 @@ private yyaction303 t = case yychar t of { CONID -> YYAction 24; QUALIFIER -> YYAction 25; DOCUMENTATION -> YYAction 26; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; LET -> YYAction 43; DO -> YYAction 44; - PRIVATE -> YYAction 433; - PROTECTED -> YYAction 434; - PUBLIC -> YYAction 435; + PRIVATE -> YYAction 440; + PROTECTED -> YYAction 441; + PUBLIC -> YYAction 442; PURE -> YYAction 48; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -3038,91 +3066,91 @@ private yyaction303 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction304 t = case yychar t of { - ',' -> YYAction (-370); - '=' -> YYAction (-370); +private yyaction309 t = case yychar t of { + ',' -> YYAction (-374); + '=' -> YYAction (-374); _ -> case yytoken t of { - GETS -> YYAction 407; - ARROW -> YYAction (-370); + GETS -> YYAction 414; + ARROW -> YYAction (-374); _ -> YYAction yyErr; }; }; -private yyaction305 t = case yychar t of { - ',' -> YYAction 442; - '=' -> YYAction (-372); +private yyaction310 t = case yychar t of { + ',' -> YYAction 449; + '=' -> YYAction (-376); _ -> case yytoken t of { - ARROW -> YYAction (-372); + ARROW -> YYAction (-376); _ -> YYAction yyErr; }; }; -private yyaction306 t = case yychar t of { - '=' -> YYAction 444; +private yyaction311 t = case yychar t of { + '=' -> YYAction 451; _ -> case yytoken t of { - ARROW -> YYAction 443; - _ -> YYAction yyErr; - }; -}; -private yyaction307 t = YYAction (-343); -private yyaction308 t = YYAction (-377); -private yyaction309 t = case yychar t of { - '-' -> YYAction 190; - ';' -> YYAction (-393); - '}' -> YYAction (-393); - ')' -> YYAction (-393); - ',' -> YYAction (-393); - '|' -> YYAction (-393); - ']' -> YYAction (-393); - '=' -> YYAction (-393); - _ -> case yytoken t of { - SOMEOP -> YYAction 189; - WHERE -> YYAction (-393); - THEN -> YYAction (-393); - ELSE -> YYAction (-393); - OF -> YYAction (-393); - ARROW -> YYAction (-393); - DCOLON -> YYAction (-393); - GETS -> YYAction (-393); - DOTDOT -> YYAction (-393); + ARROW -> YYAction 450; + _ -> YYAction yyErr; + }; +}; +private yyaction312 t = YYAction (-347); +private yyaction313 t = YYAction (-381); +private yyaction314 t = case yychar t of { + '-' -> YYAction 194; + ';' -> YYAction (-397); + '}' -> YYAction (-397); + ')' -> YYAction (-397); + ',' -> YYAction (-397); + '|' -> YYAction (-397); + ']' -> YYAction (-397); + '=' -> YYAction (-397); + _ -> case yytoken t of { + SOMEOP -> YYAction 193; + WHERE -> YYAction (-397); + THEN -> YYAction (-397); + ELSE -> YYAction (-397); + OF -> YYAction (-397); + ARROW -> YYAction (-397); + DCOLON -> YYAction (-397); + GETS -> YYAction (-397); + DOTDOT -> YYAction (-397); _ -> YYAction yyBrace; }; }; -private yyaction310 t = case yychar t of { - '-' -> YYAction 190; - ';' -> YYAction (-394); - '}' -> YYAction (-394); - ')' -> YYAction (-394); - ',' -> YYAction (-394); - '|' -> YYAction (-394); - ']' -> YYAction (-394); - '=' -> YYAction (-394); - _ -> case yytoken t of { - SOMEOP -> YYAction 189; - WHERE -> YYAction (-394); - THEN -> YYAction (-394); - ELSE -> YYAction (-394); - OF -> YYAction (-394); - ARROW -> YYAction (-394); - DCOLON -> YYAction (-394); - GETS -> YYAction (-394); - DOTDOT -> YYAction (-394); +private yyaction315 t = case yychar t of { + '-' -> YYAction 194; + ';' -> YYAction (-398); + '}' -> YYAction (-398); + ')' -> YYAction (-398); + ',' -> YYAction (-398); + '|' -> YYAction (-398); + ']' -> YYAction (-398); + '=' -> YYAction (-398); + _ -> case yytoken t of { + SOMEOP -> YYAction 193; + WHERE -> YYAction (-398); + THEN -> YYAction (-398); + ELSE -> YYAction (-398); + OF -> YYAction (-398); + ARROW -> YYAction (-398); + DCOLON -> YYAction (-398); + GETS -> YYAction (-398); + DOTDOT -> YYAction (-398); _ -> YYAction yyBrace; }; }; -private yyaction311 t = YYAction (-412); -private yyaction312 t = case yytoken t of { - VARID -> YYAction 446; +private yyaction316 t = YYAction (-416); +private yyaction317 t = case yytoken t of { + VARID -> YYAction 453; _ -> YYAction yyErr; }; -private yyaction313 t = case yychar t of { +private yyaction318 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -3143,483 +3171,493 @@ private yyaction313 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction314 t = YYAction (-413); -private yyaction315 t = YYAction (-414); -private yyaction316 t = case yychar t of { - '?' -> YYAction 450; - '=' -> YYAction 451; - '}' -> YYAction (-456); - ',' -> YYAction (-456); +private yyaction319 t = YYAction (-417); +private yyaction320 t = YYAction (-418); +private yyaction321 t = case yychar t of { + '?' -> YYAction 457; + '=' -> YYAction 458; + '}' -> YYAction (-460); + ',' -> YYAction (-460); _ -> case yytoken t of { - GETS -> YYAction 449; + GETS -> YYAction 456; _ -> YYAction yyBrace; }; }; -private yyaction317 t = case yychar t of { - '}' -> YYAction 452; +private yyaction322 t = case yychar t of { + '}' -> YYAction 459; _ -> YYAction yyBrace; }; -private yyaction318 t = case yychar t of { - ',' -> YYAction 453; - '}' -> YYAction (-451); +private yyaction323 t = case yychar t of { + ',' -> YYAction 460; + '}' -> YYAction (-455); _ -> YYAction yyBrace; }; -private yyaction319 t = case yychar t of { - '}' -> YYAction 454; +private yyaction324 t = case yychar t of { + '}' -> YYAction 461; _ -> YYAction yyBrace; }; -private yyaction320 t = case yychar t of { +private yyaction325 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; - QUALIFIER -> YYAction 455; + VARID -> YYAction 112; + QUALIFIER -> YYAction 462; _ -> YYAction yyErr; }; }; -private yyaction321 t = case yychar t of { - ')' -> YYAction 457; +private yyaction326 t = case yychar t of { + ')' -> YYAction 464; _ -> YYAction yyErr; }; -private yyaction322 t = YYAction (-189); -private yyaction323 t = case yychar t of { - ',' -> YYAction 458; - ')' -> YYAction (-176); +private yyaction327 t = YYAction (-190); +private yyaction328 t = case yychar t of { + ',' -> YYAction 465; + ')' -> YYAction (-177); _ -> YYAction yyErr; }; -private yyaction324 t = YYAction (-188); -private yyaction325 t = case yychar t of { - '(' -> YYAction 204; - ';' -> YYAction (-142); - '}' -> YYAction (-142); +private yyaction329 t = YYAction (-189); +private yyaction330 t = case yychar t of { + '(' -> YYAction 208; + ';' -> YYAction (-143); + '}' -> YYAction (-143); _ -> case yytoken t of { - VARID -> YYAction 119; - PUBLIC -> YYAction 203; + VARID -> YYAction 121; + PUBLIC -> YYAction 207; _ -> YYAction yyBrace; }; }; -private yyaction326 t = YYAction (-141); -private yyaction327 t = YYAction (-146); -private yyaction328 t = case yychar t of { - '(' -> YYAction 460; - ')' -> YYAction (-183); - ',' -> YYAction (-183); +private yyaction331 t = YYAction (-142); +private yyaction332 t = YYAction (-147); +private yyaction333 t = case yychar t of { + '(' -> YYAction 467; + ')' -> YYAction (-184); + ',' -> YYAction (-184); _ -> case yytoken t of { - VARID -> YYAction (-183); - CONID -> YYAction (-183); - SOMEOP -> YYAction (-183); + VARID -> YYAction (-184); + CONID -> YYAction (-184); + SOMEOP -> YYAction (-184); _ -> YYAction yyErr; }; }; -private yyaction329 t = case yychar t of { +private yyaction334 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; - CONID -> YYAction 111; - QUALIFIER -> YYAction 461; + VARID -> YYAction 112; + CONID -> YYAction 113; + QUALIFIER -> YYAction 468; _ -> YYAction yyErr; }; }; -private yyaction330 t = case yychar t of { +private yyaction335 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 143; - CONID -> YYAction 328; - QUALIFIER -> YYAction 329; - PUBLIC -> YYAction 330; - SOMEOP -> YYAction 121; + VARID -> YYAction 146; + CONID -> YYAction 333; + QUALIFIER -> YYAction 334; + PUBLIC -> YYAction 335; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction331 t = YYAction (-144); -private yyaction332 t = case yychar t of { - ')' -> YYAction 463; +private yyaction336 t = YYAction (-145); +private yyaction337 t = case yychar t of { + ')' -> YYAction 470; _ -> YYAction yyErr; }; -private yyaction333 t = case yychar t of { - ',' -> YYAction 464; - ')' -> YYAction (-147); +private yyaction338 t = case yychar t of { + ',' -> YYAction 471; + ')' -> YYAction (-148); _ -> YYAction yyErr; }; -private yyaction334 t = case yychar t of { - ')' -> YYAction (-156); - ',' -> YYAction (-156); +private yyaction339 t = case yychar t of { + ')' -> YYAction (-157); + ',' -> YYAction (-157); _ -> case yytoken t of { - VARID -> YYAction 465; - CONID -> YYAction 466; - SOMEOP -> YYAction 121; + VARID -> YYAction 472; + CONID -> YYAction 473; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction335 t = YYAction (-150); -private yyaction336 t = YYAction (-153); -private yyaction337 t = YYAction (-154); -private yyaction338 t = YYAction (-155); -private yyaction339 t = case yychar t of { +private yyaction340 t = YYAction (-151); +private yyaction341 t = YYAction (-154); +private yyaction342 t = YYAction (-155); +private yyaction343 t = YYAction (-156); +private yyaction344 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 143; - CONID -> YYAction 328; - QUALIFIER -> YYAction 329; - PUBLIC -> YYAction 330; - SOMEOP -> YYAction 121; + VARID -> YYAction 146; + CONID -> YYAction 333; + QUALIFIER -> YYAction 334; + PUBLIC -> YYAction 335; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction340 t = YYAction (-42); -private yyaction341 t = YYAction (-237); -private yyaction342 t = case yychar t of { - ';' -> YYAction (-236); - '}' -> YYAction (-236); - ')' -> YYAction (-236); - ',' -> YYAction (-236); - '|' -> YYAction (-236); - ']' -> YYAction (-236); +private yyaction345 t = YYAction (-42); +private yyaction346 t = YYAction (-238); +private yyaction347 t = case yychar t of { + ';' -> YYAction (-237); + '}' -> YYAction (-237); + ')' -> YYAction (-237); + ',' -> YYAction (-237); + '|' -> YYAction (-237); + ']' -> YYAction (-237); _ -> case yytoken t of { - ARROW -> YYAction 470; - WHERE -> YYAction (-236); - CLASS -> YYAction (-236); + ARROW -> YYAction 477; + WHERE -> YYAction (-237); + CLASS -> YYAction (-237); _ -> YYAction yyBrace; }; }; -private yyaction343 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction348 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction344 t = case yytoken t of { - WHERE -> YYAction 472; +private yyaction349 t = case yytoken t of { + WHERE -> YYAction 480; _ -> YYAction yyErr; }; -private yyaction345 t = YYAction (-206); -private yyaction346 t = YYAction (-204); -private yyaction347 t = YYAction (-205); -private yyaction348 t = case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; +private yyaction350 t = YYAction (-207); +private yyaction351 t = YYAction (-205); +private yyaction352 t = YYAction (-206); +private yyaction353 t = case yytoken t of { + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; _ -> YYAction yyErr; }; -private yyaction349 t = YYAction (-10); -private yyaction350 t = case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; +private yyaction354 t = YYAction (-10); +private yyaction355 t = case yytoken t of { + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; _ -> YYAction yyErr; }; -private yyaction351 t = YYAction (-288); -private yyaction352 t = case yychar t of { - ',' -> YYAction 476; - ';' -> YYAction (-239); - '}' -> YYAction (-239); - ')' -> YYAction (-239); - '|' -> YYAction (-239); - _ -> case yytoken t of { - WHERE -> YYAction (-239); - _ -> YYAction yyBrace; - }; +private yyaction356 t = YYAction (-292); +private yyaction357 t = case yychar t of { + ',' -> YYAction 484; + '}' -> YYAction (-289); + _ -> YYAction yyBrace; }; -private yyaction353 t = case yychar t of { - '}' -> YYAction 477; +private yyaction358 t = case yychar t of { + '}' -> YYAction 485; _ -> YYAction yyBrace; }; -private yyaction354 t = YYAction (-218); -private yyaction355 t = case yychar t of { - ';' -> YYAction (-223); - '}' -> YYAction (-223); - '|' -> YYAction (-223); +private yyaction359 t = YYAction (-219); +private yyaction360 t = case yychar t of { + ';' -> YYAction (-224); + '}' -> YYAction (-224); + '|' -> YYAction (-224); _ -> case yytoken t of { - THROWS -> YYAction 478; + THROWS -> YYAction 486; _ -> YYAction yyBrace; }; }; -private yyaction356 t = case yychar t of { - '|' -> YYAction 479; - ';' -> YYAction (-224); - '}' -> YYAction (-224); +private yyaction361 t = case yychar t of { + '|' -> YYAction 487; + ';' -> YYAction (-225); + '}' -> YYAction (-225); _ -> YYAction yyBrace; }; -private yyaction357 t = YYAction (-226); -private yyaction358 t = case yytoken t of { - EXTENDS -> YYAction 480; - DCOLON -> YYAction 481; +private yyaction362 t = YYAction (-227); +private yyaction363 t = case yytoken t of { + EXTENDS -> YYAction 488; + DCOLON -> YYAction 489; _ -> YYAction yyErr; }; -private yyaction359 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction364 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction360 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction365 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction361 t = case yychar t of { - '{' -> YYAction 484; - '(' -> YYAction 240; - '[' -> YYAction 241; - '?' -> YYAction 485; - '!' -> YYAction 486; - ';' -> YYAction (-310); - '}' -> YYAction (-310); - '|' -> YYAction (-310); - _ -> case yytoken t of { - VARID -> YYAction 225; +private yyaction366 t = case yychar t of { + '{' -> YYAction 492; + '(' -> YYAction 244; + '[' -> YYAction 245; + '?' -> YYAction 493; + '!' -> YYAction 494; + ';' -> YYAction (-314); + '}' -> YYAction (-314); + '|' -> YYAction (-314); + _ -> case yytoken t of { + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - DOCUMENTATION -> YYAction (-310); - WHERE -> YYAction (-310); + QUALIFIER -> YYAction 133; + DOCUMENTATION -> YYAction (-314); + WHERE -> YYAction (-314); _ -> YYAction yyBrace; }; }; -private yyaction362 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction367 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; + CONID -> YYAction 366; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; }; -private yyaction363 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction368 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; + CONID -> YYAction 366; _ -> YYAction yyErr; }; }; -private yyaction364 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction369 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; + CONID -> YYAction 366; _ -> YYAction yyErr; }; }; -private yyaction365 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction370 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; + CONID -> YYAction 366; _ -> YYAction yyErr; }; }; -private yyaction366 t = case yytoken t of { - CONID -> YYAction 361; +private yyaction371 t = case yytoken t of { + CONID -> YYAction 366; _ -> YYAction yyErr; }; -private yyaction367 t = case yytoken t of { - CONID -> YYAction 361; +private yyaction372 t = case yytoken t of { + CONID -> YYAction 366; _ -> YYAction yyErr; }; -private yyaction368 t = YYAction (-295); -private yyaction369 t = case yychar t of { - ';' -> YYAction (-300); - '}' -> YYAction (-300); - '|' -> YYAction (-300); +private yyaction373 t = YYAction (-297); +private yyaction374 t = case yychar t of { + ';' -> YYAction (-304); + '}' -> YYAction (-304); + '|' -> YYAction (-304); _ -> case yytoken t of { - DOCUMENTATION -> YYAction 497; - WHERE -> YYAction (-300); + DOCUMENTATION -> YYAction 505; + WHERE -> YYAction (-304); _ -> YYAction yyBrace; }; }; -private yyaction370 t = YYAction (-303); -private yyaction371 t = YYAction (-309); -private yyaction372 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction375 t = YYAction (-307); +private yyaction376 t = YYAction (-313); +private yyaction377 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - DOCUMENTATION -> YYAction 362; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; }; -private yyaction373 t = YYAction (-297); -private yyaction374 t = YYAction (-284); -private yyaction375 t = case yytoken t of { - NATIVE -> YYAction 499; +private yyaction378 t = YYAction (-301); +private yyaction379 t = YYAction (-286); +private yyaction380 t = case yytoken t of { + NATIVE -> YYAction 507; _ -> YYAction yyErr; }; -private yyaction376 t = case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; +private yyaction381 t = case yytoken t of { + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; _ -> YYAction yyErr; }; -private yyaction377 t = YYAction (-292); -private yyaction378 t = case yychar t of { - '|' -> YYAction 502; - ';' -> YYAction (-298); - '}' -> YYAction (-298); +private yyaction382 t = YYAction (-294); +private yyaction383 t = case yychar t of { + '|' -> YYAction 510; + ';' -> YYAction (-302); + '}' -> YYAction (-302); _ -> case yytoken t of { - WHERE -> YYAction (-298); + WHERE -> YYAction (-302); _ -> YYAction yyBrace; }; }; -private yyaction379 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction384 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - DOCUMENTATION -> YYAction 362; - NATIVE -> YYAction 374; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; - PURE -> YYAction 375; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + NATIVE -> YYAction 379; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; + PURE -> YYAction 380; _ -> YYAction yyErr; }; }; -private yyaction380 t = case yychar t of { - ')' -> YYAction (-266); +private yyaction385 t = case yychar t of { + ')' -> YYAction (-267); _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction381 t = YYAction (-269); -private yyaction382 t = case yychar t of { - '(' -> YYAction 226; +private yyaction386 t = YYAction (-270); +private yyaction387 t = case yychar t of { + '(' -> YYAction 230; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; _ -> YYAction yyErr; }; }; -private yyaction383 t = case yychar t of { - ')' -> YYAction (-274); +private yyaction388 t = case yychar t of { + ')' -> YYAction (-275); _ -> case yytoken t of { CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction384 t = YYAction (-277); -private yyaction385 t = case yychar t of { - '(' -> YYAction (-250); - ')' -> YYAction (-250); - ',' -> YYAction (-250); - '|' -> YYAction (-250); - '[' -> YYAction (-250); +private yyaction389 t = YYAction (-278); +private yyaction390 t = case yychar t of { + '(' -> YYAction (-251); + ')' -> YYAction (-251); + ',' -> YYAction (-251); + '|' -> YYAction (-251); + '[' -> YYAction (-251); _ -> case yytoken t of { - EXTENDS -> YYAction 480; - DCOLON -> YYAction 481; - VARID -> YYAction (-250); - CONID -> YYAction (-250); - QUALIFIER -> YYAction (-250); - ARROW -> YYAction (-250); + EXTENDS -> YYAction 488; + DCOLON -> YYAction 489; + VARID -> YYAction (-251); + CONID -> YYAction (-251); + QUALIFIER -> YYAction (-251); + ARROW -> YYAction (-251); _ -> YYAction yyErr; }; }; -private yyaction386 t = case yychar t of { - ')' -> YYAction 508; +private yyaction391 t = case yychar t of { + ')' -> YYAction 516; _ -> YYAction yyErr; }; -private yyaction387 t = YYAction (-257); -private yyaction388 t = case yychar t of { - ')' -> YYAction 509; - ',' -> YYAction 510; - '|' -> YYAction 511; +private yyaction392 t = YYAction (-258); +private yyaction393 t = case yychar t of { + ')' -> YYAction 517; + ',' -> YYAction 518; + '|' -> YYAction 519; _ -> YYAction yyErr; }; -private yyaction389 t = case yychar t of { - ')' -> YYAction 512; +private yyaction394 t = case yychar t of { + ')' -> YYAction 520; _ -> YYAction yyErr; }; -private yyaction390 t = YYAction (-256); -private yyaction391 t = case yychar t of { - ']' -> YYAction 513; +private yyaction395 t = YYAction (-257); +private yyaction396 t = case yychar t of { + ']' -> YYAction 521; _ -> YYAction yyErr; }; -private yyaction392 t = case yychar t of { - ')' -> YYAction 387; - ',' -> YYAction 159; +private yyaction397 t = case yychar t of { + ')' -> YYAction 392; + ',' -> YYAction 162; _ -> case yytoken t of { - ARROW -> YYAction 386; + ARROW -> YYAction 391; _ -> YYAction yyErr; }; }; -private yyaction393 t = case yychar t of { - ']' -> YYAction 390; +private yyaction398 t = case yychar t of { + ']' -> YYAction 395; _ -> YYAction yyErr; }; -private yyaction394 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction399 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction395 t = YYAction (-336); -private yyaction396 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction400 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - VARID -> YYAction 225; - CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; }; -private yyaction397 t = YYAction (-434); -private yyaction398 t = YYAction (-433); -private yyaction399 t = YYAction (-432); -private yyaction400 t = YYAction (-389); private yyaction401 t = case yychar t of { - ';' -> YYAction 517; + '=' -> YYAction 523; + _ -> YYAction yyErr; +}; +private yyaction402 t = YYAction (-340); +private yyaction403 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - ELSE -> YYAction 516; + VARID -> YYAction 229; + CONID -> YYAction 24; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction402 t = YYAction (-387); -private yyaction403 t = case yychar t of { +private yyaction404 t = YYAction (-438); +private yyaction405 t = YYAction (-437); +private yyaction406 t = YYAction (-436); +private yyaction407 t = YYAction (-393); +private yyaction408 t = case yychar t of { + ';' -> YYAction 526; + _ -> case yytoken t of { + ELSE -> YYAction 525; + _ -> YYAction yyErr; + }; +}; +private yyaction409 t = YYAction (-391); +private yyaction410 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -3640,7 +3678,7 @@ private yyaction403 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction404 t = case yychar t of { +private yyaction411 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -3648,7 +3686,7 @@ private yyaction404 t = case yychar t of { '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - '}' -> YYAction (-137); + '}' -> YYAction (-138); _ -> case yytoken t of { VARID -> YYAction 23; CONID -> YYAction 24; @@ -3671,11 +3709,11 @@ private yyaction404 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction405 t = case yytoken t of { - IN -> YYAction 524; +private yyaction412 t = case yytoken t of { + IN -> YYAction 533; _ -> YYAction yyErr; }; -private yyaction406 t = case yychar t of { +private yyaction413 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -3705,16 +3743,16 @@ private yyaction406 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction407 t = case yychar t of { +private yyaction414 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -3735,16 +3773,16 @@ private yyaction407 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction408 t = case yychar t of { +private yyaction415 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -3765,24 +3803,24 @@ private yyaction408 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction409 t = case yychar t of { +private yyaction416 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - '}' -> YYAction (-368); + '}' -> YYAction (-372); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; - LET -> YYAction 262; + LET -> YYAction 267; DO -> YYAction 44; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -3796,63 +3834,63 @@ private yyaction409 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction410 t = YYAction (-411); -private yyaction411 t = YYAction (-435); -private yyaction412 t = case yychar t of { - ';' -> YYAction 529; - ')' -> YYAction (-462); +private yyaction417 t = YYAction (-415); +private yyaction418 t = YYAction (-439); +private yyaction419 t = case yychar t of { + ';' -> YYAction 538; + ')' -> YYAction (-466); _ -> YYAction yyErr; }; -private yyaction413 t = case yychar t of { - ')' -> YYAction 530; +private yyaction420 t = case yychar t of { + ')' -> YYAction 539; _ -> YYAction yyErr; }; -private yyaction414 t = case yychar t of { - ',' -> YYAction 279; - ')' -> YYAction (-459); - ']' -> YYAction (-459); +private yyaction421 t = case yychar t of { + ',' -> YYAction 284; + ')' -> YYAction (-463); + ']' -> YYAction (-463); _ -> case yytoken t of { - DOTDOT -> YYAction (-459); + DOTDOT -> YYAction (-463); _ -> YYAction yyErr; }; }; -private yyaction415 t = case yychar t of { - ')' -> YYAction 531; +private yyaction422 t = case yychar t of { + ')' -> YYAction 540; _ -> YYAction yyErr; }; -private yyaction416 t = YYAction (-437); -private yyaction417 t = YYAction (-436); -private yyaction418 t = YYAction (-460); -private yyaction419 t = case yychar t of { - ',' -> YYAction 532; - ']' -> YYAction (-364); +private yyaction423 t = YYAction (-441); +private yyaction424 t = YYAction (-440); +private yyaction425 t = YYAction (-464); +private yyaction426 t = case yychar t of { + ',' -> YYAction 541; + ']' -> YYAction (-368); _ -> YYAction yyErr; }; -private yyaction420 t = case yychar t of { - ']' -> YYAction 533; +private yyaction427 t = case yychar t of { + ']' -> YYAction 542; _ -> YYAction yyErr; }; -private yyaction421 t = YYAction (-443); -private yyaction422 t = case yychar t of { - ']' -> YYAction 534; +private yyaction428 t = YYAction (-447); +private yyaction429 t = case yychar t of { + ']' -> YYAction 543; _ -> YYAction yyErr; }; -private yyaction423 t = YYAction (-386); -private yyaction424 t = YYAction (-341); -private yyaction425 t = case yychar t of { - '}' -> YYAction 535; +private yyaction430 t = YYAction (-390); +private yyaction431 t = YYAction (-345); +private yyaction432 t = case yychar t of { + '}' -> YYAction 544; _ -> YYAction yyBrace; }; -private yyaction426 t = case yychar t of { +private yyaction433 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -3873,43 +3911,43 @@ private yyaction426 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction427 t = YYAction (-429); -private yyaction428 t = case yychar t of { - '}' -> YYAction (-450); +private yyaction434 t = YYAction (-433); +private yyaction435 t = case yychar t of { + '}' -> YYAction (-454); _ -> case yytoken t of { - VARID -> YYAction 119; + VARID -> YYAction 121; _ -> YYAction yyBrace; }; }; -private yyaction429 t = case yychar t of { - '.' -> YYAction 539; +private yyaction436 t = case yychar t of { + '.' -> YYAction 548; _ -> case yytoken t of { - SOMEOP -> YYAction 538; + SOMEOP -> YYAction 547; _ -> YYAction yyErr; }; }; -private yyaction430 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction437 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction431 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction438 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction432 t = YYAction (-320); -private yyaction433 t = case yychar t of { +private yyaction439 t = YYAction (-324); +private yyaction440 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -3921,7 +3959,7 @@ private yyaction433 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; @@ -3941,7 +3979,7 @@ private yyaction433 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction434 t = case yychar t of { +private yyaction441 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -3953,7 +3991,7 @@ private yyaction434 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; @@ -3973,7 +4011,7 @@ private yyaction434 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction435 t = case yychar t of { +private yyaction442 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -3985,7 +4023,7 @@ private yyaction435 t = case yychar t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; @@ -4005,8 +4043,8 @@ private yyaction435 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction436 t = YYAction (-339); -private yyaction437 t = case yychar t of { +private yyaction443 t = YYAction (-343); +private yyaction444 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -4014,23 +4052,23 @@ private yyaction437 t = case yychar t of { '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - ';' -> YYAction (-131); - '}' -> YYAction (-131); + ';' -> YYAction (-132); + '}' -> YYAction (-132); _ -> case yytoken t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; DOCUMENTATION -> YYAction 26; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; LET -> YYAction 43; DO -> YYAction 44; - PRIVATE -> YYAction 433; - PROTECTED -> YYAction 434; - PUBLIC -> YYAction 435; + PRIVATE -> YYAction 440; + PROTECTED -> YYAction 441; + PUBLIC -> YYAction 442; PURE -> YYAction 48; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -4044,28 +4082,28 @@ private yyaction437 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction438 t = YYAction (-127); -private yyaction439 t = case yychar t of { - '}' -> YYAction 548; +private yyaction445 t = YYAction (-128); +private yyaction446 t = case yychar t of { + '}' -> YYAction 557; _ -> YYAction yyBrace; }; -private yyaction440 t = case yychar t of { - ';' -> YYAction 549; - '}' -> YYAction (-121); +private yyaction447 t = case yychar t of { + ';' -> YYAction 558; + '}' -> YYAction (-122); _ -> YYAction yyBrace; }; -private yyaction441 t = YYAction (-133); -private yyaction442 t = case yychar t of { +private yyaction448 t = YYAction (-134); +private yyaction449 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - '=' -> YYAction (-374); + '=' -> YYAction (-378); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4083,22 +4121,22 @@ private yyaction442 t = case yychar t of { CHRCONST -> YYAction 55; REGEXP -> YYAction 56; BIGCONST -> YYAction 57; - ARROW -> YYAction (-374); + ARROW -> YYAction (-378); _ -> YYAction yyErr; }; }; -private yyaction443 t = YYAction (-359); -private yyaction444 t = YYAction (-360); -private yyaction445 t = case yychar t of { +private yyaction450 t = YYAction (-363); +private yyaction451 t = YYAction (-364); +private yyaction452 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4119,35 +4157,35 @@ private yyaction445 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction446 t = case yychar t of { - '?' -> YYAction 553; - '=' -> YYAction 554; - '}' -> YYAction (-456); - ',' -> YYAction (-456); +private yyaction453 t = case yychar t of { + '?' -> YYAction 562; + '=' -> YYAction 563; + '}' -> YYAction (-460); + ',' -> YYAction (-460); _ -> case yytoken t of { - GETS -> YYAction 552; + GETS -> YYAction 561; _ -> YYAction yyBrace; }; }; -private yyaction447 t = case yychar t of { - '}' -> YYAction 555; +private yyaction454 t = case yychar t of { + '}' -> YYAction 564; _ -> YYAction yyBrace; }; -private yyaction448 t = case yychar t of { - ']' -> YYAction 556; +private yyaction455 t = case yychar t of { + ']' -> YYAction 565; _ -> YYAction yyErr; }; -private yyaction449 t = case yychar t of { +private yyaction456 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 557; - '(' -> YYAction 144; + '}' -> YYAction 566; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4168,21 +4206,21 @@ private yyaction449 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction450 t = case yychar t of { - '}' -> YYAction 559; +private yyaction457 t = case yychar t of { + '}' -> YYAction 568; _ -> YYAction yyBrace; }; -private yyaction451 t = case yychar t of { +private yyaction458 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 560; - '(' -> YYAction 144; + '}' -> YYAction 569; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4203,158 +4241,165 @@ private yyaction451 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction452 t = YYAction (-418); -private yyaction453 t = case yychar t of { - '}' -> YYAction (-453); +private yyaction459 t = YYAction (-422); +private yyaction460 t = case yychar t of { + '}' -> YYAction (-457); _ -> case yytoken t of { - VARID -> YYAction 562; + VARID -> YYAction 571; _ -> YYAction yyBrace; }; }; -private yyaction454 t = YYAction (-2); -private yyaction455 t = case yychar t of { +private yyaction461 t = YYAction (-2); +private yyaction462 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; + VARID -> YYAction 112; _ -> YYAction yyErr; }; }; -private yyaction456 t = YYAction (-187); -private yyaction457 t = YYAction (-22); -private yyaction458 t = case yychar t of { +private yyaction463 t = YYAction (-188); +private yyaction464 t = YYAction (-22); +private yyaction465 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; - QUALIFIER -> YYAction 320; - SOMEOP -> YYAction 121; + VARID -> YYAction 112; + QUALIFIER -> YYAction 325; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction459 t = YYAction (-140); -private yyaction460 t = case yychar t of { - ')' -> YYAction 567; +private yyaction466 t = YYAction (-141); +private yyaction467 t = case yychar t of { + ')' -> YYAction 576; _ -> case yytoken t of { - VARID -> YYAction 465; - CONID -> YYAction 466; - PUBLIC -> YYAction 566; - SOMEOP -> YYAction 121; + VARID -> YYAction 472; + CONID -> YYAction 473; + PUBLIC -> YYAction 575; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction461 t = case yychar t of { +private yyaction468 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; _ -> case yytoken t of { - VARID -> YYAction 110; - CONID -> YYAction 199; + VARID -> YYAction 112; + CONID -> YYAction 203; _ -> YYAction yyErr; }; }; -private yyaction462 t = YYAction (-158); -private yyaction463 t = YYAction (-145); -private yyaction464 t = case yychar t of { +private yyaction469 t = YYAction (-159); +private yyaction470 t = YYAction (-146); +private yyaction471 t = case yychar t of { '?' -> YYAction 61; '!' -> YYAction 62; - ')' -> YYAction (-148); + ')' -> YYAction (-149); _ -> case yytoken t of { - VARID -> YYAction 143; - CONID -> YYAction 328; - QUALIFIER -> YYAction 329; - PUBLIC -> YYAction 330; - SOMEOP -> YYAction 121; + VARID -> YYAction 146; + CONID -> YYAction 333; + QUALIFIER -> YYAction 334; + PUBLIC -> YYAction 335; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction465 t = YYAction (-165); -private yyaction466 t = YYAction (-166); -private yyaction467 t = YYAction (-167); -private yyaction468 t = YYAction (-157); -private yyaction469 t = case yychar t of { - ')' -> YYAction 572; +private yyaction472 t = YYAction (-166); +private yyaction473 t = YYAction (-167); +private yyaction474 t = YYAction (-168); +private yyaction475 t = YYAction (-158); +private yyaction476 t = case yychar t of { + ')' -> YYAction 581; _ -> YYAction yyErr; }; -private yyaction470 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction477 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction471 t = YYAction (-44); -private yyaction472 t = case yychar t of { - '{' -> YYAction 574; +private yyaction478 t = case yychar t of { + ',' -> YYAction 583; + ';' -> YYAction (-240); + '}' -> YYAction (-240); + ')' -> YYAction (-240); + '|' -> YYAction (-240); + _ -> case yytoken t of { + WHERE -> YYAction (-240); + _ -> YYAction yyBrace; + }; +}; +private yyaction479 t = YYAction (-44); +private yyaction480 t = case yychar t of { + '{' -> YYAction 584; _ -> YYAction yyErr; }; -private yyaction473 t = YYAction (-40); -private yyaction474 t = YYAction (-8); -private yyaction475 t = YYAction (-9); -private yyaction476 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction481 t = YYAction (-40); +private yyaction482 t = YYAction (-8); +private yyaction483 t = YYAction (-9); +private yyaction484 t = case yychar t of { + '(' -> YYAction 230; _ -> case yytoken t of { - VARID -> YYAction 225; - CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + VARID -> YYAction 229; _ -> YYAction yyErr; }; }; -private yyaction477 t = YYAction (-287); -private yyaction478 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction485 t = YYAction (-291); +private yyaction486 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction479 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction487 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction480 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction488 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction481 t = case yychar t of { - '(' -> YYAction 580; +private yyaction489 t = case yychar t of { + '(' -> YYAction 590; _ -> case yytoken t of { - SOMEOP -> YYAction 579; + SOMEOP -> YYAction 589; _ -> YYAction yyErr; }; }; -private yyaction482 t = case yychar t of { - ')' -> YYAction 583; +private yyaction490 t = case yychar t of { + ')' -> YYAction 593; _ -> YYAction yyErr; }; -private yyaction483 t = case yychar t of { - ')' -> YYAction 584; +private yyaction491 t = case yychar t of { + ')' -> YYAction 594; _ -> YYAction yyErr; }; -private yyaction484 t = case yychar t of { +private yyaction492 t = case yychar t of { '?' -> YYAction (-18); '!' -> YYAction (-18); _ -> case yytoken t of { @@ -4365,139 +4410,151 @@ private yyaction484 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction485 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction493 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction486 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction494 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; + QUALIFIER -> YYAction 133; _ -> YYAction yyErr; }; }; -private yyaction487 t = YYAction (-318); -private yyaction488 t = YYAction (-312); -private yyaction489 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; - '?' -> YYAction 485; - '!' -> YYAction 486; - ';' -> YYAction (-313); - '}' -> YYAction (-313); - '|' -> YYAction (-313); - _ -> case yytoken t of { - VARID -> YYAction 225; +private yyaction495 t = YYAction (-322); +private yyaction496 t = YYAction (-316); +private yyaction497 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + '?' -> YYAction 493; + '!' -> YYAction 494; + ';' -> YYAction (-317); + '}' -> YYAction (-317); + '|' -> YYAction (-317); + _ -> case yytoken t of { + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - DOCUMENTATION -> YYAction (-313); - WHERE -> YYAction (-313); + QUALIFIER -> YYAction 133; + DOCUMENTATION -> YYAction (-317); + WHERE -> YYAction (-317); _ -> YYAction yyBrace; }; }; -private yyaction490 t = YYAction (-315); -private yyaction491 t = YYAction (-302); -private yyaction492 t = YYAction (-305); -private yyaction493 t = YYAction (-306); -private yyaction494 t = YYAction (-304); -private yyaction495 t = YYAction (-308); -private yyaction496 t = YYAction (-307); -private yyaction497 t = YYAction (-301); -private yyaction498 t = YYAction (-294); -private yyaction499 t = YYAction (-283); -private yyaction500 t = case yychar t of { - '{' -> YYAction 217; - ';' -> YYAction (-285); - '}' -> YYAction (-285); - _ -> case yytoken t of { - WHERE -> YYAction (-285); +private yyaction498 t = YYAction (-319); +private yyaction499 t = YYAction (-306); +private yyaction500 t = YYAction (-309); +private yyaction501 t = YYAction (-310); +private yyaction502 t = YYAction (-308); +private yyaction503 t = YYAction (-312); +private yyaction504 t = YYAction (-311); +private yyaction505 t = YYAction (-305); +private yyaction506 t = YYAction (-296); +private yyaction507 t = YYAction (-285); +private yyaction508 t = case yychar t of { + '{' -> YYAction 221; + ';' -> YYAction (-287); + '}' -> YYAction (-287); + _ -> case yytoken t of { + WHERE -> YYAction (-287); _ -> YYAction yyBrace; }; }; -private yyaction501 t = YYAction (-289); -private yyaction502 t = case yychar t of { - '?' -> YYAction 366; - '!' -> YYAction 367; +private yyaction509 t = YYAction (-298); +private yyaction510 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; _ -> case yytoken t of { - CONID -> YYAction 361; - DOCUMENTATION -> YYAction 362; - PRIVATE -> YYAction 363; - PROTECTED -> YYAction 364; - PUBLIC -> YYAction 365; + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; }; -private yyaction503 t = case yytoken t of { - VARID -> YYAction 212; - CONID -> YYAction 213; - QUALIFIER -> YYAction 214; - PACKAGE -> YYAction 215; - STRCONST -> YYAction 216; +private yyaction511 t = case yytoken t of { + VARID -> YYAction 216; + CONID -> YYAction 217; + QUALIFIER -> YYAction 218; + PACKAGE -> YYAction 219; + STRCONST -> YYAction 220; _ -> YYAction yyErr; }; -private yyaction504 t = YYAction (-291); -private yyaction505 t = YYAction (-267); -private yyaction506 t = case yychar t of { - ';' -> YYAction (-338); - '}' -> YYAction (-338); +private yyaction512 t = YYAction (-293); +private yyaction513 t = YYAction (-268); +private yyaction514 t = case yychar t of { + ';' -> YYAction (-342); + '}' -> YYAction (-342); _ -> case yytoken t of { - WHERE -> YYAction 183; + WHERE -> YYAction 186; _ -> YYAction yyBrace; }; }; -private yyaction507 t = YYAction (-275); -private yyaction508 t = YYAction (-259); -private yyaction509 t = YYAction (-246); -private yyaction510 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction515 t = YYAction (-276); +private yyaction516 t = YYAction (-260); +private yyaction517 t = YYAction (-247); +private yyaction518 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction511 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction519 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction512 t = YYAction (-258); -private yyaction513 t = YYAction (-249); -private yyaction514 t = YYAction (-278); -private yyaction515 t = YYAction (-337); -private yyaction516 t = YYAction (-392); -private yyaction517 t = case yytoken t of { - ELSE -> YYAction 598; +private yyaction520 t = YYAction (-259); +private yyaction521 t = YYAction (-250); +private yyaction522 t = YYAction (-279); +private yyaction523 t = case yychar t of { + '?' -> YYAction 371; + '!' -> YYAction 372; + _ -> case yytoken t of { + CONID -> YYAction 366; + DOCUMENTATION -> YYAction 367; + PRIVATE -> YYAction 368; + PROTECTED -> YYAction 369; + PUBLIC -> YYAction 370; _ -> YYAction yyErr; }; -private yyaction518 t = case yychar t of { +}; +private yyaction524 t = YYAction (-341); +private yyaction525 t = YYAction (-396); +private yyaction526 t = case yytoken t of { + ELSE -> YYAction 608; + _ -> YYAction yyErr; + }; +private yyaction527 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4518,38 +4575,38 @@ private yyaction518 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction519 t = YYAction (-358); -private yyaction520 t = case yychar t of { - '|' -> YYAction 185; - '=' -> YYAction 444; +private yyaction528 t = YYAction (-362); +private yyaction529 t = case yychar t of { + '|' -> YYAction 189; + '=' -> YYAction 451; _ -> case yytoken t of { - ARROW -> YYAction 443; + ARROW -> YYAction 450; _ -> YYAction yyErr; }; }; -private yyaction521 t = case yychar t of { - ';' -> YYAction 602; - '}' -> YYAction (-381); +private yyaction530 t = case yychar t of { + ';' -> YYAction 612; + '}' -> YYAction (-385); _ -> case yytoken t of { - WHERE -> YYAction 172; + WHERE -> YYAction 175; _ -> YYAction yyBrace; }; }; -private yyaction522 t = case yychar t of { - '}' -> YYAction 604; +private yyaction531 t = case yychar t of { + '}' -> YYAction 614; _ -> YYAction yyBrace; }; -private yyaction523 t = YYAction (-138); -private yyaction524 t = case yychar t of { +private yyaction532 t = YYAction (-139); +private yyaction533 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4570,24 +4627,24 @@ private yyaction524 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction525 t = case yychar t of { - '}' -> YYAction 606; +private yyaction534 t = case yychar t of { + '}' -> YYAction 616; _ -> YYAction yyBrace; }; -private yyaction526 t = YYAction (-371); -private yyaction527 t = YYAction (-362); -private yyaction528 t = YYAction (-369); -private yyaction529 t = case yychar t of { +private yyaction535 t = YYAction (-375); +private yyaction536 t = YYAction (-366); +private yyaction537 t = YYAction (-373); +private yyaction538 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - ')' -> YYAction (-464); + ')' -> YYAction (-468); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4608,26 +4665,26 @@ private yyaction529 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction530 t = YYAction (-439); -private yyaction531 t = YYAction (-438); -private yyaction532 t = case yychar t of { +private yyaction539 t = YYAction (-443); +private yyaction540 t = YYAction (-442); +private yyaction541 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - ']' -> YYAction (-366); + ']' -> YYAction (-370); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; - LET -> YYAction 262; + LET -> YYAction 267; DO -> YYAction 44; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -4641,56 +4698,56 @@ private yyaction532 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction533 t = YYAction (-445); -private yyaction534 t = YYAction (-444); -private yyaction535 t = YYAction (-342); -private yyaction536 t = YYAction (-457); -private yyaction537 t = YYAction (-449); -private yyaction538 t = YYAction (-231); -private yyaction539 t = YYAction (-230); -private yyaction540 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction542 t = YYAction (-449); +private yyaction543 t = YYAction (-448); +private yyaction544 t = YYAction (-346); +private yyaction545 t = YYAction (-461); +private yyaction546 t = YYAction (-453); +private yyaction547 t = YYAction (-232); +private yyaction548 t = YYAction (-231); +private yyaction549 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - _ -> YYAction yyErr; - }; -}; -private yyaction541 t = case yychar t of { - '-' -> YYAction (-234); - ';' -> YYAction (-234); - '}' -> YYAction (-234); - ')' -> YYAction (-234); - ',' -> YYAction (-234); - '|' -> YYAction (-234); - ']' -> YYAction (-234); - '=' -> YYAction (-234); - _ -> case yytoken t of { - ARROW -> YYAction 430; - DOCUMENTATION -> YYAction (-234); - WHERE -> YYAction (-234); - CLASS -> YYAction (-234); - THEN -> YYAction (-234); - ELSE -> YYAction (-234); - OF -> YYAction (-234); - THROWS -> YYAction (-234); - DCOLON -> YYAction (-234); - GETS -> YYAction (-234); - DOTDOT -> YYAction (-234); - SOMEOP -> YYAction (-234); + QUALIFIER -> YYAction 133; + _ -> YYAction yyErr; + }; +}; +private yyaction550 t = case yychar t of { + '-' -> YYAction (-235); + ';' -> YYAction (-235); + '}' -> YYAction (-235); + ')' -> YYAction (-235); + ',' -> YYAction (-235); + '|' -> YYAction (-235); + ']' -> YYAction (-235); + '=' -> YYAction (-235); + _ -> case yytoken t of { + ARROW -> YYAction 437; + DOCUMENTATION -> YYAction (-235); + WHERE -> YYAction (-235); + CLASS -> YYAction (-235); + THEN -> YYAction (-235); + ELSE -> YYAction (-235); + OF -> YYAction (-235); + THROWS -> YYAction (-235); + DCOLON -> YYAction (-235); + GETS -> YYAction (-235); + DOTDOT -> YYAction (-235); + SOMEOP -> YYAction (-235); _ -> YYAction yyBrace; }; }; -private yyaction542 t = YYAction (-235); -private yyaction543 t = YYAction (-232); -private yyaction544 t = YYAction (-128); -private yyaction545 t = YYAction (-129); -private yyaction546 t = YYAction (-130); -private yyaction547 t = YYAction (-132); -private yyaction548 t = YYAction (-340); -private yyaction549 t = case yychar t of { +private yyaction551 t = YYAction (-236); +private yyaction552 t = YYAction (-233); +private yyaction553 t = YYAction (-129); +private yyaction554 t = YYAction (-130); +private yyaction555 t = YYAction (-131); +private yyaction556 t = YYAction (-133); +private yyaction557 t = YYAction (-344); +private yyaction558 t = case yychar t of { '-' -> YYAction 58; '(' -> YYAction 59; '[' -> YYAction 60; @@ -4698,22 +4755,22 @@ private yyaction549 t = case yychar t of { '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - '}' -> YYAction (-122); + '}' -> YYAction (-123); _ -> case yytoken t of { VARID -> YYAction 23; CONID -> YYAction 24; QUALIFIER -> YYAction 25; DOCUMENTATION -> YYAction 26; - NATIVE -> YYAction 151; + NATIVE -> YYAction 154; TRUE -> YYAction 38; FALSE -> YYAction 39; IF -> YYAction 40; CASE -> YYAction 41; LET -> YYAction 43; DO -> YYAction 44; - PRIVATE -> YYAction 433; - PROTECTED -> YYAction 434; - PUBLIC -> YYAction 435; + PRIVATE -> YYAction 440; + PROTECTED -> YYAction 441; + PUBLIC -> YYAction 442; PURE -> YYAction 48; INTCONST -> YYAction 49; STRCONST -> YYAction 50; @@ -4727,19 +4784,19 @@ private yyaction549 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction550 t = YYAction (-373); -private yyaction551 t = YYAction (-375); -private yyaction552 t = case yychar t of { +private yyaction559 t = YYAction (-377); +private yyaction560 t = YYAction (-379); +private yyaction561 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 611; - '(' -> YYAction 144; + '}' -> YYAction 621; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4760,21 +4817,21 @@ private yyaction552 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction553 t = case yychar t of { - '}' -> YYAction 612; +private yyaction562 t = case yychar t of { + '}' -> YYAction 622; _ -> YYAction yyBrace; }; -private yyaction554 t = case yychar t of { +private yyaction563 t = case yychar t of { '-' -> YYAction 58; - '}' -> YYAction 613; - '(' -> YYAction 144; + '}' -> YYAction 623; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -4795,206 +4852,217 @@ private yyaction554 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction555 t = YYAction (-422); -private yyaction556 t = YYAction (-423); -private yyaction557 t = YYAction (-417); -private yyaction558 t = YYAction (-454); -private yyaction559 t = YYAction (-415); -private yyaction560 t = YYAction (-416); -private yyaction561 t = YYAction (-455); -private yyaction562 t = case yychar t of { - '=' -> YYAction 615; - '}' -> YYAction (-456); - ',' -> YYAction (-456); +private yyaction564 t = YYAction (-426); +private yyaction565 t = YYAction (-427); +private yyaction566 t = YYAction (-421); +private yyaction567 t = YYAction (-458); +private yyaction568 t = YYAction (-419); +private yyaction569 t = YYAction (-420); +private yyaction570 t = YYAction (-459); +private yyaction571 t = case yychar t of { + '=' -> YYAction 625; + '}' -> YYAction (-460); + ',' -> YYAction (-460); _ -> case yytoken t of { - GETS -> YYAction 614; + GETS -> YYAction 624; _ -> YYAction yyBrace; }; }; -private yyaction563 t = YYAction (-452); -private yyaction564 t = YYAction (-186); -private yyaction565 t = YYAction (-177); -private yyaction566 t = case yytoken t of { - VARID -> YYAction 465; - CONID -> YYAction 466; - PUBLIC -> YYAction 566; - SOMEOP -> YYAction 121; +private yyaction572 t = YYAction (-456); +private yyaction573 t = YYAction (-187); +private yyaction574 t = YYAction (-178); +private yyaction575 t = case yytoken t of { + VARID -> YYAction 472; + CONID -> YYAction 473; + PUBLIC -> YYAction 575; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; -private yyaction567 t = YYAction (-152); -private yyaction568 t = case yychar t of { - ')' -> YYAction 617; +private yyaction576 t = YYAction (-153); +private yyaction577 t = case yychar t of { + ')' -> YYAction 627; _ -> YYAction yyErr; }; -private yyaction569 t = case yychar t of { - ')' -> YYAction (-159); - ',' -> YYAction (-159); +private yyaction578 t = case yychar t of { + ')' -> YYAction (-160); + ',' -> YYAction (-160); _ -> case yytoken t of { - VARID -> YYAction 465; - CONID -> YYAction 466; - SOMEOP -> YYAction 121; + VARID -> YYAction 472; + CONID -> YYAction 473; + SOMEOP -> YYAction 123; _ -> YYAction yyErr; }; }; -private yyaction570 t = case yychar t of { - ',' -> YYAction 619; - ')' -> YYAction (-162); +private yyaction579 t = case yychar t of { + ',' -> YYAction 629; + ')' -> YYAction (-163); _ -> YYAction yyErr; }; -private yyaction571 t = YYAction (-149); -private yyaction572 t = YYAction (-143); -private yyaction573 t = YYAction (-238); -private yyaction574 t = case yychar t of { - '-' -> YYAction 668; - ';' -> YYAction 669; - '{' -> YYAction 670; - '}' -> YYAction 671; - '.' -> YYAction 672; - '(' -> YYAction 673; - ')' -> YYAction 674; - ',' -> YYAction 675; - '|' -> YYAction 676; - '[' -> YYAction 677; - ']' -> YYAction 678; - '?' -> YYAction 679; - '!' -> YYAction 680; - '=' -> YYAction 681; - '\\' -> YYAction 682; - _ -> case yytoken t of { - VARID -> YYAction 620; - CONID -> YYAction 621; - QUALIFIER -> YYAction 622; - DOCUMENTATION -> YYAction 623; - EXTENDS -> YYAction 624; - SUPER -> YYAction 625; - PACKAGE -> YYAction 626; - IMPORT -> YYAction 627; - INFIX -> YYAction 628; - INFIXR -> YYAction 629; - INFIXL -> YYAction 630; - NATIVE -> YYAction 631; - DATA -> YYAction 632; - WHERE -> YYAction 633; - CLASS -> YYAction 634; - INSTANCE -> YYAction 635; - ABSTRACT -> YYAction 636; - TYPE -> YYAction 637; - TRUE -> YYAction 638; - FALSE -> YYAction 639; - IF -> YYAction 640; - THEN -> YYAction 641; - ELSE -> YYAction 642; - CASE -> YYAction 643; - OF -> YYAction 644; - DERIVE -> YYAction 645; - LET -> YYAction 646; - IN -> YYAction 647; - DO -> YYAction 648; - FORALL -> YYAction 649; - PRIVATE -> YYAction 650; - PROTECTED -> YYAction 651; - PUBLIC -> YYAction 652; - PURE -> YYAction 653; - THROWS -> YYAction 654; - MUTABLE -> YYAction 655; - INTCONST -> YYAction 656; - STRCONST -> YYAction 657; - LONGCONST -> YYAction 658; - FLTCONST -> YYAction 659; - DBLCONST -> YYAction 660; - CHRCONST -> YYAction 661; - ARROW -> YYAction 662; - DCOLON -> YYAction 663; - GETS -> YYAction 664; - EARROW -> YYAction 665; - DOTDOT -> YYAction 666; - SOMEOP -> YYAction 667; - _ -> YYAction yyBrace; +private yyaction580 t = YYAction (-150); +private yyaction581 t = YYAction (-144); +private yyaction582 t = YYAction (-239); +private yyaction583 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + _ -> case yytoken t of { + VARID -> YYAction 229; + CONID -> YYAction 24; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; + _ -> YYAction yyErr; }; }; -private yyaction575 t = YYAction (-240); -private yyaction576 t = YYAction (-222); -private yyaction577 t = YYAction (-225); -private yyaction578 t = case yychar t of { +private yyaction584 t = case yychar t of { + '-' -> YYAction 679; + ';' -> YYAction 680; + '{' -> YYAction 681; + '}' -> YYAction 682; + '.' -> YYAction 683; + '(' -> YYAction 684; ')' -> YYAction 685; + ',' -> YYAction 686; + '|' -> YYAction 687; + '[' -> YYAction 688; + ']' -> YYAction 689; + '?' -> YYAction 690; + '!' -> YYAction 691; + '=' -> YYAction 692; + '\\' -> YYAction 693; + _ -> case yytoken t of { + VARID -> YYAction 631; + CONID -> YYAction 632; + QUALIFIER -> YYAction 633; + DOCUMENTATION -> YYAction 634; + EXTENDS -> YYAction 635; + SUPER -> YYAction 636; + PACKAGE -> YYAction 637; + IMPORT -> YYAction 638; + INFIX -> YYAction 639; + INFIXR -> YYAction 640; + INFIXL -> YYAction 641; + NATIVE -> YYAction 642; + DATA -> YYAction 643; + WHERE -> YYAction 644; + CLASS -> YYAction 645; + INSTANCE -> YYAction 646; + ABSTRACT -> YYAction 647; + TYPE -> YYAction 648; + TRUE -> YYAction 649; + FALSE -> YYAction 650; + IF -> YYAction 651; + THEN -> YYAction 652; + ELSE -> YYAction 653; + CASE -> YYAction 654; + OF -> YYAction 655; + DERIVE -> YYAction 656; + LET -> YYAction 657; + IN -> YYAction 658; + DO -> YYAction 659; + FORALL -> YYAction 660; + PRIVATE -> YYAction 661; + PROTECTED -> YYAction 662; + PUBLIC -> YYAction 663; + PURE -> YYAction 664; + THROWS -> YYAction 665; + MUTABLE -> YYAction 666; + INTCONST -> YYAction 667; + STRCONST -> YYAction 668; + LONGCONST -> YYAction 669; + FLTCONST -> YYAction 670; + DBLCONST -> YYAction 671; + CHRCONST -> YYAction 672; + ARROW -> YYAction 673; + DCOLON -> YYAction 674; + GETS -> YYAction 675; + EARROW -> YYAction 676; + DOTDOT -> YYAction 677; + SOMEOP -> YYAction 678; + _ -> YYAction yyBrace; + }; +}; +private yyaction585 t = YYAction (-290); +private yyaction586 t = YYAction (-223); +private yyaction587 t = YYAction (-226); +private yyaction588 t = case yychar t of { + ')' -> YYAction 696; _ -> YYAction yyErr; }; -private yyaction579 t = YYAction (-262); -private yyaction580 t = case yychar t of { - '(' -> YYAction 580; +private yyaction589 t = YYAction (-263); +private yyaction590 t = case yychar t of { + '(' -> YYAction 590; _ -> case yytoken t of { - SOMEOP -> YYAction 579; + SOMEOP -> YYAction 589; _ -> YYAction yyErr; }; }; -private yyaction581 t = case yychar t of { - ')' -> YYAction 687; +private yyaction591 t = case yychar t of { + ')' -> YYAction 698; _ -> YYAction yyErr; }; -private yyaction582 t = case yychar t of { - ')' -> YYAction (-261); +private yyaction592 t = case yychar t of { + ')' -> YYAction (-262); _ -> case yytoken t of { - ARROW -> YYAction 688; + ARROW -> YYAction 699; _ -> YYAction yyErr; }; }; -private yyaction583 t = YYAction (-253); -private yyaction584 t = YYAction (-254); -private yyaction585 t = case yychar t of { - '?' -> YYAction 691; - '!' -> YYAction 692; +private yyaction593 t = YYAction (-254); +private yyaction594 t = YYAction (-255); +private yyaction595 t = case yychar t of { + '?' -> YYAction 702; + '!' -> YYAction 703; _ -> case yytoken t of { - VARID -> YYAction 119; - PRIVATE -> YYAction 689; - PUBLIC -> YYAction 690; + VARID -> YYAction 121; + PRIVATE -> YYAction 700; + PUBLIC -> YYAction 701; _ -> YYAction yyErr; }; }; -private yyaction586 t = case yychar t of { - '}' -> YYAction 698; +private yyaction596 t = case yychar t of { + '}' -> YYAction 709; _ -> YYAction yyBrace; }; -private yyaction587 t = case yychar t of { - ',' -> YYAction 700; - '}' -> YYAction (-321); +private yyaction597 t = case yychar t of { + ',' -> YYAction 711; + '}' -> YYAction (-325); _ -> case yytoken t of { - DOCUMENTATION -> YYAction 699; + DOCUMENTATION -> YYAction 710; _ -> YYAction yyBrace; }; }; -private yyaction588 t = YYAction (-317); -private yyaction589 t = YYAction (-316); -private yyaction590 t = YYAction (-314); -private yyaction591 t = YYAction (-286); -private yyaction592 t = YYAction (-299); -private yyaction593 t = YYAction (-290); -private yyaction594 t = YYAction (-270); -private yyaction595 t = case yychar t of { - ')' -> YYAction 701; +private yyaction598 t = YYAction (-321); +private yyaction599 t = YYAction (-320); +private yyaction600 t = YYAction (-318); +private yyaction601 t = YYAction (-288); +private yyaction602 t = YYAction (-303); +private yyaction603 t = YYAction (-299); +private yyaction604 t = YYAction (-271); +private yyaction605 t = case yychar t of { + ')' -> YYAction 712; _ -> YYAction yyErr; }; -private yyaction596 t = case yychar t of { - '|' -> YYAction 702; - ')' -> YYAction (-241); +private yyaction606 t = case yychar t of { + '|' -> YYAction 713; + ')' -> YYAction (-242); _ -> YYAction yyErr; }; -private yyaction597 t = case yychar t of { - ')' -> YYAction 703; +private yyaction607 t = case yychar t of { + ')' -> YYAction 714; _ -> YYAction yyErr; }; -private yyaction598 t = YYAction (-391); -private yyaction599 t = YYAction (-397); -private yyaction600 t = YYAction (-379); -private yyaction601 t = case yychar t of { +private yyaction608 t = YYAction (-395); +private yyaction609 t = YYAction (-401); +private yyaction610 t = YYAction (-383); +private yyaction611 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -5015,17 +5083,17 @@ private yyaction601 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction602 t = case yychar t of { +private yyaction612 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; - '}' -> YYAction (-383); + '}' -> YYAction (-387); _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -5046,36 +5114,36 @@ private yyaction602 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction603 t = YYAction (-380); -private yyaction604 t = YYAction (-398); -private yyaction605 t = YYAction (-399); -private yyaction606 t = case yychar t of { - ';' -> YYAction (-363); - '}' -> YYAction (-363); - ',' -> YYAction (-363); - ']' -> YYAction (-363); +private yyaction613 t = YYAction (-384); +private yyaction614 t = YYAction (-402); +private yyaction615 t = YYAction (-403); +private yyaction616 t = case yychar t of { + ';' -> YYAction (-367); + '}' -> YYAction (-367); + ',' -> YYAction (-367); + ']' -> YYAction (-367); _ -> case yytoken t of { - IN -> YYAction 524; + IN -> YYAction 533; _ -> YYAction yyBrace; }; }; -private yyaction607 t = YYAction (-463); -private yyaction608 t = YYAction (-365); -private yyaction609 t = YYAction (-229); -private yyaction610 t = YYAction (-123); -private yyaction611 t = YYAction (-421); -private yyaction612 t = YYAction (-419); -private yyaction613 t = YYAction (-420); -private yyaction614 t = case yychar t of { +private yyaction617 t = YYAction (-467); +private yyaction618 t = YYAction (-369); +private yyaction619 t = YYAction (-230); +private yyaction620 t = YYAction (-124); +private yyaction621 t = YYAction (-425); +private yyaction622 t = YYAction (-423); +private yyaction623 t = YYAction (-424); +private yyaction624 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -5096,16 +5164,16 @@ private yyaction614 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction615 t = case yychar t of { +private yyaction625 t = case yychar t of { '-' -> YYAction 58; - '(' -> YYAction 144; + '(' -> YYAction 147; '[' -> YYAction 60; '?' -> YYAction 61; '!' -> YYAction 62; '\\' -> YYAction 63; '_' -> YYAction 64; _ -> case yytoken t of { - VARID -> YYAction 143; + VARID -> YYAction 146; CONID -> YYAction 24; QUALIFIER -> YYAction 25; TRUE -> YYAction 38; @@ -5126,275 +5194,276 @@ private yyaction615 t = case yychar t of { _ -> YYAction yyErr; }; }; -private yyaction616 t = YYAction (-161); -private yyaction617 t = YYAction (-151); -private yyaction618 t = YYAction (-160); -private yyaction619 t = case yychar t of { - ')' -> YYAction (-163); - _ -> case yytoken t of { - VARID -> YYAction 465; - CONID -> YYAction 466; - PUBLIC -> YYAction 566; - SOMEOP -> YYAction 121; - _ -> YYAction yyErr; - }; -}; -private yyaction620 t = YYAction (-47); -private yyaction621 t = YYAction (-48); -private yyaction622 t = YYAction (-49); -private yyaction623 t = YYAction (-52); -private yyaction624 t = YYAction (-50); -private yyaction625 t = YYAction (-51); -private yyaction626 t = YYAction (-53); -private yyaction627 t = YYAction (-54); -private yyaction628 t = YYAction (-55); -private yyaction629 t = YYAction (-56); -private yyaction630 t = YYAction (-57); -private yyaction631 t = YYAction (-58); -private yyaction632 t = YYAction (-59); -private yyaction633 t = YYAction (-60); -private yyaction634 t = YYAction (-61); -private yyaction635 t = YYAction (-62); -private yyaction636 t = YYAction (-63); -private yyaction637 t = YYAction (-64); -private yyaction638 t = YYAction (-65); -private yyaction639 t = YYAction (-66); -private yyaction640 t = YYAction (-67); -private yyaction641 t = YYAction (-68); -private yyaction642 t = YYAction (-69); -private yyaction643 t = YYAction (-70); -private yyaction644 t = YYAction (-71); -private yyaction645 t = YYAction (-72); -private yyaction646 t = YYAction (-73); -private yyaction647 t = YYAction (-74); -private yyaction648 t = YYAction (-75); -private yyaction649 t = YYAction (-76); -private yyaction650 t = YYAction (-77); -private yyaction651 t = YYAction (-78); -private yyaction652 t = YYAction (-79); -private yyaction653 t = YYAction (-80); -private yyaction654 t = YYAction (-81); -private yyaction655 t = YYAction (-82); -private yyaction656 t = YYAction (-83); -private yyaction657 t = YYAction (-84); -private yyaction658 t = YYAction (-85); -private yyaction659 t = YYAction (-86); -private yyaction660 t = YYAction (-87); -private yyaction661 t = YYAction (-88); -private yyaction662 t = YYAction (-89); -private yyaction663 t = YYAction (-90); -private yyaction664 t = YYAction (-91); -private yyaction665 t = YYAction (-92); -private yyaction666 t = YYAction (-93); -private yyaction667 t = YYAction (-94); -private yyaction668 t = YYAction (-103); -private yyaction669 t = YYAction (-104); -private yyaction670 t = case yychar t of { - '-' -> YYAction 668; - ';' -> YYAction 669; - '{' -> YYAction 670; - '}' -> YYAction 707; - '.' -> YYAction 672; - '(' -> YYAction 673; - ')' -> YYAction 674; - ',' -> YYAction 675; - '|' -> YYAction 676; - '[' -> YYAction 677; - ']' -> YYAction 678; - '?' -> YYAction 679; - '!' -> YYAction 680; - '=' -> YYAction 681; - '\\' -> YYAction 682; - _ -> case yytoken t of { - VARID -> YYAction 620; - CONID -> YYAction 621; - QUALIFIER -> YYAction 622; - DOCUMENTATION -> YYAction 623; - EXTENDS -> YYAction 624; - SUPER -> YYAction 625; - PACKAGE -> YYAction 626; - IMPORT -> YYAction 627; - INFIX -> YYAction 628; - INFIXR -> YYAction 629; - INFIXL -> YYAction 630; - NATIVE -> YYAction 631; - DATA -> YYAction 632; - WHERE -> YYAction 633; - CLASS -> YYAction 634; - INSTANCE -> YYAction 635; - ABSTRACT -> YYAction 636; - TYPE -> YYAction 637; - TRUE -> YYAction 638; - FALSE -> YYAction 639; - IF -> YYAction 640; - THEN -> YYAction 641; - ELSE -> YYAction 642; - CASE -> YYAction 643; - OF -> YYAction 644; - DERIVE -> YYAction 645; - LET -> YYAction 646; - IN -> YYAction 647; - DO -> YYAction 648; - FORALL -> YYAction 649; - PRIVATE -> YYAction 650; - PROTECTED -> YYAction 651; - PUBLIC -> YYAction 652; - PURE -> YYAction 653; - THROWS -> YYAction 654; - MUTABLE -> YYAction 655; - INTCONST -> YYAction 656; - STRCONST -> YYAction 657; - LONGCONST -> YYAction 658; - FLTCONST -> YYAction 659; - DBLCONST -> YYAction 660; - CHRCONST -> YYAction 661; - ARROW -> YYAction 662; - DCOLON -> YYAction 663; - GETS -> YYAction 664; - EARROW -> YYAction 665; - DOTDOT -> YYAction 666; - SOMEOP -> YYAction 667; +private yyaction626 t = YYAction (-162); +private yyaction627 t = YYAction (-152); +private yyaction628 t = YYAction (-161); +private yyaction629 t = case yychar t of { + ')' -> YYAction (-164); + _ -> case yytoken t of { + VARID -> YYAction 472; + CONID -> YYAction 473; + PUBLIC -> YYAction 575; + SOMEOP -> YYAction 123; + _ -> YYAction yyErr; + }; +}; +private yyaction630 t = YYAction (-241); +private yyaction631 t = YYAction (-47); +private yyaction632 t = YYAction (-48); +private yyaction633 t = YYAction (-49); +private yyaction634 t = YYAction (-52); +private yyaction635 t = YYAction (-50); +private yyaction636 t = YYAction (-51); +private yyaction637 t = YYAction (-53); +private yyaction638 t = YYAction (-54); +private yyaction639 t = YYAction (-55); +private yyaction640 t = YYAction (-56); +private yyaction641 t = YYAction (-57); +private yyaction642 t = YYAction (-58); +private yyaction643 t = YYAction (-59); +private yyaction644 t = YYAction (-60); +private yyaction645 t = YYAction (-61); +private yyaction646 t = YYAction (-62); +private yyaction647 t = YYAction (-63); +private yyaction648 t = YYAction (-64); +private yyaction649 t = YYAction (-65); +private yyaction650 t = YYAction (-66); +private yyaction651 t = YYAction (-67); +private yyaction652 t = YYAction (-68); +private yyaction653 t = YYAction (-69); +private yyaction654 t = YYAction (-70); +private yyaction655 t = YYAction (-71); +private yyaction656 t = YYAction (-72); +private yyaction657 t = YYAction (-73); +private yyaction658 t = YYAction (-74); +private yyaction659 t = YYAction (-75); +private yyaction660 t = YYAction (-76); +private yyaction661 t = YYAction (-77); +private yyaction662 t = YYAction (-78); +private yyaction663 t = YYAction (-79); +private yyaction664 t = YYAction (-80); +private yyaction665 t = YYAction (-81); +private yyaction666 t = YYAction (-82); +private yyaction667 t = YYAction (-83); +private yyaction668 t = YYAction (-84); +private yyaction669 t = YYAction (-85); +private yyaction670 t = YYAction (-86); +private yyaction671 t = YYAction (-87); +private yyaction672 t = YYAction (-88); +private yyaction673 t = YYAction (-89); +private yyaction674 t = YYAction (-90); +private yyaction675 t = YYAction (-91); +private yyaction676 t = YYAction (-92); +private yyaction677 t = YYAction (-93); +private yyaction678 t = YYAction (-94); +private yyaction679 t = YYAction (-103); +private yyaction680 t = YYAction (-104); +private yyaction681 t = case yychar t of { + '-' -> YYAction 679; + ';' -> YYAction 680; + '{' -> YYAction 681; + '}' -> YYAction 718; + '.' -> YYAction 683; + '(' -> YYAction 684; + ')' -> YYAction 685; + ',' -> YYAction 686; + '|' -> YYAction 687; + '[' -> YYAction 688; + ']' -> YYAction 689; + '?' -> YYAction 690; + '!' -> YYAction 691; + '=' -> YYAction 692; + '\\' -> YYAction 693; + _ -> case yytoken t of { + VARID -> YYAction 631; + CONID -> YYAction 632; + QUALIFIER -> YYAction 633; + DOCUMENTATION -> YYAction 634; + EXTENDS -> YYAction 635; + SUPER -> YYAction 636; + PACKAGE -> YYAction 637; + IMPORT -> YYAction 638; + INFIX -> YYAction 639; + INFIXR -> YYAction 640; + INFIXL -> YYAction 641; + NATIVE -> YYAction 642; + DATA -> YYAction 643; + WHERE -> YYAction 644; + CLASS -> YYAction 645; + INSTANCE -> YYAction 646; + ABSTRACT -> YYAction 647; + TYPE -> YYAction 648; + TRUE -> YYAction 649; + FALSE -> YYAction 650; + IF -> YYAction 651; + THEN -> YYAction 652; + ELSE -> YYAction 653; + CASE -> YYAction 654; + OF -> YYAction 655; + DERIVE -> YYAction 656; + LET -> YYAction 657; + IN -> YYAction 658; + DO -> YYAction 659; + FORALL -> YYAction 660; + PRIVATE -> YYAction 661; + PROTECTED -> YYAction 662; + PUBLIC -> YYAction 663; + PURE -> YYAction 664; + THROWS -> YYAction 665; + MUTABLE -> YYAction 666; + INTCONST -> YYAction 667; + STRCONST -> YYAction 668; + LONGCONST -> YYAction 669; + FLTCONST -> YYAction 670; + DBLCONST -> YYAction 671; + CHRCONST -> YYAction 672; + ARROW -> YYAction 673; + DCOLON -> YYAction 674; + GETS -> YYAction 675; + EARROW -> YYAction 676; + DOTDOT -> YYAction 677; + SOMEOP -> YYAction 678; _ -> YYAction yyBrace; }; }; -private yyaction671 t = YYAction (-46); -private yyaction672 t = YYAction (-101); -private yyaction673 t = YYAction (-99); -private yyaction674 t = YYAction (-100); -private yyaction675 t = YYAction (-95); -private yyaction676 t = YYAction (-96); -private yyaction677 t = YYAction (-97); -private yyaction678 t = YYAction (-98); -private yyaction679 t = YYAction (-102); -private yyaction680 t = YYAction (-105); -private yyaction681 t = YYAction (-106); -private yyaction682 t = YYAction (-107); -private yyaction683 t = case yychar t of { - '}' -> YYAction 709; +private yyaction682 t = YYAction (-46); +private yyaction683 t = YYAction (-101); +private yyaction684 t = YYAction (-99); +private yyaction685 t = YYAction (-100); +private yyaction686 t = YYAction (-95); +private yyaction687 t = YYAction (-96); +private yyaction688 t = YYAction (-97); +private yyaction689 t = YYAction (-98); +private yyaction690 t = YYAction (-102); +private yyaction691 t = YYAction (-105); +private yyaction692 t = YYAction (-106); +private yyaction693 t = YYAction (-107); +private yyaction694 t = case yychar t of { + '}' -> YYAction 720; _ -> YYAction yyBrace; }; -private yyaction684 t = case yychar t of { - '-' -> YYAction 668; - ';' -> YYAction 669; - '{' -> YYAction 670; - '.' -> YYAction 672; - '(' -> YYAction 673; - ')' -> YYAction 674; - ',' -> YYAction 675; - '|' -> YYAction 676; - '[' -> YYAction 677; - ']' -> YYAction 678; - '?' -> YYAction 679; - '!' -> YYAction 680; - '=' -> YYAction 681; - '\\' -> YYAction 682; +private yyaction695 t = case yychar t of { + '-' -> YYAction 679; + ';' -> YYAction 680; + '{' -> YYAction 681; + '.' -> YYAction 683; + '(' -> YYAction 684; + ')' -> YYAction 685; + ',' -> YYAction 686; + '|' -> YYAction 687; + '[' -> YYAction 688; + ']' -> YYAction 689; + '?' -> YYAction 690; + '!' -> YYAction 691; + '=' -> YYAction 692; + '\\' -> YYAction 693; '}' -> YYAction (-108); _ -> case yytoken t of { - VARID -> YYAction 620; - CONID -> YYAction 621; - QUALIFIER -> YYAction 622; - DOCUMENTATION -> YYAction 623; - EXTENDS -> YYAction 624; - SUPER -> YYAction 625; - PACKAGE -> YYAction 626; - IMPORT -> YYAction 627; - INFIX -> YYAction 628; - INFIXR -> YYAction 629; - INFIXL -> YYAction 630; - NATIVE -> YYAction 631; - DATA -> YYAction 632; - WHERE -> YYAction 633; - CLASS -> YYAction 634; - INSTANCE -> YYAction 635; - ABSTRACT -> YYAction 636; - TYPE -> YYAction 637; - TRUE -> YYAction 638; - FALSE -> YYAction 639; - IF -> YYAction 640; - THEN -> YYAction 641; - ELSE -> YYAction 642; - CASE -> YYAction 643; - OF -> YYAction 644; - DERIVE -> YYAction 645; - LET -> YYAction 646; - IN -> YYAction 647; - DO -> YYAction 648; - FORALL -> YYAction 649; - PRIVATE -> YYAction 650; - PROTECTED -> YYAction 651; - PUBLIC -> YYAction 652; - PURE -> YYAction 653; - THROWS -> YYAction 654; - MUTABLE -> YYAction 655; - INTCONST -> YYAction 656; - STRCONST -> YYAction 657; - LONGCONST -> YYAction 658; - FLTCONST -> YYAction 659; - DBLCONST -> YYAction 660; - CHRCONST -> YYAction 661; - ARROW -> YYAction 662; - DCOLON -> YYAction 663; - GETS -> YYAction 664; - EARROW -> YYAction 665; - DOTDOT -> YYAction 666; - SOMEOP -> YYAction 667; + VARID -> YYAction 631; + CONID -> YYAction 632; + QUALIFIER -> YYAction 633; + DOCUMENTATION -> YYAction 634; + EXTENDS -> YYAction 635; + SUPER -> YYAction 636; + PACKAGE -> YYAction 637; + IMPORT -> YYAction 638; + INFIX -> YYAction 639; + INFIXR -> YYAction 640; + INFIXL -> YYAction 641; + NATIVE -> YYAction 642; + DATA -> YYAction 643; + WHERE -> YYAction 644; + CLASS -> YYAction 645; + INSTANCE -> YYAction 646; + ABSTRACT -> YYAction 647; + TYPE -> YYAction 648; + TRUE -> YYAction 649; + FALSE -> YYAction 650; + IF -> YYAction 651; + THEN -> YYAction 652; + ELSE -> YYAction 653; + CASE -> YYAction 654; + OF -> YYAction 655; + DERIVE -> YYAction 656; + LET -> YYAction 657; + IN -> YYAction 658; + DO -> YYAction 659; + FORALL -> YYAction 660; + PRIVATE -> YYAction 661; + PROTECTED -> YYAction 662; + PUBLIC -> YYAction 663; + PURE -> YYAction 664; + THROWS -> YYAction 665; + MUTABLE -> YYAction 666; + INTCONST -> YYAction 667; + STRCONST -> YYAction 668; + LONGCONST -> YYAction 669; + FLTCONST -> YYAction 670; + DBLCONST -> YYAction 671; + CHRCONST -> YYAction 672; + ARROW -> YYAction 673; + DCOLON -> YYAction 674; + GETS -> YYAction 675; + EARROW -> YYAction 676; + DOTDOT -> YYAction 677; + SOMEOP -> YYAction 678; _ -> YYAction yyBrace; }; }; -private yyaction685 t = YYAction (-252); -private yyaction686 t = case yychar t of { - ')' -> YYAction 711; +private yyaction696 t = YYAction (-253); +private yyaction697 t = case yychar t of { + ')' -> YYAction 722; _ -> YYAction yyErr; }; -private yyaction687 t = YYAction (-251); -private yyaction688 t = case yychar t of { - '(' -> YYAction 580; +private yyaction698 t = YYAction (-252); +private yyaction699 t = case yychar t of { + '(' -> YYAction 590; _ -> case yytoken t of { - SOMEOP -> YYAction 579; + SOMEOP -> YYAction 589; _ -> YYAction yyErr; }; }; -private yyaction689 t = case yychar t of { - '?' -> YYAction 691; - '!' -> YYAction 692; +private yyaction700 t = case yychar t of { + '?' -> YYAction 702; + '!' -> YYAction 703; _ -> case yytoken t of { - VARID -> YYAction 119; + VARID -> YYAction 121; _ -> YYAction yyErr; }; }; -private yyaction690 t = case yychar t of { - '?' -> YYAction 691; - '!' -> YYAction 692; +private yyaction701 t = case yychar t of { + '?' -> YYAction 702; + '!' -> YYAction 703; _ -> case yytoken t of { - VARID -> YYAction 119; + VARID -> YYAction 121; _ -> YYAction yyErr; }; }; -private yyaction691 t = case yytoken t of { - VARID -> YYAction 119; +private yyaction702 t = case yytoken t of { + VARID -> YYAction 121; _ -> YYAction yyErr; }; -private yyaction692 t = case yytoken t of { - VARID -> YYAction 119; +private yyaction703 t = case yytoken t of { + VARID -> YYAction 121; _ -> YYAction yyErr; }; -private yyaction693 t = YYAction (-335); -private yyaction694 t = case yytoken t of { - DCOLON -> YYAction 717; +private yyaction704 t = YYAction (-339); +private yyaction705 t = case yytoken t of { + DCOLON -> YYAction 728; _ -> YYAction yyErr; }; -private yyaction695 t = case yychar t of { - ',' -> YYAction 718; +private yyaction706 t = case yychar t of { + ',' -> YYAction 729; _ -> case yytoken t of { - DCOLON -> YYAction (-327); + DCOLON -> YYAction (-331); _ -> YYAction yyErr; }; }; -private yyaction696 t = YYAction (-329); -private yyaction697 t = YYAction (-332); -private yyaction698 t = YYAction (-311); -private yyaction699 t = case yychar t of { - '}' -> YYAction (-323); +private yyaction707 t = YYAction (-333); +private yyaction708 t = YYAction (-336); +private yyaction709 t = YYAction (-315); +private yyaction710 t = case yychar t of { + '}' -> YYAction (-327); '?' -> YYAction (-18); '!' -> YYAction (-18); _ -> case yytoken t of { @@ -5405,8 +5474,8 @@ private yyaction699 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction700 t = case yychar t of { - '}' -> YYAction (-322); +private yyaction711 t = case yychar t of { + '}' -> YYAction (-326); '?' -> YYAction (-18); '!' -> YYAction (-18); _ -> case yytoken t of { @@ -5417,198 +5486,198 @@ private yyaction700 t = case yychar t of { _ -> YYAction yyBrace; }; }; -private yyaction701 t = YYAction (-247); -private yyaction702 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; +private yyaction712 t = YYAction (-248); +private yyaction713 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; _ -> case yytoken t of { - VARID -> YYAction 225; + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; - _ -> YYAction yyErr; - }; -}; -private yyaction703 t = YYAction (-248); -private yyaction704 t = YYAction (-378); -private yyaction705 t = YYAction (-382); -private yyaction706 t = YYAction (-164); -private yyaction707 t = case yychar t of { - '-' -> YYAction 668; - ';' -> YYAction 669; - '{' -> YYAction 670; - '.' -> YYAction 672; - '(' -> YYAction 673; - ')' -> YYAction 674; - ',' -> YYAction 675; - '|' -> YYAction 676; - '[' -> YYAction 677; - ']' -> YYAction 678; - '?' -> YYAction 679; - '!' -> YYAction 680; - '=' -> YYAction 681; - '\\' -> YYAction 682; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; + _ -> YYAction yyErr; + }; +}; +private yyaction714 t = YYAction (-249); +private yyaction715 t = YYAction (-382); +private yyaction716 t = YYAction (-386); +private yyaction717 t = YYAction (-165); +private yyaction718 t = case yychar t of { + '-' -> YYAction 679; + ';' -> YYAction 680; + '{' -> YYAction 681; + '.' -> YYAction 683; + '(' -> YYAction 684; + ')' -> YYAction 685; + ',' -> YYAction 686; + '|' -> YYAction 687; + '[' -> YYAction 688; + ']' -> YYAction 689; + '?' -> YYAction 690; + '!' -> YYAction 691; + '=' -> YYAction 692; + '\\' -> YYAction 693; '}' -> YYAction (-112); _ -> case yytoken t of { - VARID -> YYAction 620; - CONID -> YYAction 621; - QUALIFIER -> YYAction 622; - DOCUMENTATION -> YYAction 623; - EXTENDS -> YYAction 624; - SUPER -> YYAction 625; - PACKAGE -> YYAction 626; - IMPORT -> YYAction 627; - INFIX -> YYAction 628; - INFIXR -> YYAction 629; - INFIXL -> YYAction 630; - NATIVE -> YYAction 631; - DATA -> YYAction 632; - WHERE -> YYAction 633; - CLASS -> YYAction 634; - INSTANCE -> YYAction 635; - ABSTRACT -> YYAction 636; - TYPE -> YYAction 637; - TRUE -> YYAction 638; - FALSE -> YYAction 639; - IF -> YYAction 640; - THEN -> YYAction 641; - ELSE -> YYAction 642; - CASE -> YYAction 643; - OF -> YYAction 644; - DERIVE -> YYAction 645; - LET -> YYAction 646; - IN -> YYAction 647; - DO -> YYAction 648; - FORALL -> YYAction 649; - PRIVATE -> YYAction 650; - PROTECTED -> YYAction 651; - PUBLIC -> YYAction 652; - PURE -> YYAction 653; - THROWS -> YYAction 654; - MUTABLE -> YYAction 655; - INTCONST -> YYAction 656; - STRCONST -> YYAction 657; - LONGCONST -> YYAction 658; - FLTCONST -> YYAction 659; - DBLCONST -> YYAction 660; - CHRCONST -> YYAction 661; - ARROW -> YYAction 662; - DCOLON -> YYAction 663; - GETS -> YYAction 664; - EARROW -> YYAction 665; - DOTDOT -> YYAction 666; - SOMEOP -> YYAction 667; + VARID -> YYAction 631; + CONID -> YYAction 632; + QUALIFIER -> YYAction 633; + DOCUMENTATION -> YYAction 634; + EXTENDS -> YYAction 635; + SUPER -> YYAction 636; + PACKAGE -> YYAction 637; + IMPORT -> YYAction 638; + INFIX -> YYAction 639; + INFIXR -> YYAction 640; + INFIXL -> YYAction 641; + NATIVE -> YYAction 642; + DATA -> YYAction 643; + WHERE -> YYAction 644; + CLASS -> YYAction 645; + INSTANCE -> YYAction 646; + ABSTRACT -> YYAction 647; + TYPE -> YYAction 648; + TRUE -> YYAction 649; + FALSE -> YYAction 650; + IF -> YYAction 651; + THEN -> YYAction 652; + ELSE -> YYAction 653; + CASE -> YYAction 654; + OF -> YYAction 655; + DERIVE -> YYAction 656; + LET -> YYAction 657; + IN -> YYAction 658; + DO -> YYAction 659; + FORALL -> YYAction 660; + PRIVATE -> YYAction 661; + PROTECTED -> YYAction 662; + PUBLIC -> YYAction 663; + PURE -> YYAction 664; + THROWS -> YYAction 665; + MUTABLE -> YYAction 666; + INTCONST -> YYAction 667; + STRCONST -> YYAction 668; + LONGCONST -> YYAction 669; + FLTCONST -> YYAction 670; + DBLCONST -> YYAction 671; + CHRCONST -> YYAction 672; + ARROW -> YYAction 673; + DCOLON -> YYAction 674; + GETS -> YYAction 675; + EARROW -> YYAction 676; + DOTDOT -> YYAction 677; + SOMEOP -> YYAction 678; _ -> YYAction yyBrace; }; }; -private yyaction708 t = case yychar t of { - '}' -> YYAction 723; +private yyaction719 t = case yychar t of { + '}' -> YYAction 734; _ -> YYAction yyBrace; }; -private yyaction709 t = YYAction (-45); -private yyaction710 t = YYAction (-109); -private yyaction711 t = YYAction (-263); -private yyaction712 t = YYAction (-260); -private yyaction713 t = YYAction (-331); -private yyaction714 t = YYAction (-330); -private yyaction715 t = YYAction (-334); -private yyaction716 t = YYAction (-333); -private yyaction717 t = case yychar t of { - '(' -> YYAction 240; - '[' -> YYAction 241; - _ -> case yytoken t of { - VARID -> YYAction 225; +private yyaction720 t = YYAction (-45); +private yyaction721 t = YYAction (-109); +private yyaction722 t = YYAction (-264); +private yyaction723 t = YYAction (-261); +private yyaction724 t = YYAction (-335); +private yyaction725 t = YYAction (-334); +private yyaction726 t = YYAction (-338); +private yyaction727 t = YYAction (-337); +private yyaction728 t = case yychar t of { + '(' -> YYAction 244; + '[' -> YYAction 245; + _ -> case yytoken t of { + VARID -> YYAction 229; CONID -> YYAction 24; - QUALIFIER -> YYAction 131; - FORALL -> YYAction 294; + QUALIFIER -> YYAction 133; + FORALL -> YYAction 299; _ -> YYAction yyErr; }; }; -private yyaction718 t = case yychar t of { - '?' -> YYAction 691; - '!' -> YYAction 692; - _ -> case yytoken t of { - VARID -> YYAction 119; - PRIVATE -> YYAction 689; - PUBLIC -> YYAction 690; - _ -> YYAction yyErr; - }; -}; -private yyaction719 t = YYAction (-325); -private yyaction720 t = YYAction (-324); -private yyaction721 t = YYAction (-242); -private yyaction722 t = YYAction (-113); -private yyaction723 t = case yychar t of { - '-' -> YYAction 668; - ';' -> YYAction 669; - '{' -> YYAction 670; - '.' -> YYAction 672; - '(' -> YYAction 673; - ')' -> YYAction 674; - ',' -> YYAction 675; - '|' -> YYAction 676; - '[' -> YYAction 677; - ']' -> YYAction 678; - '?' -> YYAction 679; - '!' -> YYAction 680; - '=' -> YYAction 681; - '\\' -> YYAction 682; +private yyaction729 t = case yychar t of { + '?' -> YYAction 702; + '!' -> YYAction 703; + _ -> case yytoken t of { + VARID -> YYAction 121; + PRIVATE -> YYAction 700; + PUBLIC -> YYAction 701; + _ -> YYAction yyErr; + }; +}; +private yyaction730 t = YYAction (-329); +private yyaction731 t = YYAction (-328); +private yyaction732 t = YYAction (-243); +private yyaction733 t = YYAction (-113); +private yyaction734 t = case yychar t of { + '-' -> YYAction 679; + ';' -> YYAction 680; + '{' -> YYAction 681; + '.' -> YYAction 683; + '(' -> YYAction 684; + ')' -> YYAction 685; + ',' -> YYAction 686; + '|' -> YYAction 687; + '[' -> YYAction 688; + ']' -> YYAction 689; + '?' -> YYAction 690; + '!' -> YYAction 691; + '=' -> YYAction 692; + '\\' -> YYAction 693; '}' -> YYAction (-110); _ -> case yytoken t of { - VARID -> YYAction 620; - CONID -> YYAction 621; - QUALIFIER -> YYAction 622; - DOCUMENTATION -> YYAction 623; - EXTENDS -> YYAction 624; - SUPER -> YYAction 625; - PACKAGE -> YYAction 626; - IMPORT -> YYAction 627; - INFIX -> YYAction 628; - INFIXR -> YYAction 629; - INFIXL -> YYAction 630; - NATIVE -> YYAction 631; - DATA -> YYAction 632; - WHERE -> YYAction 633; - CLASS -> YYAction 634; - INSTANCE -> YYAction 635; - ABSTRACT -> YYAction 636; - TYPE -> YYAction 637; - TRUE -> YYAction 638; - FALSE -> YYAction 639; - IF -> YYAction 640; - THEN -> YYAction 641; - ELSE -> YYAction 642; - CASE -> YYAction 643; - OF -> YYAction 644; - DERIVE -> YYAction 645; - LET -> YYAction 646; - IN -> YYAction 647; - DO -> YYAction 648; - FORALL -> YYAction 649; - PRIVATE -> YYAction 650; - PROTECTED -> YYAction 651; - PUBLIC -> YYAction 652; - PURE -> YYAction 653; - THROWS -> YYAction 654; - MUTABLE -> YYAction 655; - INTCONST -> YYAction 656; - STRCONST -> YYAction 657; - LONGCONST -> YYAction 658; - FLTCONST -> YYAction 659; - DBLCONST -> YYAction 660; - CHRCONST -> YYAction 661; - ARROW -> YYAction 662; - DCOLON -> YYAction 663; - GETS -> YYAction 664; - EARROW -> YYAction 665; - DOTDOT -> YYAction 666; - SOMEOP -> YYAction 667; + VARID -> YYAction 631; + CONID -> YYAction 632; + QUALIFIER -> YYAction 633; + DOCUMENTATION -> YYAction 634; + EXTENDS -> YYAction 635; + SUPER -> YYAction 636; + PACKAGE -> YYAction 637; + IMPORT -> YYAction 638; + INFIX -> YYAction 639; + INFIXR -> YYAction 640; + INFIXL -> YYAction 641; + NATIVE -> YYAction 642; + DATA -> YYAction 643; + WHERE -> YYAction 644; + CLASS -> YYAction 645; + INSTANCE -> YYAction 646; + ABSTRACT -> YYAction 647; + TYPE -> YYAction 648; + TRUE -> YYAction 649; + FALSE -> YYAction 650; + IF -> YYAction 651; + THEN -> YYAction 652; + ELSE -> YYAction 653; + CASE -> YYAction 654; + OF -> YYAction 655; + DERIVE -> YYAction 656; + LET -> YYAction 657; + IN -> YYAction 658; + DO -> YYAction 659; + FORALL -> YYAction 660; + PRIVATE -> YYAction 661; + PROTECTED -> YYAction 662; + PUBLIC -> YYAction 663; + PURE -> YYAction 664; + THROWS -> YYAction 665; + MUTABLE -> YYAction 666; + INTCONST -> YYAction 667; + STRCONST -> YYAction 668; + LONGCONST -> YYAction 669; + FLTCONST -> YYAction 670; + DBLCONST -> YYAction 671; + CHRCONST -> YYAction 672; + ARROW -> YYAction 673; + DCOLON -> YYAction 674; + GETS -> YYAction 675; + EARROW -> YYAction 676; + DOTDOT -> YYAction 677; + SOMEOP -> YYAction 678; _ -> YYAction yyBrace; }; }; -private yyaction724 t = YYAction (-326); -private yyaction725 t = YYAction (-328); -private yyaction726 t = YYAction (-111); +private yyaction735 t = YYAction (-330); +private yyaction736 t = YYAction (-332); +private yyaction737 t = YYAction (-111); private reduce1 = \d\(a,p)\w\b -> do { changeST Global.{sub <- SubSt.{ thisPos = p}}; @@ -5691,7 +5760,7 @@ private reduce27 = const ; private reduce28 = \a\_\b -> a ++ b ; -private reduce29 = single +private reduce29 = single . DefinitionS.Doc ; private reduce32 = \_\ds -> map (updVis Private) ds ; @@ -5699,13 +5768,13 @@ private reduce33 = \_\ds -> map (updVis Protected) ds ; private reduce34 = \_\ds -> map (updVis Public) ds ; -private reduce35 = \_\(d::Def) -> [d.{ctrs <- map updCtr}] +private reduce35 = \_\(d::DatDcl) -> [DefinitionS.Dat $ d.{ctrs <- map updCtr}] ; -private reduce36 = single +private reduce36 = single . DefinitionS.Imp ; -private reduce37 = single +private reduce37 = single . DefinitionS.Fix ; -private reduce38 = single +private reduce38 = single . DefinitionS.Mod ; private reduce40 = \_\m\t\i\js -> ModDcl {pos = yyline m, extending=t, implementing=i, code=js } ; @@ -5735,105 +5804,113 @@ private reduce113 = \a\b\cs -> a:b:cs ; private reduce114 = \t -> DocDcl {pos = yyline t, text = t.value} ; -private reduce115 = single +private reduce115 = single . DefinitionS.Typ +; +private reduce116 = single . DefinitionS.Dat ; -private reduce116 = single +private reduce117 = single . DefinitionS.Jav ; -private reduce117 = single +private reduce118 = single . DefinitionS.Cla ; -private reduce118 = single +private reduce119 = single . DefinitionS.Ins ; -private reduce119 = single +private reduce120 = single . DefinitionS.Drv ; -private reduce122 = const +private reduce123 = const ; -private reduce123 = \d\_\ds -> d ++ ds +private reduce124 = \d\_\ds -> d ++ ds ; -private reduce125 = single +private reduce125 = map DefinitionS.Ann ; -private reduce128 = \_\ds -> map (updVis Private) ds +private reduce126 = single . DefinitionS.Nat ; -private reduce129 = \_\ds -> map (updVis Protected) ds +private reduce127 = single . DefinitionS.Fun ; -private reduce130 = \_\ds -> map (updVis Public) ds +private reduce129 = \_\ds -> map (updVis Private) ds ; -private reduce131 = single +private reduce130 = \_\ds -> map (updVis Protected) ds ; -private reduce132 = (:) +private reduce131 = \_\ds -> map (updVis Public) ds ; -private reduce137 = const +private reduce132 = single . DefinitionS.Doc ; -private reduce138 = \ds1\_\ds2 -> ds1 ++ ds2 +private reduce133 = \doc\ds -> DefinitionS.Doc doc : ds ; -private reduce139 = \i\b\c -> ImpDcl {pos=snd b, pack=fst b, imports=c, as=Nothing} +private reduce135 = map LetMemberS.Ann ; -private reduce140 = \i\p\a\c\l -> do +private reduce136 = single . LetMemberS.Fun +; +private reduce138 = const +; +private reduce139 = \ds1\_\ds2 -> ds1 ++ ds2 +; +private reduce140 = \i\b\c -> ImpDcl {pos=snd b, pack=fst b, imports=c, as=Nothing} +; +private reduce141 = \i\p\a\c\l -> do when (Token.value a != "as") do yyerror (yyline a) (show "as" ++ " expected instead of " ++ show (Token.value a)) changeST Global.{sub <- SubSt.{idKind <- insert (KeyTk c) (Left()) }} YYM.pure ImpDcl {pos = snd p, pack = fst p, imports = l, as = Just (Token.value c)} ; -private reduce141 = \i\p\c\l -> do +private reduce142 = \i\p\c\l -> do changeST Global.{sub <- SubSt.{idKind <- insert (KeyTk c) (Left()) }} YYM.pure ImpDcl {pos = snd p, pack = fst p, imports = l, as = Just (Token.value c)} ; -private reduce142 = linkAll +private reduce143 = linkAll ; -private reduce143 = \v\_\is\_ -> do +private reduce144 = \v\_\is\_ -> do when ( v.value `notElem` [ "except", "excluding", "without", "außer", "ohne", "hiding" ]) do yyerror (yyline v) (show "hiding" ++ " expected instead of " ++ show v.value) YYM.pure linkAll.{items=is} ; -private reduce144 = \_\_ -> linkNone +private reduce145 = \_\_ -> linkNone ; -private reduce145 = \_\is\_ -> linkNone.{items = is} +private reduce146 = \_\is\_ -> linkNone.{items = is} ; -private reduce146 = \_\il -> ImportList.{publik = true} il +private reduce147 = \_\il -> ImportList.{publik = true} il ; -private reduce147 = single +private reduce148 = single ; -private reduce148 = \s\_ -> [s] +private reduce149 = \s\_ -> [s] ; -private reduce149 = liste +private reduce150 = liste ; -private reduce150 = \v -> protoItem.{ name = v } +private reduce151 = \v -> protoItem.{ name = v } ; -private reduce151 = \v\_\ms\_ -> protoItem.{ name = Simple v, members = Just ms} +private reduce152 = \v\_\ms\_ -> protoItem.{ name = Simple v, members = Just ms} ; -private reduce152 = \v\_\_ -> protoItem.{ name = Simple v, members = Just []} +private reduce153 = \v\_\_ -> protoItem.{ name = Simple v, members = Just []} ; -private reduce153 = \v -> protoItem.{ name = v } +private reduce154 = \v -> protoItem.{ name = v } ; -private reduce154 = \t -> protoItem.{ name = opSname t } +private reduce155 = \t -> protoItem.{ name = opSname t } ; -private reduce155 = \v -> protoItem.{ name = Simple v} +private reduce156 = \v -> protoItem.{ name = Simple v} ; -private reduce156 = \s -> ImportItem.{alias = (enclosed . Token.value . SName.id . ImportItem.name) s} s +private reduce157 = \s -> ImportItem.{alias = (enclosed . Token.value . SName.id . ImportItem.name) s} s ; -private reduce157 = \s\a -> ImportItem.{alias = enclosed (Token.value a)} s +private reduce158 = \s\a -> ImportItem.{alias = enclosed (Token.value a)} s ; -private reduce158 = \_\s -> ImportItem.export s +private reduce159 = \_\s -> ImportItem.export s ; -private reduce159 = \v -> protoItem.{ name = Simple v, +private reduce160 = \v -> protoItem.{ name = Simple v, alias = enclosed (Token.value v)} ; -private reduce160 = \v\a -> protoItem.{ name = Simple v, +private reduce161 = \v\a -> protoItem.{ name = Simple v, alias = enclosed (Token.value a)} ; -private reduce161 = \_\s -> ImportItem.export s +private reduce162 = \_\s -> ImportItem.export s ; -private reduce162 = single +private reduce163 = single ; -private reduce163 = \s\_ -> [s] +private reduce164 = \s\_ -> [s] ; -private reduce164 = liste +private reduce165 = liste ; -private reduce167 = \v -> do { op <- unqualified v; pure op } -; -private reduce170 = Token.{tokid = VARID} +private reduce168 = \v -> do { op <- unqualified v; pure op } ; private reduce171 = Token.{tokid = VARID} ; @@ -5845,174 +5922,176 @@ private reduce174 = Token.{tokid = VARID} ; private reduce175 = Token.{tokid = VARID} ; -private reduce176 = single +private reduce176 = Token.{tokid = VARID} +; +private reduce177 = single ; -private reduce177 = liste +private reduce178 = liste ; -private reduce178 = \n\t\v -> With2 n t v +private reduce179 = \n\t\v -> With2 n t v ; -private reduce179 = \t\v -> With1 t v +private reduce180 = \t\v -> With1 t v ; -private reduce180 = \v -> Simple v +private reduce181 = \v -> Simple v ; -private reduce181 = \n\t\v -> With2 n t v +private reduce182 = \n\t\v -> With2 n t v ; -private reduce182 = \t\v -> With1 t v +private reduce183 = \t\v -> With1 t v ; -private reduce183 = \v -> Simple v +private reduce184 = \v -> Simple v ; -private reduce186 = \n\t\v -> With2 n t v +private reduce187 = \n\t\v -> With2 n t v ; -private reduce187 = \t\v -> With1 t v +private reduce188 = \t\v -> With1 t v ; -private reduce188 = Simple +private reduce189 = Simple ; -private reduce189 = opSname +private reduce190 = opSname ; -private reduce193 = \f\i -> do +private reduce194 = \f\i -> do t <- infixop (yyline i) NOP1 (Token.value i) YYM.pure (FixDcl {pos=Pos f i, opid=t, ops=[]}) ; -private reduce194 = \f\i -> do +private reduce195 = \f\i -> do t <- infixop (yyline i) LOP1 (Token.value i) YYM.pure (FixDcl {pos=Pos f i, opid=t, ops=[]}) ; -private reduce195 = \f\i -> do +private reduce196 = \f\i -> do t <- infixop (yyline i) ROP1 (Token.value i) YYM.pure (FixDcl {pos=Pos f i, opid=t, ops=[]}) ; -private reduce196 = Token.value -; private reduce197 = Token.value ; private reduce198 = Token.value ; -private reduce199 = single +private reduce199 = Token.value ; -private reduce200 = (:) +private reduce200 = single ; -private reduce201 = \(def::Def)\o -> def.{ops = o} +private reduce201 = (:) ; -private reduce202 = \as\_\s -> map (annotation s) as +private reduce202 = \(def::FixDcl)\o -> def.{ops = o} ; -private reduce204 = \_\a\_ -> do unqualified a +private reduce203 = \as\_\s -> map (annotation s) as ; -private reduce205 = \_\a\_ -> a +private reduce205 = \_\a\_ -> do unqualified a ; private reduce206 = \_\a\_ -> a ; -private reduce207 = single +private reduce207 = \_\a\_ -> a ; -private reduce208 = liste +private reduce208 = single ; -private reduce209 = \_\(d::Def) -> d.{isPure = true} +private reduce209 = liste ; -private reduce214 = \o -> do unqualified o +private reduce210 = \_\(d::NatDcl) -> d.{isPure = true} ; -private reduce216 = \o -> do unqualified o >>= pure . _.value +private reduce215 = \o -> do unqualified o ; -private reduce217 = Token.value +private reduce217 = \o -> do unqualified o >>= pure . _.value ; -private reduce218 = \f\j\g -> (f,j,Just g) +private reduce218 = Token.value ; -private reduce219 = \f\j -> (f,j,Nothing) +private reduce219 = \f\j\g -> (f,j,Just g) ; -private reduce220 = \f\g -> (f,Token.value f, Just g) +private reduce220 = \f\j -> (f,j,Nothing) ; -private reduce221 = \f -> (f,Token.value f, Nothing) +private reduce221 = \f\g -> (f,Token.value f, Just g) ; -private reduce222 = \a\_\c -> (a, c) +private reduce222 = \f -> (f,Token.value f, Nothing) ; -private reduce223 = \a -> (a, []) +private reduce223 = \a\_\c -> (a, c) ; -private reduce224 = single +private reduce224 = \a -> (a, []) ; -private reduce225 = liste +private reduce225 = single ; -private reduce226 = \_\(fr,jv,ga)\col\t -> +private reduce226 = liste +; +private reduce227 = \_\(fr,jv,ga)\col\t -> NatDcl {pos=yyline fr, vis=Public, name=fr.value, meth=jv, txs=t, isPure=false, gargs = ga, doc=Nothing} ; -private reduce228 = ForAll [] +private reduce229 = ForAll [] ; -private reduce229 = \_\vs\_\r -> ForAll vs r +private reduce230 = \_\vs\_\r -> ForAll vs r ; -private reduce231 = \dot -> do +private reduce232 = \dot -> do when (Token.value dot != "•") do yyerror (yyline dot) ("'.' expected instead of " ++ show dot.value) YYM.pure dot ; -private reduce232 = \tau\t\rho -> do +private reduce233 = \tau\t\rho -> do context <- tauToCtx tau - YYM.pure (Rho.{context} rho) + YYM.pure $ set RhoT._context context rho ; -private reduce234 = RhoTau [] +private reduce235 = RhoT.Tau . RhoTau [] ; -private reduce235 = \a\_\b -> case a of - TSig s -> RhoFun [] s b - _ -> RhoFun [] (ForAll [] (RhoTau [] a)) b +private reduce236 = \a\_\b -> case a of + TSig s -> RhoT.Fun $ RhoFun [] s b + _ -> RhoT.Fun $ RhoFun [] (ForAll [] (RhoT.Tau $ RhoTau [] a)) b ; -private reduce237 = TSig +private reduce238 = TSig ; -private reduce238 = \a\f\b -> case a of - TSig s -> TSig (ForAll [] (RhoFun [] s (RhoTau [] b))) - _ -> TApp (TApp (TCon (yyline f) (fromBase f.{tokid=CONID, value="->"})) a) b +private reduce239 = \a\f\b -> case a of + TSig s -> TSig (ForAll [] (RhoT.Fun $ RhoFun [] s (RhoT.Tau $ RhoTau [] b))) + _ -> TApp (TApp (TauT.Con TCon{pos=yyline f, name=fromBase f.{tokid=CONID, value="->"}}) a) b ; -private reduce239 = single +private reduce240 = single +; +private reduce241 = liste ; -private reduce240 = liste +private reduce242 = single ; -private reduce241 = single +private reduce243 = liste ; -private reduce242 = liste +private reduce244 = \taus -> Tau.mkapp (head taus) (tail taus) ; -private reduce243 = \taus -> Tau.mkapp (head taus) (tail taus) +private reduce245 = TauT.Var ; -private reduce245 = \(tn::SName) -> TCon (yyline tn.id) tn +private reduce246 = \(tn::SName) -> TauT.Con TCon{pos=yyline tn.id, name=tn} ; -private reduce246 = \_\t\_ -> t +private reduce247 = \_\t\_ -> t ; -private reduce247 = \_\t\(c::Token)\ts\_ -> +private reduce248 = \_\t\(c::Token)\ts\_ -> let tus = t:ts; i = length tus; tname = fromBase c.{tokid=CONID, value=tuple i} - in (TCon (yyline c) tname).mkapp tus + in (TauT.Con TCon{pos=yyline c, name=tname}).mkapp tus ; -private reduce248 = \_\t\e\ts\_ -> mkEither (yyline e) t ts +private reduce249 = \_\t\e\ts\_ -> mkEither (yyline e) t ts ; -private reduce249 = \a\t\_ -> TApp (TCon (yyline a) - (fromBase a.{tokid=CONID, value="[]"})) - t +private reduce250 = \a\t\_ -> TApp (TauT.Con TCon{pos=yyline a, name=fromBase a.{tokid=CONID, value="[]"} }) t ; -private reduce250 = \n -> TVar (yyline n) KVar (Token.value n) +private reduce251 = \n -> TVar{pos=yyline n, kind=KVar, var=Token.value n} ; -private reduce251 = \_\n\_\k\_ -> TVar (yyline n) k (Token.value n) +private reduce252 = \_\n\_\k\_ -> TVar{pos=yyline n, kind=k, var=Token.value n} ; -private reduce252 = \_\v\x\ks\_ -> TVar (yyline v) (KGen ks) (v.value) +private reduce253 = \_\v\x\ks\_ -> TVar{pos=yyline v, kind=KGen ks, var=v.value} ; -private reduce253 = \_\x\ks\_ -> TVar (yyline x) (KGen ks) ("<") +private reduce254 = \_\x\ks\_ -> TVar{pos=yyline x, kind=KGen ks, var="<"} ; -private reduce254 = \_\x\k\_ -> TVar (yyline x) (KGen [k]) (">") +private reduce255 = \_\x\k\_ -> TVar{pos=yyline x, kind=KGen [k], var=">"} ; -private reduce256 = \(a::Token)\_ -> fromBase a.{tokid=CONID, value="[]"} +private reduce257 = \(a::Token)\_ -> fromBase a.{tokid=CONID, value="[]"} ; -private reduce257 = \(a::Token)\_ -> fromBase a.{tokid=CONID, value="()"} +private reduce258 = \(a::Token)\_ -> fromBase a.{tokid=CONID, value="()"} ; -private reduce258 = \(z::Token)\n\_ -> fromBase z.{tokid=CONID, value=tuple (n+1)} +private reduce259 = \(z::Token)\n\_ -> fromBase z.{tokid=CONID, value=tuple (n+1)} ; -private reduce259 = \_\(a::Token)\_ -> fromBase a.{tokid=CONID, value="->"} +private reduce260 = \_\(a::Token)\_ -> fromBase a.{tokid=CONID, value="->"} ; -private reduce260 = \a\_\c -> KApp a c +private reduce261 = \a\_\c -> KApp a c ; -private reduce262 = \star -> do +private reduce263 = \star -> do let w = Token.value star when (w != "*") do yyerror (yyline star) @@ -6020,23 +6099,23 @@ private reduce262 = \star -> do pure KType ; -private reduce263 = \_\b\_ -> b +private reduce264 = \_\b\_ -> b ; -private reduce264 = \c\v -> Ctx {pos=Pos (SName.id c) v.pos.last, cname=c, tau=v} +private reduce265 = \c\v -> Ctx {pos=Pos (SName.id c) v.pos.last, cname=c, tau=TauT.Var v} ; -private reduce265 = single +private reduce266 = single ; -private reduce266 = \c\_ -> [c] +private reduce267 = \c\_ -> [c] ; -private reduce267 = liste +private reduce268 = liste ; -private reduce268 = single +private reduce269 = single ; -private reduce269 = \_\x\_ -> x +private reduce270 = \_\x\_ -> x ; -private reduce270 = +private reduce271 = \_\ctxs\_\c\v\defs -> do - sups <- classContext (Token.value c) ctxs (v::TauS).var + sups <- classContext ctxs v.var pure ClaDcl{ pos = yyline c, vis = Public, @@ -6047,366 +6126,376 @@ private reduce270 = doc = Nothing} ; -private reduce271 = +private reduce272 = \kw\ctxs\defs -> case ctxs of Ctx{pos,cname,tau}:rest -> do unless (null rest) (yyerror (yyline kw) "classname missing after contexts") when (SName.{ty?} cname) (yyerror (yyline cname.id) "classname must not be qualified") + clvar <- case tau of + TauT.Var v -> pure v + _ -> do + -- actually, this case never happens because of the 'scontext' rule + yyerror (yyline cname.id) + $ "class declaration must be in the form of C t " + ++ "where C is a class name and t is a type variable" + pure $ TVar {pos=Position.null, kind=KVar, var="bad"} pure ClaDcl {pos, vis = Public, name=cname.id.value, - clvar = tau, supers = [], + clvar, supers = [], defs, doc = Nothing} _ -> Prelude.error "fatal: empty ccontext (cannot happen)" ; -private reduce272 = \c\t -> Ctx {pos=Pos (SName.id c) t.getpos.last, cname=c, tau=t} +private reduce273 = \c\t -> Ctx {pos=Pos (SName.id c) t.getpos.last, cname=c, tau=t} ; -private reduce273 = single +private reduce274 = single ; -private reduce274 = \c\_ -> [c] +private reduce275 = \c\_ -> [c] ; -private reduce275 = liste +private reduce276 = liste ; -private reduce276 = single +private reduce277 = single ; -private reduce277 = \_\x\_ -> x +private reduce278 = \_\x\_ -> x ; -private reduce278 = +private reduce279 = \ctxs\ea\cls\tau -> InsDcl { pos = yyline ea, vis = Public, clas = cls, - typ = ForAll [] (RhoTau ctxs tau), + typ = ForAll [] (RhoT.Tau $ RhoTau ctxs tau), defs = [], doc = Nothing} ; -private reduce279 = +private reduce280 = \ctxs -> case ctxs of Ctx{pos, cname, tau}:rest -> do unless (null rest) (yyerror pos "classname missing after instance contexts") pure InsDcl { pos, vis = Public, clas = cname, - typ = ForAll [] (RhoTau [] tau), + typ = ForAll [] (RhoT.Tau $ RhoTau [] tau), defs = [], doc = Nothing, } _ -> Prelude.error "fatal: empty instance context" ; -private reduce280 = - \ins\head\defs -> (head::Def).{defs, pos = yyline ins} +private reduce281 = + \ins\head\defs -> (head::InsDcl).{defs, pos = yyline ins} ; -private reduce281 = - \d\(i::Def) -> DrvDcl {pos = yyline d, vis = Public, clas=i.clas, typ=i.typ, doc=Nothing} +private reduce282 = + \d\(i::InsDcl) -> DrvDcl {pos = yyline d, vis = Public, clas=i.clas, typ=i.typ, doc=Nothing} ; -private reduce282 = \def\defs -> (def::Def).{defs = defs} +private reduce283 = \def\defs -> (def::DatDcl).{defs = defs} ; -private reduce283 = \_\_ -> true +private reduce284 = \def\defs -> (def::JavDcl).{defs = defs} ; -private reduce284 = \_ -> false +private reduce285 = \_\_ -> true ; -private reduce285 = \x -> (x, Nothing) +private reduce286 = \_ -> false ; -private reduce286 = \x\gs -> (x, Just gs) +private reduce287 = \x -> (x, Nothing) ; -private reduce287 = \_\ts\_ -> ts +private reduce288 = \x\gs -> (x, Just gs) ; -private reduce288 = \_\_ -> [] +private reduce289 = single ; -private reduce289 = - \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, - jclas=jt, vars=[], defs=[], - gargs, - isPure = pur, - doc=Nothing} - +private reduce290 = \h\_\t -> h:t ; -private reduce290 = - \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, - jclas=jt, vars=ds, defs=[], - gargs, - isPure = pur, - doc=Nothing} - +private reduce291 = \_\ts\_ -> ts +; +private reduce292 = \_\_ -> [] ; -private reduce291 = +private reduce293 = \dat\d\ds\docu\alts -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = false, vars=ds, ctrs=alts, defs=[], doc=Nothing} ; -private reduce292 = +private reduce294 = \dat\d\docu\alts -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = false, vars=[], ctrs=alts, defs=[], doc=Nothing} ; -private reduce293 = +private reduce295 = \dat\d -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = false, vars=[], ctrs=[], defs=[], doc=Nothing} ; -private reduce294 = +private reduce296 = \dat\d\ds\docu\alt -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = true, vars=ds, ctrs=[alt], defs=[], doc=Nothing} ; -private reduce295 = +private reduce297 = \dat\d\docu\alt -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = true, vars=[], ctrs=[alt], defs=[], doc=Nothing} ; -private reduce296 = single +private reduce298 = + \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, + jclas=jt, vars=[], defs=[], + gargs, + isPure = pur, + doc=Nothing} + ; -private reduce297 = (:) +private reduce299 = + \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, + jclas=jt, vars=ds, defs=[], + gargs, + isPure = pur, + doc=Nothing} + +; +private reduce300 = single +; +private reduce301 = (:) ; -private reduce298 = single +private reduce302 = single ; -private reduce299 = liste +private reduce303 = liste ; -private reduce301 = \dc\doc -> (dc::DConS).{doc = Just (Token.value doc)} +private reduce305 = \dc\doc -> (dc::DConS).{doc = Just (Token.value doc)} ; -private reduce302 = \doc\dc -> (dc::DConS).{doc = Just (Token.value doc)} +private reduce306 = \doc\dc -> (dc::DConS).{doc = Just (Token.value doc)} ; -private reduce304 = \_\dc -> (dc::DConS).{vis = Public} +private reduce308 = \_\dc -> (dc::DConS).{vis = Public} ; -private reduce305 = \_\dc -> (dc::DConS).{vis = Private} +private reduce309 = \_\dc -> (dc::DConS).{vis = Private} ; -private reduce306 = \_\dc -> (dc::DConS).{vis = Protected} +private reduce310 = \_\dc -> (dc::DConS).{vis = Protected} ; -private reduce307 = \_\dcon -> DCon.{ -- strict=true, +private reduce311 = \_\dcon -> DCon.{ -- strict=true, flds <-map ConField.{strict=true}} dcon ; -private reduce308 = \_\dcon -> DCon.{ -- strict=false, +private reduce312 = \_\dcon -> DCon.{ -- strict=false, flds <-map ConField.{strict=false}} dcon ; -private reduce310 = \c -> DCon {pos=yyline c, vis=Public, -- strict=false, +private reduce314 = \c -> DCon {pos=yyline c, vis=Public, -- strict=false, name=Token.value c, flds=[], doc=Nothing } ; -private reduce311 = \c\_\fs\_ -> DCon {pos=yyline c, vis=Public, -- strict=false, +private reduce315 = \c\_\fs\_ -> DCon {pos=yyline c, vis=Public, -- strict=false, name=Token.value c, flds=fs, doc=Nothing } ; -private reduce312 = \c\fs -> DCon {pos=yyline c, vis=Public, -- strict=false, +private reduce316 = \c\fs -> DCon {pos=yyline c, vis=Public, -- strict=false, name=Token.value c, flds=fs, doc=Nothing } ; -private reduce313 = single +private reduce317 = single ; -private reduce314 = (:) +private reduce318 = (:) ; -private reduce316 = const ConField.{strict=true} +private reduce320 = const ConField.{strict=true} ; -private reduce317 = const ConField.{strict=false} +private reduce321 = const ConField.{strict=false} ; -private reduce318 = \tau -> case tau of +private reduce322 = \tau -> case tau of TSig s -> Field Position.null Nothing Nothing Public false s _ -> Field Position.null Nothing Nothing Public false - (ForAll [] (RhoTau [] tau)) + (ForAll [] (RhoT.Tau $ RhoTau [] tau)) ; -private reduce319 = single +private reduce323 = single ; -private reduce320 = (:) +private reduce324 = (:) ; -private reduce322 = const +private reduce326 = const ; -private reduce323 = \cs\(d::Token) -> map ConField.{doc <- addDoc d.value} cs +private reduce327 = \cs\(d::Token) -> map ConField.{doc <- addDoc d.value} cs ; -private reduce324 = \as\c\ls -> as ++ ls +private reduce328 = \as\c\ls -> as ++ ls ; -private reduce325 = \as\(d::Token)\ls -> map ConField.{doc <- addDoc d.value} as ++ ls +private reduce329 = \as\(d::Token)\ls -> map ConField.{doc <- addDoc d.value} as ++ ls ; -private reduce326 = \(d::Maybe String)\vs\_\t -> +private reduce330 = \(d::Maybe String)\vs\_\t -> map (ConField.{doc=d} . ($t)) vs ; -private reduce327 = single +private reduce331 = single ; -private reduce328 = liste +private reduce332 = liste ; -private reduce330 = const (ConField.{vis=Public} .) +private reduce334 = const (ConField.{vis=Public} .) ; -private reduce331 = const (ConField.{vis=Private} .) +private reduce335 = const (ConField.{vis=Private} .) ; -private reduce333 = const (ConField.{strict=true} .) +private reduce337 = const (ConField.{strict=true} .) ; -private reduce334 = const (ConField.{strict=false} .) +private reduce338 = const (ConField.{strict=false} .) ; -private reduce335 = \v -> Field (yyline v) (Just v.value) Nothing Public false +private reduce339 = \v -> Field (yyline v) (Just v.value) Nothing Public false ; -private reduce336 = \t\i \_\r -> TypDcl {pos=yyline i, +private reduce340 = \t\i \_\r -> TypDcl {pos=yyline i, vis=Public, name=Token.value i, vars=[], typ = r, doc=Nothing} ; -private reduce337 = \t\i\vs\_\r -> TypDcl {pos=yyline i, +private reduce341 = \t\i\vs\_\r -> TypDcl {pos=yyline i, vis=Public, name=Token.value i, vars=vs, typ = r, doc=Nothing} ; -private reduce338 = [] +private reduce342 = [] ; -private reduce339 = \_\_\_ -> [] +private reduce343 = \_\_\_ -> [] ; -private reduce340 = \_\_\defs\_ -> defs +private reduce344 = \_\_\defs\_ -> defs ; -private reduce341 = \_\_\_ -> [] +private reduce345 = \_\_\_ -> [] ; -private reduce342 = \_\_\defs\_ -> defs +private reduce346 = \_\_\defs\_ -> defs ; -private reduce343 = \(ex,pats)\eq\expr -> fundef ex pats expr +private reduce347 = \(ex,pats)\eq\expr -> fundef ex pats expr ; -private reduce344 = \(ex,pats)\gds -> fungds ex pats gds +private reduce348 = \(ex,pats)\gds -> fungds ex pats gds ; -private reduce345 = \fdefs\defs -> - case fdefs of - [fd] | FunDcl {expr=x} <- fd = YYM.pure [fd.{expr = Let defs x}] - _ = do - yyerror (head fdefs).pos ("illegal function definition, where { ... } after annotation?") - YYM.pure fdefs - +private reduce349 = \(fd::FunDcl)\defs -> YYM.pure $ fd.{expr = Let defs fd.expr} ; -private reduce346 = \x -> do +private reduce350 = \x -> do x <- funhead x YYM.pure x ; -private reduce347 = \x -> Lit (yyline x) LBool "true" false +private reduce351 = \x -> Lit (yyline x) LBool "true" false ; -private reduce348 = \x -> Lit (yyline x) LBool "false" false +private reduce352 = \x -> Lit (yyline x) LBool "false" false ; -private reduce349 = \x -> do litchar x +private reduce353 = \x -> do litchar x ; -private reduce350 = \x -> Lit (yyline x) LString (Token.value x) false +private reduce354 = \x -> Lit (yyline x) LString (Token.value x) false ; -private reduce351 = \x -> do litint x +private reduce355 = \x -> do litint x ; -private reduce352 = \x -> do litbig x +private reduce356 = \x -> do litbig x ; -private reduce353 = \x -> do litlong x +private reduce357 = \x -> do litlong x ; -private reduce354 = \x -> Lit (yyline x) LFloat (Token.value x) false +private reduce358 = \x -> Lit (yyline x) LFloat (Token.value x) false ; -private reduce355 = \x -> Lit (yyline x) LDouble (Token.value x) false +private reduce359 = \x -> Lit (yyline x) LDouble (Token.value x) false ; -private reduce356 = \x -> do litdec x +private reduce360 = \x -> do litdec x ; -private reduce357 = \x -> do litregexp x +private reduce361 = \x -> do litregexp x ; -private reduce362 = \e\t\x -> do { (ex,pat) <- funhead e; YYM.pure (Right (fundef ex pat x)) } +private reduce366 = \e\t\x -> do + (ex,pat) <- funhead e + YYM.pure $ Right $ single $ LetMemberS.Fun $ fundef ex pat x ; -private reduce363 = \_\_\ds\_ -> Right ds +private reduce367 = \_\_\ds\_ -> Right ds ; -private reduce364 = single +private reduce368 = single ; -private reduce365 = liste +private reduce369 = liste ; -private reduce366 = (const . single) +private reduce370 = (const . single) ; -private reduce367 = single +private reduce371 = single ; -private reduce368 = (const . single) +private reduce372 = (const . single) ; -private reduce369 = liste +private reduce373 = liste ; -private reduce370 = \e -> Left (Nothing, e) +private reduce374 = \e -> Left (Nothing, e) ; -private reduce371 = \p\g\e -> Left (Just p, e) +private reduce375 = \p\g\e -> Left (Just p, e) ; -private reduce372 = single +private reduce376 = single ; -private reduce373 = liste +private reduce377 = liste ; -private reduce374 = (const . single) +private reduce378 = (const . single) ; -private reduce375 = \a\qs\_\x -> (yyline a, qs, x) +private reduce379 = \a\qs\_\x -> (yyline a, qs, x) ; -private reduce376 = single +private reduce380 = single ; -private reduce377 = (:) +private reduce381 = (:) ; -private reduce378 = \p\a\e -> +private reduce382 = \p\a\e -> CAlt {pat=p, ex=e} ; -private reduce379 = \p\gs -> guardedalt p gs +private reduce383 = \p\gs -> guardedalt p gs ; -private reduce380 = \(calt::CAltS)\defs -> +private reduce384 = \(calt::CAltS)\defs -> let nx = Let defs calt.ex; in calt.{ ex = nx } ; -private reduce381 = single +private reduce385 = single ; -private reduce382 = liste +private reduce386 = liste ; -private reduce383 = \a\_ -> [a] +private reduce387 = \a\_ -> [a] ; -private reduce384 = \_\ps\b -> foldr (\p\x -> Lam p x false) b ps +private reduce388 = \_\ps\b -> foldr (\p\x -> Lam p x false) b ps ; -private reduce386 = \_\x -> x +private reduce390 = \_\x -> x ; -private reduce387 = \x\_\t -> Ann {ex = x, typ=t} +private reduce391 = \x\_\t -> Ann {ex = x, typ=t} ; -private reduce389 = flip const +private reduce393 = flip const ; -private reduce391 = flip const +private reduce395 = flip const ; -private reduce393 = mkapp +private reduce397 = mkapp ; -private reduce394 = mkapp +private reduce398 = mkapp ; -private reduce395 = \m\x -> nApp (Vbl (contextName m "negate")) x +private reduce399 = \m\x -> nApp (Vbl (contextName m "negate")) x ; -private reduce397 = \_\c\_\t\_\e -> Ifte c t e +private reduce401 = \_\c\_\t\_\e -> Ifte c t e ; -private reduce398 = \_\e\_\_\as\_ -> Case CNormal e as +private reduce402 = \_\e\_\_\as\_ -> Case CNormal e as ; -private reduce399 = \_\_\ds\_\_\e -> Let ds e +private reduce403 = \_\_\ds\_\_\e -> Let ds e ; -private reduce401 = underscore +private reduce405 = underscore ; -private reduce403 = nApp +private reduce407 = nApp ; -private reduce405 = \u\p -> nApp (Vbl {name=Simple u}) p +private reduce409 = \u\p -> nApp (Vbl {name=Simple u}) p ; -private reduce406 = single +private reduce410 = single ; -private reduce407 = (:) +private reduce411 = (:) ; -private reduce408 = With1 +private reduce412 = With1 ; -private reduce409 = With2 +private reduce413 = With2 ; -private reduce411 = \d\_\defs\_ -> do mkMonad (yyline d) defs +private reduce415 = \d\_\defs\_ -> do mkMonad (yyline d) defs ; -private reduce412 = \p\_\(v::Token) -> umem p v id +private reduce416 = \p\_\(v::Token) -> umem p v id ; -private reduce413 = \p\_\v -> do {v <- unqualified v; +private reduce417 = \p\_\v -> do {v <- unqualified v; YYM.pure (umem p v id)} ; -private reduce414 = \p\_\v -> umem p v id +private reduce418 = \p\_\v -> umem p v id ; -private reduce415 = \q\_\(v::Token)\_\_ -> +private reduce419 = \q\_\(v::Token)\_\_ -> Vbl (q v.{value <- ("has$" ++)}) ; -private reduce416 = \q\_\(v::Token)\_\_ -> +private reduce420 = \q\_\(v::Token)\_\_ -> Vbl (q v.{value <- ("upd$" ++)}) ; -private reduce417 = \q\_\(v::Token)\_\_ -> +private reduce421 = \q\_\(v::Token)\_\_ -> Vbl (q v.{value <- ("chg$" ++)}) ; -private reduce418 = \q\(p::Token)\fs\_ -> let { +private reduce422 = \q\(p::Token)\fs\_ -> let { -- n = Simple q; flp = Vbl (wellKnown p "flip"); bul = Vbl (contextName p "•"); @@ -6418,63 +6507,63 @@ private reduce418 = \q\(p::Token)\fs\_ -> let { chup (r, false, e) = flp `nApp` Vbl (q r.{value <- ("upd$"++)}) `nApp` e; }} in c fs ; -private reduce419 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("has$"++)} id +private reduce423 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("has$"++)} id ; -private reduce420 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("upd$"++)} id +private reduce424 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("upd$"++)} id ; -private reduce421 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("chg$"++)} id +private reduce425 = \p\_\_\(v::Token)\_\_ -> umem p v.{value <- ("chg$"++)} id ; -private reduce422 = \x\(p::Token)\_\fs\_ -> +private reduce426 = \x\(p::Token)\_\fs\_ -> let { u x [] = x; u x ((r::Token, true , e):xs) = u (umem x r.{value <- ("chg$" ++)} (`nApp` e)) xs; u x ((r::Token, false, e):xs) = u (umem x r.{value <- ("upd$" ++)} (`nApp` e)) xs; } in u x fs ; -private reduce423 = \p\t\_\v\_ -> +private reduce427 = \p\t\_\v\_ -> let elem = t.{tokid = VARID, value = "elemAt"} in Vbl {name=Simple elem} `nApp` p `nApp` v ; -private reduce424 = \x -> Vbl {name=x} +private reduce428 = \x -> Vbl {name=x} ; -private reduce426 = \t -> Vbl {name = Simple t.{tokid=VARID, value="_"}} +private reduce430 = \t -> Vbl {name = Simple t.{tokid=VARID, value="_"}} ; -private reduce427 = \qc -> Con {name=qc} +private reduce431 = \qc -> Con {name=qc} ; -private reduce428 = \qc\_\z -> ConFS {name=qc, fields=[]} +private reduce432 = \qc\_\z -> ConFS {name=qc, fields=[]} ; -private reduce429 = \qc\_\fs\z -> ConFS {name=qc, fields=fs} +private reduce433 = \qc\_\fs\z -> ConFS {name=qc, fields=fs} ; -private reduce430 = \z\_ -> Con (fromBase z.{tokid=CONID, value="()"}) +private reduce434 = \z\_ -> Con (fromBase z.{tokid=CONID, value="()"}) ; -private reduce431 = \z\n\_ -> Con (fromBase z.{tokid=CONID, value=tuple (n+1)}) +private reduce435 = \z\n\_ -> Con (fromBase z.{tokid=CONID, value=tuple (n+1)}) ; -private reduce432 = \_\x\_ -> Vbl {name=Simple x} +private reduce436 = \_\x\_ -> Vbl {name=Simple x} ; -private reduce433 = \a\o\z -> Enclosed{firstT=a, lastT=z, ex=(varcon o) (opSname o)} +private reduce437 = \a\o\z -> Enclosed{firstT=a, lastT=z, ex=(varcon o) (opSname o)} ; -private reduce434 = \_\m\_ -> (Vbl (fromBase m)) +private reduce438 = \_\m\_ -> (Vbl (fromBase m)) ; -private reduce435 = \z\o\x\_ -> let -- (+1) --> flip (+) 1 +private reduce439 = \z\o\x\_ -> let -- (+1) --> flip (+) 1 flp = Vbl (contextName z "flip") op = (varcon o) (opSname o) ex = nApp (nApp flp op) x in ex ; -private reduce436 = \_\x\o\_ -> -- (1+) --> (+) 1 +private reduce440 = \_\x\o\_ -> -- (1+) --> (+) 1 nApp ((varcon o) (opSname o)) x ; -private reduce437 = \_\x\o\_ -> -- (1+) --> (+) 1 +private reduce441 = \_\x\o\_ -> -- (1+) --> (+) 1 nApp ((varcon o) (Simple o)) x ; -private reduce438 = \a\e\x\es\_ -> fold nApp (Con +private reduce442 = \a\e\x\es\_ -> fold nApp (Con (fromBase x.{tokid=CONID, value=tuple (1+length es)}) ) (e:es) ; -private reduce439 = \a\e\(x::Token)\es\_ -> do +private reduce443 = \a\e\(x::Token)\es\_ -> do g <- getST E.warn (yyline x) (PP.text "strict tuples are deprecated, use ',' to separate elements") pure ( @@ -6486,32 +6575,32 @@ private reduce439 = \a\e\(x::Token)\es\_ -> do ) ; -private reduce440 = \_\x\_ -> Term x +private reduce444 = \_\x\_ -> Term x ; -private reduce441 = \a\z -> Con (fromBase z.{tokid=CONID, value="[]"}) +private reduce445 = \a\z -> Con (fromBase z.{tokid=CONID, value="[]"}) ; -private reduce442 = \b\es\z -> +private reduce446 = \b\es\z -> foldr (\a\as -> nApp (nApp (Con (fromBase b.{tokid=CONID, value=":"})) a) as) (Con (fromBase z.{tokid=CONID, value="[]"})) es ; -private reduce443 = \a\b\c\d -> do mkEnumFrom a b c d +private reduce447 = \a\b\c\d -> do mkEnumFrom a b c d ; -private reduce444 = \a\b\c\d\e -> do mkEnumFromTo a b c d e +private reduce448 = \a\b\c\d\e -> do mkEnumFromTo a b c d e ; -private reduce445 = \(a::Token)\e\b\qs\(z::Token) -> do { +private reduce449 = \(a::Token)\e\b\qs\(z::Token) -> do { let {nil = z.{tokid=CONID, value="[]"}}; listComprehension (yyline b) e qs (Con {name = fromBase nil}) } ; -private reduce446 = const 1 +private reduce450 = const 1 ; -private reduce447 = ((+) . const 1) +private reduce451 = ((+) . const 1) ; -private reduce448 = single +private reduce452 = single ; -private reduce449 = \a\c\ls -> +private reduce453 = \a\c\ls -> if elemBy (using fst) a ls then do { E.warn (yyline c) (msgdoc ("field `" ++ fst a ++ "` should appear only once.")); @@ -6520,35 +6609,35 @@ private reduce449 = \a\c\ls -> YYM.pure (a:ls) ; -private reduce450 = (const . single) +private reduce454 = (const . single) ; -private reduce451 = single +private reduce455 = single ; -private reduce452 = liste +private reduce456 = liste ; -private reduce453 = (const . single) +private reduce457 = (const . single) ; -private reduce454 = \s\_\x -> (s, true, x) +private reduce458 = \s\_\x -> (s, true, x) ; -private reduce455 = \s\_\x -> (s, false, x) +private reduce459 = \s\_\x -> (s, false, x) ; -private reduce456 = \s -> (s, false, Vbl (Simple s)) +private reduce460 = \s -> (s, false, Vbl (Simple s)) ; -private reduce457 = \s\_\x -> (Token.value s, x) +private reduce461 = \s\_\x -> (Token.value s, x) ; -private reduce458 = \s -> (s.value, Vbl (Simple s)) +private reduce462 = \s -> (s.value, Vbl (Simple s)) ; -private reduce459 = single +private reduce463 = single ; -private reduce460 = liste +private reduce464 = liste ; -private reduce461 = (const . single) +private reduce465 = (const . single) ; -private reduce462 = single +private reduce466 = single ; -private reduce463 = liste +private reduce467 = liste ; -private reduce464 = (const . single) +private reduce468 = (const . single) ; yyrule 1 = "module: docsO moduleclause ';' definitions"; yyrule 2 = "module: docsO moduleclause WHERE '{' definitions '}'"; @@ -6666,354 +6755,358 @@ yyrule 113 = "jtokens: '{' '}' jtokens"; yyrule 114 = "documentation: DOCUMENTATION"; yyrule 115 = "publicdefinition: typedef"; yyrule 116 = "publicdefinition: datadef"; -yyrule 117 = "publicdefinition: classdef"; -yyrule 118 = "publicdefinition: instdef"; -yyrule 119 = "publicdefinition: derivedef"; -yyrule 120 = "publicdefinition: localdef"; -yyrule 121 = "localdefs: dplocaldef"; -yyrule 122 = "localdefs: dplocaldef ';'"; -yyrule 123 = "localdefs: dplocaldef ';' localdefs"; -yyrule 124 = "localdef: annotation"; -yyrule 125 = "localdef: nativedef"; -yyrule 126 = "localdef: fundef"; -yyrule 127 = "plocaldef: localdef"; -yyrule 128 = "plocaldef: PRIVATE localdef"; -yyrule 129 = "plocaldef: PROTECTED localdef"; -yyrule 130 = "plocaldef: PUBLIC localdef"; -yyrule 131 = "dplocaldef: documentation"; -yyrule 132 = "dplocaldef: documentation dplocaldef"; -yyrule 133 = "dplocaldef: plocaldef"; -yyrule 134 = "letdef: annotation"; -yyrule 135 = "letdef: fundef"; -yyrule 136 = "letdefs: letdef"; -yyrule 137 = "letdefs: letdef ';'"; -yyrule 138 = "letdefs: letdef ';' letdefs"; -yyrule 139 = "import: IMPORT modulename importliste"; -yyrule 140 = "import: IMPORT modulename VARID CONID importliste"; -yyrule 141 = "import: IMPORT modulename CONID importliste"; -yyrule 142 = "importliste: "; -yyrule 143 = "importliste: varid '(' importspecs ')'"; -yyrule 144 = "importliste: '(' ')'"; -yyrule 145 = "importliste: '(' importspecs ')'"; -yyrule 146 = "importliste: PUBLIC importliste"; -yyrule 147 = "importspecs: importspec"; -yyrule 148 = "importspecs: importspec ','"; -yyrule 149 = "importspecs: importspec ',' importspecs"; -yyrule 150 = "importitem: qvarid"; -yyrule 151 = "importitem: CONID '(' memspecs ')'"; -yyrule 152 = "importitem: CONID '(' ')'"; -yyrule 153 = "importitem: qconid"; -yyrule 154 = "importitem: operator"; -yyrule 155 = "importitem: unop"; -yyrule 156 = "importspec: importitem"; -yyrule 157 = "importspec: importitem alias"; -yyrule 158 = "importspec: PUBLIC importspec"; -yyrule 159 = "memspec: alias"; -yyrule 160 = "memspec: alias alias"; -yyrule 161 = "memspec: PUBLIC memspec"; -yyrule 162 = "memspecs: memspec"; -yyrule 163 = "memspecs: memspec ','"; -yyrule 164 = "memspecs: memspec ',' memspecs"; -yyrule 165 = "alias: VARID"; -yyrule 166 = "alias: CONID"; -yyrule 167 = "alias: operator"; -yyrule 168 = "varid: VARID"; -yyrule 169 = "varidkw: VARID"; -yyrule 170 = "varidkw: DATA"; -yyrule 171 = "varidkw: TYPE"; -yyrule 172 = "varidkw: NATIVE"; -yyrule 173 = "varidkw: PURE"; -yyrule 174 = "varidkw: PACKAGE"; -yyrule 175 = "varidkw: IMPORT"; -yyrule 176 = "qvarids: qvarop"; -yyrule 177 = "qvarids: qvarop ',' qvarids"; -yyrule 178 = "qvarid: QUALIFIER QUALIFIER varop"; -yyrule 179 = "qvarid: QUALIFIER varop"; -yyrule 180 = "qvarid: VARID"; -yyrule 181 = "qconid: QUALIFIER QUALIFIER CONID"; -yyrule 182 = "qconid: QUALIFIER CONID"; -yyrule 183 = "qconid: CONID"; -yyrule 184 = "varop: VARID"; -yyrule 185 = "varop: unop"; -yyrule 186 = "qvarop: QUALIFIER QUALIFIER varop"; -yyrule 187 = "qvarop: QUALIFIER varop"; -yyrule 188 = "qvarop: varop"; -yyrule 189 = "qvarop: operator"; -yyrule 190 = "operator: SOMEOP"; -yyrule 191 = "unop: '!'"; -yyrule 192 = "unop: '?'"; -yyrule 193 = "fixity: INFIX INTCONST"; -yyrule 194 = "fixity: INFIXL INTCONST"; -yyrule 195 = "fixity: INFIXR INTCONST"; -yyrule 196 = "opstring: operator"; -yyrule 197 = "opstring: VARID"; -yyrule 198 = "opstring: '-'"; -yyrule 199 = "operators: opstring"; -yyrule 200 = "operators: opstring operators"; -yyrule 201 = "infix: fixity operators"; -yyrule 202 = "annotation: annoitems DCOLON sigma"; -yyrule 203 = "annoitem: varid"; -yyrule 204 = "annoitem: '(' operator ')'"; -yyrule 205 = "annoitem: '(' unop ')'"; -yyrule 206 = "annoitem: '(' '-' ')'"; -yyrule 207 = "annoitems: annoitem"; -yyrule 208 = "annoitems: annoitem ',' annoitems"; -yyrule 209 = "nativedef: PURE impurenativedef"; -yyrule 210 = "nativedef: impurenativedef"; -yyrule 211 = "fitem: annoitem"; -yyrule 212 = "fitem: unop"; -yyrule 213 = "fitem: '-'"; -yyrule 214 = "fitem: operator"; -yyrule 215 = "jitem: nativename"; -yyrule 216 = "jitem: operator"; -yyrule 217 = "jitem: unop"; -yyrule 218 = "methodspec: fitem jitem gargs"; -yyrule 219 = "methodspec: fitem jitem"; -yyrule 220 = "methodspec: fitem gargs"; -yyrule 221 = "methodspec: fitem"; -yyrule 222 = "sigex: sigma THROWS tauSC"; -yyrule 223 = "sigex: sigma"; -yyrule 224 = "sigexs: sigex"; -yyrule 225 = "sigexs: sigex '|' sigexs"; -yyrule 226 = "impurenativedef: NATIVE methodspec DCOLON sigexs"; -yyrule 227 = "sigma: forall"; -yyrule 228 = "sigma: rho"; -yyrule 229 = "forall: FORALL dvars mbdot rho"; -yyrule 230 = "mbdot: '.'"; -yyrule 231 = "mbdot: SOMEOP"; -yyrule 232 = "rho: tapp EARROW rhofun"; -yyrule 233 = "rho: rhofun"; -yyrule 234 = "rhofun: tapp"; -yyrule 235 = "rhofun: tapp ARROW rhofun"; -yyrule 236 = "tau: tapp"; -yyrule 237 = "tau: forall"; -yyrule 238 = "tau: tapp ARROW tau"; -yyrule 239 = "tauSC: tau"; -yyrule 240 = "tauSC: tau ',' tauSC"; -yyrule 241 = "tauSB: tau"; -yyrule 242 = "tauSB: tau '|' tauSB"; -yyrule 243 = "tapp: simpletypes"; -yyrule 244 = "simpletype: tyvar"; -yyrule 245 = "simpletype: tyname"; -yyrule 246 = "simpletype: '(' tau ')'"; -yyrule 247 = "simpletype: '(' tau ',' tauSC ')'"; -yyrule 248 = "simpletype: '(' tau '|' tauSB ')'"; -yyrule 249 = "simpletype: '[' tau ']'"; -yyrule 250 = "tyvar: VARID"; -yyrule 251 = "tyvar: '(' VARID DCOLON kind ')'"; -yyrule 252 = "tyvar: '(' VARID EXTENDS tauSC ')'"; -yyrule 253 = "tyvar: '(' EXTENDS tauSC ')'"; -yyrule 254 = "tyvar: '(' SUPER tapp ')'"; -yyrule 255 = "tyname: qconid"; -yyrule 256 = "tyname: '[' ']'"; -yyrule 257 = "tyname: '(' ')'"; -yyrule 258 = "tyname: '(' commata ')'"; -yyrule 259 = "tyname: '(' ARROW ')'"; -yyrule 260 = "kind: simplekind ARROW kind"; -yyrule 261 = "kind: simplekind"; -yyrule 262 = "simplekind: SOMEOP"; -yyrule 263 = "simplekind: '(' kind ')'"; -yyrule 264 = "scontext: qconid tyvar"; -yyrule 265 = "scontexts: scontext"; -yyrule 266 = "scontexts: scontext ','"; -yyrule 267 = "scontexts: scontext ',' scontexts"; -yyrule 268 = "ccontext: scontext"; -yyrule 269 = "ccontext: '(' scontexts ')'"; -yyrule 270 = "classdef: CLASS ccontext EARROW CONID tyvar wheredef"; -yyrule 271 = "classdef: CLASS ccontext wheredef"; -yyrule 272 = "sicontext: qconid simpletype"; -yyrule 273 = "sicontexts: sicontext"; -yyrule 274 = "sicontexts: sicontext ','"; -yyrule 275 = "sicontexts: sicontext ',' sicontexts"; -yyrule 276 = "icontext: sicontext"; -yyrule 277 = "icontext: '(' sicontexts ')'"; -yyrule 278 = "insthead: icontext EARROW tyname simpletype"; -yyrule 279 = "insthead: icontext"; -yyrule 280 = "instdef: INSTANCE insthead wheredef"; -yyrule 281 = "derivedef: DERIVE insthead"; -yyrule 282 = "datadef: datainit wheredef"; -yyrule 283 = "nativepur: PURE NATIVE"; -yyrule 284 = "nativepur: NATIVE"; -yyrule 285 = "nativespec: nativename"; -yyrule 286 = "nativespec: nativename gargs"; -yyrule 287 = "gargs: '{' tauSC '}'"; -yyrule 288 = "gargs: '{' '}'"; -yyrule 289 = "datainit: DATA CONID '=' nativepur nativespec"; -yyrule 290 = "datainit: DATA CONID dvars '=' nativepur nativespec"; -yyrule 291 = "datainit: DATA CONID dvars '=' dalts"; -yyrule 292 = "datainit: DATA CONID '=' dalts"; -yyrule 293 = "datainit: DATA CONID"; -yyrule 294 = "datainit: NEWTYPE CONID dvars '=' dalt"; -yyrule 295 = "datainit: NEWTYPE CONID '=' dalt"; -yyrule 296 = "dvars: tyvar"; -yyrule 297 = "dvars: tyvar dvars"; -yyrule 298 = "dalts: dalt"; -yyrule 299 = "dalts: dalt '|' dalts"; -yyrule 300 = "dalt: visdalt"; -yyrule 301 = "dalt: visdalt DOCUMENTATION"; -yyrule 302 = "dalt: DOCUMENTATION visdalt"; -yyrule 303 = "visdalt: strictdalt"; -yyrule 304 = "visdalt: PUBLIC strictdalt"; -yyrule 305 = "visdalt: PRIVATE strictdalt"; -yyrule 306 = "visdalt: PROTECTED strictdalt"; -yyrule 307 = "strictdalt: '!' simpledalt"; -yyrule 308 = "strictdalt: '?' simpledalt"; -yyrule 309 = "strictdalt: simpledalt"; -yyrule 310 = "simpledalt: CONID"; -yyrule 311 = "simpledalt: CONID '{' conflds '}'"; -yyrule 312 = "simpledalt: CONID contypes"; -yyrule 313 = "contypes: strictcontype"; -yyrule 314 = "contypes: strictcontype contypes"; -yyrule 315 = "strictcontype: contype"; -yyrule 316 = "strictcontype: '!' contype"; -yyrule 317 = "strictcontype: '?' contype"; -yyrule 318 = "contype: simpletype"; -yyrule 319 = "simpletypes: simpletype"; -yyrule 320 = "simpletypes: simpletype simpletypes"; -yyrule 321 = "conflds: confld"; -yyrule 322 = "conflds: confld ','"; -yyrule 323 = "conflds: confld DOCUMENTATION"; -yyrule 324 = "conflds: confld ',' conflds"; -yyrule 325 = "conflds: confld DOCUMENTATION conflds"; -yyrule 326 = "confld: docsO fldids DCOLON sigma"; -yyrule 327 = "fldids: fldid"; -yyrule 328 = "fldids: fldid ',' fldids"; -yyrule 329 = "fldid: strictfldid"; -yyrule 330 = "fldid: PUBLIC strictfldid"; -yyrule 331 = "fldid: PRIVATE strictfldid"; -yyrule 332 = "strictfldid: plainfldid"; -yyrule 333 = "strictfldid: '!' plainfldid"; -yyrule 334 = "strictfldid: '?' plainfldid"; -yyrule 335 = "plainfldid: varid"; -yyrule 336 = "typedef: TYPE CONID '=' sigma"; -yyrule 337 = "typedef: TYPE CONID dvars '=' sigma"; -yyrule 338 = "wheredef: "; -yyrule 339 = "wheredef: WHERE '{' '}'"; -yyrule 340 = "wheredef: WHERE '{' localdefs '}'"; -yyrule 341 = "wherelet: WHERE '{' '}'"; -yyrule 342 = "wherelet: WHERE '{' letdefs '}'"; -yyrule 343 = "fundef: funhead '=' expr"; -yyrule 344 = "fundef: funhead guards"; -yyrule 345 = "fundef: fundef wherelet"; -yyrule 346 = "funhead: binex"; -yyrule 347 = "literal: TRUE"; -yyrule 348 = "literal: FALSE"; -yyrule 349 = "literal: CHRCONST"; -yyrule 350 = "literal: STRCONST"; -yyrule 351 = "literal: INTCONST"; -yyrule 352 = "literal: BIGCONST"; -yyrule 353 = "literal: LONGCONST"; -yyrule 354 = "literal: FLTCONST"; -yyrule 355 = "literal: DBLCONST"; -yyrule 356 = "literal: DECCONST"; -yyrule 357 = "literal: REGEXP"; -yyrule 358 = "pattern: expr"; -yyrule 359 = "aeq: ARROW"; -yyrule 360 = "aeq: '='"; -yyrule 361 = "lcqual: gqual"; -yyrule 362 = "lcqual: expr '=' expr"; -yyrule 363 = "lcqual: LET '{' letdefs '}'"; -yyrule 364 = "lcquals: lcqual"; -yyrule 365 = "lcquals: lcqual ',' lcquals"; -yyrule 366 = "lcquals: lcqual ','"; -yyrule 367 = "dodefs: lcqual"; -yyrule 368 = "dodefs: lcqual ';'"; -yyrule 369 = "dodefs: lcqual ';' dodefs"; -yyrule 370 = "gqual: expr"; -yyrule 371 = "gqual: expr GETS expr"; -yyrule 372 = "gquals: gqual"; -yyrule 373 = "gquals: gqual ',' gquals"; -yyrule 374 = "gquals: gqual ','"; -yyrule 375 = "guard: '|' gquals aeq expr"; -yyrule 376 = "guards: guard"; -yyrule 377 = "guards: guard guards"; -yyrule 378 = "calt: pattern aeq expr"; -yyrule 379 = "calt: pattern guards"; -yyrule 380 = "calt: calt wherelet"; -yyrule 381 = "calts: calt"; -yyrule 382 = "calts: calt ';' calts"; -yyrule 383 = "calts: calt ';'"; -yyrule 384 = "lambda: '\\' apats lambdabody"; -yyrule 385 = "lambdabody: lambda"; -yyrule 386 = "lambdabody: ARROW expr"; -yyrule 387 = "expr: binex DCOLON sigma"; -yyrule 388 = "expr: binex"; -yyrule 389 = "thenx: ';' THEN"; -yyrule 390 = "thenx: THEN"; -yyrule 391 = "elsex: ';' ELSE"; -yyrule 392 = "elsex: ELSE"; -yyrule 393 = "binex: binex SOMEOP binex"; -yyrule 394 = "binex: binex '-' binex"; -yyrule 395 = "binex: '-' topex"; -yyrule 396 = "binex: topex"; -yyrule 397 = "topex: IF expr thenx expr elsex expr"; -yyrule 398 = "topex: CASE expr OF '{' calts '}'"; -yyrule 399 = "topex: LET '{' letdefs '}' IN expr"; -yyrule 400 = "topex: lambda"; -yyrule 401 = "topex: appex"; -yyrule 402 = "appex: unex"; -yyrule 403 = "appex: appex unex"; -yyrule 404 = "unex: primary"; -yyrule 405 = "unex: unop unex"; -yyrule 406 = "apats: unex"; -yyrule 407 = "apats: unex apats"; -yyrule 408 = "qualifiers: QUALIFIER"; -yyrule 409 = "qualifiers: QUALIFIER QUALIFIER"; -yyrule 410 = "primary: term"; -yyrule 411 = "primary: DO '{' dodefs '}'"; -yyrule 412 = "primary: primary '.' VARID"; -yyrule 413 = "primary: primary '.' operator"; -yyrule 414 = "primary: primary '.' unop"; -yyrule 415 = "primary: qualifiers '{' VARID '?' '}'"; -yyrule 416 = "primary: qualifiers '{' VARID '=' '}'"; -yyrule 417 = "primary: qualifiers '{' VARID GETS '}'"; -yyrule 418 = "primary: qualifiers '{' getfields '}'"; -yyrule 419 = "primary: primary '.' '{' VARID '?' '}'"; -yyrule 420 = "primary: primary '.' '{' VARID '=' '}'"; -yyrule 421 = "primary: primary '.' '{' VARID GETS '}'"; -yyrule 422 = "primary: primary '.' '{' getfields '}'"; -yyrule 423 = "primary: primary '.' '[' expr ']'"; -yyrule 424 = "term: qvarid"; -yyrule 425 = "term: literal"; -yyrule 426 = "term: '_'"; -yyrule 427 = "term: qconid"; -yyrule 428 = "term: qconid '{' '}'"; -yyrule 429 = "term: qconid '{' fields '}'"; -yyrule 430 = "term: '(' ')'"; -yyrule 431 = "term: '(' commata ')'"; -yyrule 432 = "term: '(' unop ')'"; -yyrule 433 = "term: '(' operator ')'"; -yyrule 434 = "term: '(' '-' ')'"; -yyrule 435 = "term: '(' operator expr ')'"; -yyrule 436 = "term: '(' binex operator ')'"; -yyrule 437 = "term: '(' binex '-' ')'"; -yyrule 438 = "term: '(' expr ',' exprSC ')'"; -yyrule 439 = "term: '(' expr ';' exprSS ')'"; -yyrule 440 = "term: '(' expr ')'"; -yyrule 441 = "term: '[' ']'"; -yyrule 442 = "term: '[' exprSC ']'"; -yyrule 443 = "term: '[' exprSC DOTDOT ']'"; -yyrule 444 = "term: '[' exprSC DOTDOT expr ']'"; -yyrule 445 = "term: '[' expr '|' lcquals ']'"; -yyrule 446 = "commata: ','"; -yyrule 447 = "commata: ',' commata"; -yyrule 448 = "fields: field"; -yyrule 449 = "fields: field ',' fields"; -yyrule 450 = "fields: field ','"; -yyrule 451 = "getfields: getfield"; -yyrule 452 = "getfields: getfield ',' getfields"; -yyrule 453 = "getfields: getfield ','"; -yyrule 454 = "getfield: VARID GETS expr"; -yyrule 455 = "getfield: VARID '=' expr"; -yyrule 456 = "getfield: VARID"; -yyrule 457 = "field: varid '=' expr"; -yyrule 458 = "field: varid"; -yyrule 459 = "exprSC: expr"; -yyrule 460 = "exprSC: expr ',' exprSC"; -yyrule 461 = "exprSC: expr ','"; -yyrule 462 = "exprSS: expr"; -yyrule 463 = "exprSS: expr ';' exprSS"; -yyrule 464 = "exprSS: expr ';'"; +yyrule 117 = "publicdefinition: datajavadef"; +yyrule 118 = "publicdefinition: classdef"; +yyrule 119 = "publicdefinition: instdef"; +yyrule 120 = "publicdefinition: derivedef"; +yyrule 121 = "publicdefinition: localdef"; +yyrule 122 = "localdefs: dplocaldef"; +yyrule 123 = "localdefs: dplocaldef ';'"; +yyrule 124 = "localdefs: dplocaldef ';' localdefs"; +yyrule 125 = "localdef: annotation"; +yyrule 126 = "localdef: nativedef"; +yyrule 127 = "localdef: fundef"; +yyrule 128 = "plocaldef: localdef"; +yyrule 129 = "plocaldef: PRIVATE localdef"; +yyrule 130 = "plocaldef: PROTECTED localdef"; +yyrule 131 = "plocaldef: PUBLIC localdef"; +yyrule 132 = "dplocaldef: documentation"; +yyrule 133 = "dplocaldef: documentation dplocaldef"; +yyrule 134 = "dplocaldef: plocaldef"; +yyrule 135 = "letdef: annotation"; +yyrule 136 = "letdef: fundef"; +yyrule 137 = "letdefs: letdef"; +yyrule 138 = "letdefs: letdef ';'"; +yyrule 139 = "letdefs: letdef ';' letdefs"; +yyrule 140 = "import: IMPORT modulename importliste"; +yyrule 141 = "import: IMPORT modulename VARID CONID importliste"; +yyrule 142 = "import: IMPORT modulename CONID importliste"; +yyrule 143 = "importliste: "; +yyrule 144 = "importliste: varid '(' importspecs ')'"; +yyrule 145 = "importliste: '(' ')'"; +yyrule 146 = "importliste: '(' importspecs ')'"; +yyrule 147 = "importliste: PUBLIC importliste"; +yyrule 148 = "importspecs: importspec"; +yyrule 149 = "importspecs: importspec ','"; +yyrule 150 = "importspecs: importspec ',' importspecs"; +yyrule 151 = "importitem: qvarid"; +yyrule 152 = "importitem: CONID '(' memspecs ')'"; +yyrule 153 = "importitem: CONID '(' ')'"; +yyrule 154 = "importitem: qconid"; +yyrule 155 = "importitem: operator"; +yyrule 156 = "importitem: unop"; +yyrule 157 = "importspec: importitem"; +yyrule 158 = "importspec: importitem alias"; +yyrule 159 = "importspec: PUBLIC importspec"; +yyrule 160 = "memspec: alias"; +yyrule 161 = "memspec: alias alias"; +yyrule 162 = "memspec: PUBLIC memspec"; +yyrule 163 = "memspecs: memspec"; +yyrule 164 = "memspecs: memspec ','"; +yyrule 165 = "memspecs: memspec ',' memspecs"; +yyrule 166 = "alias: VARID"; +yyrule 167 = "alias: CONID"; +yyrule 168 = "alias: operator"; +yyrule 169 = "varid: VARID"; +yyrule 170 = "varidkw: VARID"; +yyrule 171 = "varidkw: DATA"; +yyrule 172 = "varidkw: TYPE"; +yyrule 173 = "varidkw: NATIVE"; +yyrule 174 = "varidkw: PURE"; +yyrule 175 = "varidkw: PACKAGE"; +yyrule 176 = "varidkw: IMPORT"; +yyrule 177 = "qvarids: qvarop"; +yyrule 178 = "qvarids: qvarop ',' qvarids"; +yyrule 179 = "qvarid: QUALIFIER QUALIFIER varop"; +yyrule 180 = "qvarid: QUALIFIER varop"; +yyrule 181 = "qvarid: VARID"; +yyrule 182 = "qconid: QUALIFIER QUALIFIER CONID"; +yyrule 183 = "qconid: QUALIFIER CONID"; +yyrule 184 = "qconid: CONID"; +yyrule 185 = "varop: VARID"; +yyrule 186 = "varop: unop"; +yyrule 187 = "qvarop: QUALIFIER QUALIFIER varop"; +yyrule 188 = "qvarop: QUALIFIER varop"; +yyrule 189 = "qvarop: varop"; +yyrule 190 = "qvarop: operator"; +yyrule 191 = "operator: SOMEOP"; +yyrule 192 = "unop: '!'"; +yyrule 193 = "unop: '?'"; +yyrule 194 = "fixity: INFIX INTCONST"; +yyrule 195 = "fixity: INFIXL INTCONST"; +yyrule 196 = "fixity: INFIXR INTCONST"; +yyrule 197 = "opstring: operator"; +yyrule 198 = "opstring: VARID"; +yyrule 199 = "opstring: '-'"; +yyrule 200 = "operators: opstring"; +yyrule 201 = "operators: opstring operators"; +yyrule 202 = "infix: fixity operators"; +yyrule 203 = "annotation: annoitems DCOLON sigma"; +yyrule 204 = "annoitem: varid"; +yyrule 205 = "annoitem: '(' operator ')'"; +yyrule 206 = "annoitem: '(' unop ')'"; +yyrule 207 = "annoitem: '(' '-' ')'"; +yyrule 208 = "annoitems: annoitem"; +yyrule 209 = "annoitems: annoitem ',' annoitems"; +yyrule 210 = "nativedef: PURE impurenativedef"; +yyrule 211 = "nativedef: impurenativedef"; +yyrule 212 = "fitem: annoitem"; +yyrule 213 = "fitem: unop"; +yyrule 214 = "fitem: '-'"; +yyrule 215 = "fitem: operator"; +yyrule 216 = "jitem: nativename"; +yyrule 217 = "jitem: operator"; +yyrule 218 = "jitem: unop"; +yyrule 219 = "methodspec: fitem jitem gargs"; +yyrule 220 = "methodspec: fitem jitem"; +yyrule 221 = "methodspec: fitem gargs"; +yyrule 222 = "methodspec: fitem"; +yyrule 223 = "sigex: sigma THROWS tauSC"; +yyrule 224 = "sigex: sigma"; +yyrule 225 = "sigexs: sigex"; +yyrule 226 = "sigexs: sigex '|' sigexs"; +yyrule 227 = "impurenativedef: NATIVE methodspec DCOLON sigexs"; +yyrule 228 = "sigma: forall"; +yyrule 229 = "sigma: rho"; +yyrule 230 = "forall: FORALL dvars mbdot rho"; +yyrule 231 = "mbdot: '.'"; +yyrule 232 = "mbdot: SOMEOP"; +yyrule 233 = "rho: tapp EARROW rhofun"; +yyrule 234 = "rho: rhofun"; +yyrule 235 = "rhofun: tapp"; +yyrule 236 = "rhofun: tapp ARROW rhofun"; +yyrule 237 = "tau: tapp"; +yyrule 238 = "tau: forall"; +yyrule 239 = "tau: tapp ARROW tau"; +yyrule 240 = "tauSC: tau"; +yyrule 241 = "tauSC: tau ',' tauSC"; +yyrule 242 = "tauSB: tau"; +yyrule 243 = "tauSB: tau '|' tauSB"; +yyrule 244 = "tapp: simpletypes"; +yyrule 245 = "simpletype: tyvar"; +yyrule 246 = "simpletype: tyname"; +yyrule 247 = "simpletype: '(' tau ')'"; +yyrule 248 = "simpletype: '(' tau ',' tauSC ')'"; +yyrule 249 = "simpletype: '(' tau '|' tauSB ')'"; +yyrule 250 = "simpletype: '[' tau ']'"; +yyrule 251 = "tyvar: VARID"; +yyrule 252 = "tyvar: '(' VARID DCOLON kind ')'"; +yyrule 253 = "tyvar: '(' VARID EXTENDS tauSC ')'"; +yyrule 254 = "tyvar: '(' EXTENDS tauSC ')'"; +yyrule 255 = "tyvar: '(' SUPER tapp ')'"; +yyrule 256 = "tyname: qconid"; +yyrule 257 = "tyname: '[' ']'"; +yyrule 258 = "tyname: '(' ')'"; +yyrule 259 = "tyname: '(' commata ')'"; +yyrule 260 = "tyname: '(' ARROW ')'"; +yyrule 261 = "kind: simplekind ARROW kind"; +yyrule 262 = "kind: simplekind"; +yyrule 263 = "simplekind: SOMEOP"; +yyrule 264 = "simplekind: '(' kind ')'"; +yyrule 265 = "scontext: qconid tyvar"; +yyrule 266 = "scontexts: scontext"; +yyrule 267 = "scontexts: scontext ','"; +yyrule 268 = "scontexts: scontext ',' scontexts"; +yyrule 269 = "ccontext: scontext"; +yyrule 270 = "ccontext: '(' scontexts ')'"; +yyrule 271 = "classdef: CLASS ccontext EARROW CONID tyvar wheredef"; +yyrule 272 = "classdef: CLASS ccontext wheredef"; +yyrule 273 = "sicontext: qconid simpletype"; +yyrule 274 = "sicontexts: sicontext"; +yyrule 275 = "sicontexts: sicontext ','"; +yyrule 276 = "sicontexts: sicontext ',' sicontexts"; +yyrule 277 = "icontext: sicontext"; +yyrule 278 = "icontext: '(' sicontexts ')'"; +yyrule 279 = "insthead: icontext EARROW tyname simpletype"; +yyrule 280 = "insthead: icontext"; +yyrule 281 = "instdef: INSTANCE insthead wheredef"; +yyrule 282 = "derivedef: DERIVE insthead"; +yyrule 283 = "datadef: datainit wheredef"; +yyrule 284 = "datajavadef: datajavainit wheredef"; +yyrule 285 = "nativepur: PURE NATIVE"; +yyrule 286 = "nativepur: NATIVE"; +yyrule 287 = "nativespec: nativename"; +yyrule 288 = "nativespec: nativename gargs"; +yyrule 289 = "gargvars: tyvar"; +yyrule 290 = "gargvars: tyvar ',' gargvars"; +yyrule 291 = "gargs: '{' gargvars '}'"; +yyrule 292 = "gargs: '{' '}'"; +yyrule 293 = "datainit: DATA CONID dvars '=' dalts"; +yyrule 294 = "datainit: DATA CONID '=' dalts"; +yyrule 295 = "datainit: DATA CONID"; +yyrule 296 = "datainit: NEWTYPE CONID dvars '=' dalt"; +yyrule 297 = "datainit: NEWTYPE CONID '=' dalt"; +yyrule 298 = "datajavainit: DATA CONID '=' nativepur nativespec"; +yyrule 299 = "datajavainit: DATA CONID dvars '=' nativepur nativespec"; +yyrule 300 = "dvars: tyvar"; +yyrule 301 = "dvars: tyvar dvars"; +yyrule 302 = "dalts: dalt"; +yyrule 303 = "dalts: dalt '|' dalts"; +yyrule 304 = "dalt: visdalt"; +yyrule 305 = "dalt: visdalt DOCUMENTATION"; +yyrule 306 = "dalt: DOCUMENTATION visdalt"; +yyrule 307 = "visdalt: strictdalt"; +yyrule 308 = "visdalt: PUBLIC strictdalt"; +yyrule 309 = "visdalt: PRIVATE strictdalt"; +yyrule 310 = "visdalt: PROTECTED strictdalt"; +yyrule 311 = "strictdalt: '!' simpledalt"; +yyrule 312 = "strictdalt: '?' simpledalt"; +yyrule 313 = "strictdalt: simpledalt"; +yyrule 314 = "simpledalt: CONID"; +yyrule 315 = "simpledalt: CONID '{' conflds '}'"; +yyrule 316 = "simpledalt: CONID contypes"; +yyrule 317 = "contypes: strictcontype"; +yyrule 318 = "contypes: strictcontype contypes"; +yyrule 319 = "strictcontype: contype"; +yyrule 320 = "strictcontype: '!' contype"; +yyrule 321 = "strictcontype: '?' contype"; +yyrule 322 = "contype: simpletype"; +yyrule 323 = "simpletypes: simpletype"; +yyrule 324 = "simpletypes: simpletype simpletypes"; +yyrule 325 = "conflds: confld"; +yyrule 326 = "conflds: confld ','"; +yyrule 327 = "conflds: confld DOCUMENTATION"; +yyrule 328 = "conflds: confld ',' conflds"; +yyrule 329 = "conflds: confld DOCUMENTATION conflds"; +yyrule 330 = "confld: docsO fldids DCOLON sigma"; +yyrule 331 = "fldids: fldid"; +yyrule 332 = "fldids: fldid ',' fldids"; +yyrule 333 = "fldid: strictfldid"; +yyrule 334 = "fldid: PUBLIC strictfldid"; +yyrule 335 = "fldid: PRIVATE strictfldid"; +yyrule 336 = "strictfldid: plainfldid"; +yyrule 337 = "strictfldid: '!' plainfldid"; +yyrule 338 = "strictfldid: '?' plainfldid"; +yyrule 339 = "plainfldid: varid"; +yyrule 340 = "typedef: TYPE CONID '=' sigma"; +yyrule 341 = "typedef: TYPE CONID dvars '=' sigma"; +yyrule 342 = "wheredef: "; +yyrule 343 = "wheredef: WHERE '{' '}'"; +yyrule 344 = "wheredef: WHERE '{' localdefs '}'"; +yyrule 345 = "wherelet: WHERE '{' '}'"; +yyrule 346 = "wherelet: WHERE '{' letdefs '}'"; +yyrule 347 = "fundef: funhead '=' expr"; +yyrule 348 = "fundef: funhead guards"; +yyrule 349 = "fundef: fundef wherelet"; +yyrule 350 = "funhead: binex"; +yyrule 351 = "literal: TRUE"; +yyrule 352 = "literal: FALSE"; +yyrule 353 = "literal: CHRCONST"; +yyrule 354 = "literal: STRCONST"; +yyrule 355 = "literal: INTCONST"; +yyrule 356 = "literal: BIGCONST"; +yyrule 357 = "literal: LONGCONST"; +yyrule 358 = "literal: FLTCONST"; +yyrule 359 = "literal: DBLCONST"; +yyrule 360 = "literal: DECCONST"; +yyrule 361 = "literal: REGEXP"; +yyrule 362 = "pattern: expr"; +yyrule 363 = "aeq: ARROW"; +yyrule 364 = "aeq: '='"; +yyrule 365 = "lcqual: gqual"; +yyrule 366 = "lcqual: expr '=' expr"; +yyrule 367 = "lcqual: LET '{' letdefs '}'"; +yyrule 368 = "lcquals: lcqual"; +yyrule 369 = "lcquals: lcqual ',' lcquals"; +yyrule 370 = "lcquals: lcqual ','"; +yyrule 371 = "dodefs: lcqual"; +yyrule 372 = "dodefs: lcqual ';'"; +yyrule 373 = "dodefs: lcqual ';' dodefs"; +yyrule 374 = "gqual: expr"; +yyrule 375 = "gqual: expr GETS expr"; +yyrule 376 = "gquals: gqual"; +yyrule 377 = "gquals: gqual ',' gquals"; +yyrule 378 = "gquals: gqual ','"; +yyrule 379 = "guard: '|' gquals aeq expr"; +yyrule 380 = "guards: guard"; +yyrule 381 = "guards: guard guards"; +yyrule 382 = "calt: pattern aeq expr"; +yyrule 383 = "calt: pattern guards"; +yyrule 384 = "calt: calt wherelet"; +yyrule 385 = "calts: calt"; +yyrule 386 = "calts: calt ';' calts"; +yyrule 387 = "calts: calt ';'"; +yyrule 388 = "lambda: '\\' apats lambdabody"; +yyrule 389 = "lambdabody: lambda"; +yyrule 390 = "lambdabody: ARROW expr"; +yyrule 391 = "expr: binex DCOLON sigma"; +yyrule 392 = "expr: binex"; +yyrule 393 = "thenx: ';' THEN"; +yyrule 394 = "thenx: THEN"; +yyrule 395 = "elsex: ';' ELSE"; +yyrule 396 = "elsex: ELSE"; +yyrule 397 = "binex: binex SOMEOP binex"; +yyrule 398 = "binex: binex '-' binex"; +yyrule 399 = "binex: '-' topex"; +yyrule 400 = "binex: topex"; +yyrule 401 = "topex: IF expr thenx expr elsex expr"; +yyrule 402 = "topex: CASE expr OF '{' calts '}'"; +yyrule 403 = "topex: LET '{' letdefs '}' IN expr"; +yyrule 404 = "topex: lambda"; +yyrule 405 = "topex: appex"; +yyrule 406 = "appex: unex"; +yyrule 407 = "appex: appex unex"; +yyrule 408 = "unex: primary"; +yyrule 409 = "unex: unop unex"; +yyrule 410 = "apats: unex"; +yyrule 411 = "apats: unex apats"; +yyrule 412 = "qualifiers: QUALIFIER"; +yyrule 413 = "qualifiers: QUALIFIER QUALIFIER"; +yyrule 414 = "primary: term"; +yyrule 415 = "primary: DO '{' dodefs '}'"; +yyrule 416 = "primary: primary '.' VARID"; +yyrule 417 = "primary: primary '.' operator"; +yyrule 418 = "primary: primary '.' unop"; +yyrule 419 = "primary: qualifiers '{' VARID '?' '}'"; +yyrule 420 = "primary: qualifiers '{' VARID '=' '}'"; +yyrule 421 = "primary: qualifiers '{' VARID GETS '}'"; +yyrule 422 = "primary: qualifiers '{' getfields '}'"; +yyrule 423 = "primary: primary '.' '{' VARID '?' '}'"; +yyrule 424 = "primary: primary '.' '{' VARID '=' '}'"; +yyrule 425 = "primary: primary '.' '{' VARID GETS '}'"; +yyrule 426 = "primary: primary '.' '{' getfields '}'"; +yyrule 427 = "primary: primary '.' '[' expr ']'"; +yyrule 428 = "term: qvarid"; +yyrule 429 = "term: literal"; +yyrule 430 = "term: '_'"; +yyrule 431 = "term: qconid"; +yyrule 432 = "term: qconid '{' '}'"; +yyrule 433 = "term: qconid '{' fields '}'"; +yyrule 434 = "term: '(' ')'"; +yyrule 435 = "term: '(' commata ')'"; +yyrule 436 = "term: '(' unop ')'"; +yyrule 437 = "term: '(' operator ')'"; +yyrule 438 = "term: '(' '-' ')'"; +yyrule 439 = "term: '(' operator expr ')'"; +yyrule 440 = "term: '(' binex operator ')'"; +yyrule 441 = "term: '(' binex '-' ')'"; +yyrule 442 = "term: '(' expr ',' exprSC ')'"; +yyrule 443 = "term: '(' expr ';' exprSS ')'"; +yyrule 444 = "term: '(' expr ')'"; +yyrule 445 = "term: '[' ']'"; +yyrule 446 = "term: '[' exprSC ']'"; +yyrule 447 = "term: '[' exprSC DOTDOT ']'"; +yyrule 448 = "term: '[' exprSC DOTDOT expr ']'"; +yyrule 449 = "term: '[' expr '|' lcquals ']'"; +yyrule 450 = "commata: ','"; +yyrule 451 = "commata: ',' commata"; +yyrule 452 = "fields: field"; +yyrule 453 = "fields: field ',' fields"; +yyrule 454 = "fields: field ','"; +yyrule 455 = "getfields: getfield"; +yyrule 456 = "getfields: getfield ',' getfields"; +yyrule 457 = "getfields: getfield ','"; +yyrule 458 = "getfield: VARID GETS expr"; +yyrule 459 = "getfield: VARID '=' expr"; +yyrule 460 = "getfield: VARID"; +yyrule 461 = "field: varid '=' expr"; +yyrule 462 = "field: varid"; +yyrule 463 = "exprSC: expr"; +yyrule 464 = "exprSC: expr ',' exprSC"; +yyrule 465 = "exprSC: expr ','"; +yyrule 466 = "exprSS: expr"; +yyrule 467 = "exprSS: expr ';' exprSS"; +yyrule 468 = "exprSS: expr ';'"; yyrule _ = ""; private yyprod1 ((_, (YYNTdefinitions yy4)):(_, (YYTok yy3)):(_, (YYNTmoduleclause yy2)):(_, (YYNTdocsO yy1)):yyvs) = do { yyr <- reduce1 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTmodule yyr, yyvs)}; @@ -7245,112 +7338,112 @@ private yyprod115 ((_, (YYNTtypedef yy1)):yyvs) = do { let {!yyr = reduce115 yy private yyprod115 yyvals = yybadprod 115 yyvals; private yyprod116 ((_, (YYNTdatadef yy1)):yyvs) = do { let {!yyr = reduce116 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; private yyprod116 yyvals = yybadprod 116 yyvals; -private yyprod117 ((_, (YYNTclassdef yy1)):yyvs) = do { let {!yyr = reduce117 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; +private yyprod117 ((_, (YYNTdatajavadef yy1)):yyvs) = do { let {!yyr = reduce117 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; private yyprod117 yyvals = yybadprod 117 yyvals; -private yyprod118 ((_, (YYNTinstdef yy1)):yyvs) = do { let {!yyr = reduce118 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; +private yyprod118 ((_, (YYNTclassdef yy1)):yyvs) = do { let {!yyr = reduce118 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; private yyprod118 yyvals = yybadprod 118 yyvals; -private yyprod119 ((_, (YYNTderivedef yy1)):yyvs) = do { let {!yyr = reduce119 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; +private yyprod119 ((_, (YYNTinstdef yy1)):yyvs) = do { let {!yyr = reduce119 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; private yyprod119 yyvals = yybadprod 119 yyvals; -private yyprod120 ((_, (YYNTlocaldef yy1)):yyvs) = YYM.pure (YYNTpublicdefinition (yy1), yyvs); +private yyprod120 ((_, (YYNTderivedef yy1)):yyvs) = do { let {!yyr = reduce120 yy1}; YYM.pure (YYNTpublicdefinition yyr, yyvs)}; private yyprod120 yyvals = yybadprod 120 yyvals; -private yyprod121 ((_, (YYNTdplocaldef yy1)):yyvs) = YYM.pure (YYNTlocaldefs (yy1), yyvs); +private yyprod121 ((_, (YYNTlocaldef yy1)):yyvs) = YYM.pure (YYNTpublicdefinition (yy1), yyvs); private yyprod121 yyvals = yybadprod 121 yyvals; -private yyprod122 ((_, (YYTok yy2)):(_, (YYNTdplocaldef yy1)):yyvs) = do { let {!yyr = reduce122 yy1 yy2}; YYM.pure (YYNTlocaldefs yyr, yyvs)}; +private yyprod122 ((_, (YYNTdplocaldef yy1)):yyvs) = YYM.pure (YYNTlocaldefs (yy1), yyvs); private yyprod122 yyvals = yybadprod 122 yyvals; -private yyprod123 ((_, (YYNTlocaldefs yy3)):(_, (YYTok yy2)):(_, (YYNTdplocaldef yy1)):yyvs) = do { let {!yyr = reduce123 yy1 yy2 yy3}; YYM.pure (YYNTlocaldefs yyr, yyvs)}; +private yyprod123 ((_, (YYTok yy2)):(_, (YYNTdplocaldef yy1)):yyvs) = do { let {!yyr = reduce123 yy1 yy2}; YYM.pure (YYNTlocaldefs yyr, yyvs)}; private yyprod123 yyvals = yybadprod 123 yyvals; -private yyprod124 ((_, (YYNTannotation yy1)):yyvs) = YYM.pure (YYNTlocaldef (yy1), yyvs); +private yyprod124 ((_, (YYNTlocaldefs yy3)):(_, (YYTok yy2)):(_, (YYNTdplocaldef yy1)):yyvs) = do { let {!yyr = reduce124 yy1 yy2 yy3}; YYM.pure (YYNTlocaldefs yyr, yyvs)}; private yyprod124 yyvals = yybadprod 124 yyvals; -private yyprod125 ((_, (YYNTnativedef yy1)):yyvs) = do { let {!yyr = reduce125 yy1}; YYM.pure (YYNTlocaldef yyr, yyvs)}; +private yyprod125 ((_, (YYNTannotation yy1)):yyvs) = do { let {!yyr = reduce125 yy1}; YYM.pure (YYNTlocaldef yyr, yyvs)}; private yyprod125 yyvals = yybadprod 125 yyvals; -private yyprod126 ((_, (YYNTfundef yy1)):yyvs) = YYM.pure (YYNTlocaldef (yy1), yyvs); +private yyprod126 ((_, (YYNTnativedef yy1)):yyvs) = do { let {!yyr = reduce126 yy1}; YYM.pure (YYNTlocaldef yyr, yyvs)}; private yyprod126 yyvals = yybadprod 126 yyvals; -private yyprod127 ((_, (YYNTlocaldef yy1)):yyvs) = YYM.pure (YYNTplocaldef (yy1), yyvs); +private yyprod127 ((_, (YYNTfundef yy1)):yyvs) = do { let {!yyr = reduce127 yy1}; YYM.pure (YYNTlocaldef yyr, yyvs)}; private yyprod127 yyvals = yybadprod 127 yyvals; -private yyprod128 ((_, (YYNTlocaldef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce128 yy1 yy2}; YYM.pure (YYNTplocaldef yyr, yyvs)}; +private yyprod128 ((_, (YYNTlocaldef yy1)):yyvs) = YYM.pure (YYNTplocaldef (yy1), yyvs); private yyprod128 yyvals = yybadprod 128 yyvals; private yyprod129 ((_, (YYNTlocaldef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce129 yy1 yy2}; YYM.pure (YYNTplocaldef yyr, yyvs)}; private yyprod129 yyvals = yybadprod 129 yyvals; private yyprod130 ((_, (YYNTlocaldef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce130 yy1 yy2}; YYM.pure (YYNTplocaldef yyr, yyvs)}; private yyprod130 yyvals = yybadprod 130 yyvals; -private yyprod131 ((_, (YYNTdocumentation yy1)):yyvs) = do { let {!yyr = reduce131 yy1}; YYM.pure (YYNTdplocaldef yyr, yyvs)}; +private yyprod131 ((_, (YYNTlocaldef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce131 yy1 yy2}; YYM.pure (YYNTplocaldef yyr, yyvs)}; private yyprod131 yyvals = yybadprod 131 yyvals; -private yyprod132 ((_, (YYNTdplocaldef yy2)):(_, (YYNTdocumentation yy1)):yyvs) = do { let {!yyr = reduce132 yy1 yy2}; YYM.pure (YYNTdplocaldef yyr, yyvs)}; +private yyprod132 ((_, (YYNTdocumentation yy1)):yyvs) = do { let {!yyr = reduce132 yy1}; YYM.pure (YYNTdplocaldef yyr, yyvs)}; private yyprod132 yyvals = yybadprod 132 yyvals; -private yyprod133 ((_, (YYNTplocaldef yy1)):yyvs) = YYM.pure (YYNTdplocaldef (yy1), yyvs); +private yyprod133 ((_, (YYNTdplocaldef yy2)):(_, (YYNTdocumentation yy1)):yyvs) = do { let {!yyr = reduce133 yy1 yy2}; YYM.pure (YYNTdplocaldef yyr, yyvs)}; private yyprod133 yyvals = yybadprod 133 yyvals; -private yyprod134 ((_, (YYNTannotation yy1)):yyvs) = YYM.pure (YYNTletdef (yy1), yyvs); +private yyprod134 ((_, (YYNTplocaldef yy1)):yyvs) = YYM.pure (YYNTdplocaldef (yy1), yyvs); private yyprod134 yyvals = yybadprod 134 yyvals; -private yyprod135 ((_, (YYNTfundef yy1)):yyvs) = YYM.pure (YYNTletdef (yy1), yyvs); +private yyprod135 ((_, (YYNTannotation yy1)):yyvs) = do { let {!yyr = reduce135 yy1}; YYM.pure (YYNTletdef yyr, yyvs)}; private yyprod135 yyvals = yybadprod 135 yyvals; -private yyprod136 ((_, (YYNTletdef yy1)):yyvs) = YYM.pure (YYNTletdefs (yy1), yyvs); +private yyprod136 ((_, (YYNTfundef yy1)):yyvs) = do { let {!yyr = reduce136 yy1}; YYM.pure (YYNTletdef yyr, yyvs)}; private yyprod136 yyvals = yybadprod 136 yyvals; -private yyprod137 ((_, (YYTok yy2)):(_, (YYNTletdef yy1)):yyvs) = do { let {!yyr = reduce137 yy1 yy2}; YYM.pure (YYNTletdefs yyr, yyvs)}; +private yyprod137 ((_, (YYNTletdef yy1)):yyvs) = YYM.pure (YYNTletdefs (yy1), yyvs); private yyprod137 yyvals = yybadprod 137 yyvals; -private yyprod138 ((_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYNTletdef yy1)):yyvs) = do { let {!yyr = reduce138 yy1 yy2 yy3}; YYM.pure (YYNTletdefs yyr, yyvs)}; +private yyprod138 ((_, (YYTok yy2)):(_, (YYNTletdef yy1)):yyvs) = do { let {!yyr = reduce138 yy1 yy2}; YYM.pure (YYNTletdefs yyr, yyvs)}; private yyprod138 yyvals = yybadprod 138 yyvals; -private yyprod139 ((_, (YYNTimportliste yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce139 yy1 yy2 yy3}; YYM.pure (YYNTimport yyr, yyvs)}; +private yyprod139 ((_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYNTletdef yy1)):yyvs) = do { let {!yyr = reduce139 yy1 yy2 yy3}; YYM.pure (YYNTletdefs yyr, yyvs)}; private yyprod139 yyvals = yybadprod 139 yyvals; -private yyprod140 ((_, (YYNTimportliste yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce140 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTimport yyr, yyvs)}; +private yyprod140 ((_, (YYNTimportliste yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce140 yy1 yy2 yy3}; YYM.pure (YYNTimport yyr, yyvs)}; private yyprod140 yyvals = yybadprod 140 yyvals; -private yyprod141 ((_, (YYNTimportliste yy4)):(_, (YYTok yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce141 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTimport yyr, yyvs)}; +private yyprod141 ((_, (YYNTimportliste yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce141 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTimport yyr, yyvs)}; private yyprod141 yyvals = yybadprod 141 yyvals; -private yyprod142 yyvs = do { let {!yyr = reduce142 }; YYM.pure (YYNTimportliste yyr, yyvs)}; -private yyprod143 ((_, (YYTok yy4)):(_, (YYNTimportspecs yy3)):(_, (YYTok yy2)):(_, (YYNTvarid yy1)):yyvs) = do { yyr <- reduce143 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTimportliste yyr, yyvs)}; -private yyprod143 yyvals = yybadprod 143 yyvals; -private yyprod144 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce144 yy1 yy2}; YYM.pure (YYNTimportliste yyr, yyvs)}; +private yyprod142 ((_, (YYNTimportliste yy4)):(_, (YYTok yy3)):(_, (YYNTmodulename yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce142 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTimport yyr, yyvs)}; +private yyprod142 yyvals = yybadprod 142 yyvals; +private yyprod143 yyvs = do { let {!yyr = reduce143 }; YYM.pure (YYNTimportliste yyr, yyvs)}; +private yyprod144 ((_, (YYTok yy4)):(_, (YYNTimportspecs yy3)):(_, (YYTok yy2)):(_, (YYNTvarid yy1)):yyvs) = do { yyr <- reduce144 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTimportliste yyr, yyvs)}; private yyprod144 yyvals = yybadprod 144 yyvals; -private yyprod145 ((_, (YYTok yy3)):(_, (YYNTimportspecs yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce145 yy1 yy2 yy3}; YYM.pure (YYNTimportliste yyr, yyvs)}; +private yyprod145 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce145 yy1 yy2}; YYM.pure (YYNTimportliste yyr, yyvs)}; private yyprod145 yyvals = yybadprod 145 yyvals; -private yyprod146 ((_, (YYNTimportliste yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce146 yy1 yy2}; YYM.pure (YYNTimportliste yyr, yyvs)}; +private yyprod146 ((_, (YYTok yy3)):(_, (YYNTimportspecs yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce146 yy1 yy2 yy3}; YYM.pure (YYNTimportliste yyr, yyvs)}; private yyprod146 yyvals = yybadprod 146 yyvals; -private yyprod147 ((_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce147 yy1}; YYM.pure (YYNTimportspecs yyr, yyvs)}; +private yyprod147 ((_, (YYNTimportliste yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce147 yy1 yy2}; YYM.pure (YYNTimportliste yyr, yyvs)}; private yyprod147 yyvals = yybadprod 147 yyvals; -private yyprod148 ((_, (YYTok yy2)):(_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce148 yy1 yy2}; YYM.pure (YYNTimportspecs yyr, yyvs)}; +private yyprod148 ((_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce148 yy1}; YYM.pure (YYNTimportspecs yyr, yyvs)}; private yyprod148 yyvals = yybadprod 148 yyvals; -private yyprod149 ((_, (YYNTimportspecs yy3)):(_, (YYTok yy2)):(_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce149 yy1 yy2 yy3}; YYM.pure (YYNTimportspecs yyr, yyvs)}; +private yyprod149 ((_, (YYTok yy2)):(_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce149 yy1 yy2}; YYM.pure (YYNTimportspecs yyr, yyvs)}; private yyprod149 yyvals = yybadprod 149 yyvals; -private yyprod150 ((_, (YYNTqvarid yy1)):yyvs) = do { let {!yyr = reduce150 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod150 ((_, (YYNTimportspecs yy3)):(_, (YYTok yy2)):(_, (YYNTimportspec yy1)):yyvs) = do { let {!yyr = reduce150 yy1 yy2 yy3}; YYM.pure (YYNTimportspecs yyr, yyvs)}; private yyprod150 yyvals = yybadprod 150 yyvals; -private yyprod151 ((_, (YYTok yy4)):(_, (YYNTmemspecs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce151 yy1 yy2 yy3 yy4}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod151 ((_, (YYNTqvarid yy1)):yyvs) = do { let {!yyr = reduce151 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod151 yyvals = yybadprod 151 yyvals; -private yyprod152 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce152 yy1 yy2 yy3}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod152 ((_, (YYTok yy4)):(_, (YYNTmemspecs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce152 yy1 yy2 yy3 yy4}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod152 yyvals = yybadprod 152 yyvals; -private yyprod153 ((_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce153 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod153 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce153 yy1 yy2 yy3}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod153 yyvals = yybadprod 153 yyvals; -private yyprod154 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce154 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod154 ((_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce154 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod154 yyvals = yybadprod 154 yyvals; -private yyprod155 ((_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce155 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; +private yyprod155 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce155 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod155 yyvals = yybadprod 155 yyvals; -private yyprod156 ((_, (YYNTimportitem yy1)):yyvs) = do { let {!yyr = reduce156 yy1}; YYM.pure (YYNTimportspec yyr, yyvs)}; +private yyprod156 ((_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce156 yy1}; YYM.pure (YYNTimportitem yyr, yyvs)}; private yyprod156 yyvals = yybadprod 156 yyvals; -private yyprod157 ((_, (YYNTalias yy2)):(_, (YYNTimportitem yy1)):yyvs) = do { let {!yyr = reduce157 yy1 yy2}; YYM.pure (YYNTimportspec yyr, yyvs)}; +private yyprod157 ((_, (YYNTimportitem yy1)):yyvs) = do { let {!yyr = reduce157 yy1}; YYM.pure (YYNTimportspec yyr, yyvs)}; private yyprod157 yyvals = yybadprod 157 yyvals; -private yyprod158 ((_, (YYNTimportspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce158 yy1 yy2}; YYM.pure (YYNTimportspec yyr, yyvs)}; +private yyprod158 ((_, (YYNTalias yy2)):(_, (YYNTimportitem yy1)):yyvs) = do { let {!yyr = reduce158 yy1 yy2}; YYM.pure (YYNTimportspec yyr, yyvs)}; private yyprod158 yyvals = yybadprod 158 yyvals; -private yyprod159 ((_, (YYNTalias yy1)):yyvs) = do { let {!yyr = reduce159 yy1}; YYM.pure (YYNTmemspec yyr, yyvs)}; +private yyprod159 ((_, (YYNTimportspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce159 yy1 yy2}; YYM.pure (YYNTimportspec yyr, yyvs)}; private yyprod159 yyvals = yybadprod 159 yyvals; -private yyprod160 ((_, (YYNTalias yy2)):(_, (YYNTalias yy1)):yyvs) = do { let {!yyr = reduce160 yy1 yy2}; YYM.pure (YYNTmemspec yyr, yyvs)}; +private yyprod160 ((_, (YYNTalias yy1)):yyvs) = do { let {!yyr = reduce160 yy1}; YYM.pure (YYNTmemspec yyr, yyvs)}; private yyprod160 yyvals = yybadprod 160 yyvals; -private yyprod161 ((_, (YYNTmemspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce161 yy1 yy2}; YYM.pure (YYNTmemspec yyr, yyvs)}; +private yyprod161 ((_, (YYNTalias yy2)):(_, (YYNTalias yy1)):yyvs) = do { let {!yyr = reduce161 yy1 yy2}; YYM.pure (YYNTmemspec yyr, yyvs)}; private yyprod161 yyvals = yybadprod 161 yyvals; -private yyprod162 ((_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce162 yy1}; YYM.pure (YYNTmemspecs yyr, yyvs)}; +private yyprod162 ((_, (YYNTmemspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce162 yy1 yy2}; YYM.pure (YYNTmemspec yyr, yyvs)}; private yyprod162 yyvals = yybadprod 162 yyvals; -private yyprod163 ((_, (YYTok yy2)):(_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce163 yy1 yy2}; YYM.pure (YYNTmemspecs yyr, yyvs)}; +private yyprod163 ((_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce163 yy1}; YYM.pure (YYNTmemspecs yyr, yyvs)}; private yyprod163 yyvals = yybadprod 163 yyvals; -private yyprod164 ((_, (YYNTmemspecs yy3)):(_, (YYTok yy2)):(_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce164 yy1 yy2 yy3}; YYM.pure (YYNTmemspecs yyr, yyvs)}; +private yyprod164 ((_, (YYTok yy2)):(_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce164 yy1 yy2}; YYM.pure (YYNTmemspecs yyr, yyvs)}; private yyprod164 yyvals = yybadprod 164 yyvals; -private yyprod165 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTalias (yy1), yyvs); +private yyprod165 ((_, (YYNTmemspecs yy3)):(_, (YYTok yy2)):(_, (YYNTmemspec yy1)):yyvs) = do { let {!yyr = reduce165 yy1 yy2 yy3}; YYM.pure (YYNTmemspecs yyr, yyvs)}; private yyprod165 yyvals = yybadprod 165 yyvals; private yyprod166 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTalias (yy1), yyvs); private yyprod166 yyvals = yybadprod 166 yyvals; -private yyprod167 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce167 yy1 ;YYM.pure (YYNTalias yyr, yyvs)}; +private yyprod167 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTalias (yy1), yyvs); private yyprod167 yyvals = yybadprod 167 yyvals; -private yyprod168 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvarid (yy1), yyvs); +private yyprod168 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce168 yy1 ;YYM.pure (YYNTalias yyr, yyvs)}; private yyprod168 yyvals = yybadprod 168 yyvals; -private yyprod169 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvaridkw (yy1), yyvs); +private yyprod169 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvarid (yy1), yyvs); private yyprod169 yyvals = yybadprod 169 yyvals; -private yyprod170 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce170 yy1}; YYM.pure (YYNTvaridkw yyr, yyvs)}; +private yyprod170 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvaridkw (yy1), yyvs); private yyprod170 yyvals = yybadprod 170 yyvals; private yyprod171 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce171 yy1}; YYM.pure (YYNTvaridkw yyr, yyvs)}; private yyprod171 yyvals = yybadprod 171 yyvals; @@ -7362,585 +7455,593 @@ private yyprod174 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce174 yy1}; YY private yyprod174 yyvals = yybadprod 174 yyvals; private yyprod175 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce175 yy1}; YYM.pure (YYNTvaridkw yyr, yyvs)}; private yyprod175 yyvals = yybadprod 175 yyvals; -private yyprod176 ((_, (YYNTqvarop yy1)):yyvs) = do { let {!yyr = reduce176 yy1}; YYM.pure (YYNTqvarids yyr, yyvs)}; +private yyprod176 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce176 yy1}; YYM.pure (YYNTvaridkw yyr, yyvs)}; private yyprod176 yyvals = yybadprod 176 yyvals; -private yyprod177 ((_, (YYNTqvarids yy3)):(_, (YYTok yy2)):(_, (YYNTqvarop yy1)):yyvs) = do { let {!yyr = reduce177 yy1 yy2 yy3}; YYM.pure (YYNTqvarids yyr, yyvs)}; +private yyprod177 ((_, (YYNTqvarop yy1)):yyvs) = do { let {!yyr = reduce177 yy1}; YYM.pure (YYNTqvarids yyr, yyvs)}; private yyprod177 yyvals = yybadprod 177 yyvals; -private yyprod178 ((_, (YYNTvarop yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce178 yy1 yy2 yy3}; YYM.pure (YYNTqvarid yyr, yyvs)}; +private yyprod178 ((_, (YYNTqvarids yy3)):(_, (YYTok yy2)):(_, (YYNTqvarop yy1)):yyvs) = do { let {!yyr = reduce178 yy1 yy2 yy3}; YYM.pure (YYNTqvarids yyr, yyvs)}; private yyprod178 yyvals = yybadprod 178 yyvals; -private yyprod179 ((_, (YYNTvarop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce179 yy1 yy2}; YYM.pure (YYNTqvarid yyr, yyvs)}; +private yyprod179 ((_, (YYNTvarop yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce179 yy1 yy2 yy3}; YYM.pure (YYNTqvarid yyr, yyvs)}; private yyprod179 yyvals = yybadprod 179 yyvals; -private yyprod180 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce180 yy1}; YYM.pure (YYNTqvarid yyr, yyvs)}; +private yyprod180 ((_, (YYNTvarop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce180 yy1 yy2}; YYM.pure (YYNTqvarid yyr, yyvs)}; private yyprod180 yyvals = yybadprod 180 yyvals; -private yyprod181 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce181 yy1 yy2 yy3}; YYM.pure (YYNTqconid yyr, yyvs)}; +private yyprod181 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce181 yy1}; YYM.pure (YYNTqvarid yyr, yyvs)}; private yyprod181 yyvals = yybadprod 181 yyvals; -private yyprod182 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce182 yy1 yy2}; YYM.pure (YYNTqconid yyr, yyvs)}; +private yyprod182 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce182 yy1 yy2 yy3}; YYM.pure (YYNTqconid yyr, yyvs)}; private yyprod182 yyvals = yybadprod 182 yyvals; -private yyprod183 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce183 yy1}; YYM.pure (YYNTqconid yyr, yyvs)}; +private yyprod183 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce183 yy1 yy2}; YYM.pure (YYNTqconid yyr, yyvs)}; private yyprod183 yyvals = yybadprod 183 yyvals; -private yyprod184 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvarop (yy1), yyvs); +private yyprod184 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce184 yy1}; YYM.pure (YYNTqconid yyr, yyvs)}; private yyprod184 yyvals = yybadprod 184 yyvals; -private yyprod185 ((_, (YYNTunop yy1)):yyvs) = YYM.pure (YYNTvarop (yy1), yyvs); +private yyprod185 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTvarop (yy1), yyvs); private yyprod185 yyvals = yybadprod 185 yyvals; -private yyprod186 ((_, (YYNTvarop yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce186 yy1 yy2 yy3}; YYM.pure (YYNTqvarop yyr, yyvs)}; +private yyprod186 ((_, (YYNTunop yy1)):yyvs) = YYM.pure (YYNTvarop (yy1), yyvs); private yyprod186 yyvals = yybadprod 186 yyvals; -private yyprod187 ((_, (YYNTvarop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce187 yy1 yy2}; YYM.pure (YYNTqvarop yyr, yyvs)}; +private yyprod187 ((_, (YYNTvarop yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce187 yy1 yy2 yy3}; YYM.pure (YYNTqvarop yyr, yyvs)}; private yyprod187 yyvals = yybadprod 187 yyvals; -private yyprod188 ((_, (YYNTvarop yy1)):yyvs) = do { let {!yyr = reduce188 yy1}; YYM.pure (YYNTqvarop yyr, yyvs)}; +private yyprod188 ((_, (YYNTvarop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce188 yy1 yy2}; YYM.pure (YYNTqvarop yyr, yyvs)}; private yyprod188 yyvals = yybadprod 188 yyvals; -private yyprod189 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce189 yy1}; YYM.pure (YYNTqvarop yyr, yyvs)}; +private yyprod189 ((_, (YYNTvarop yy1)):yyvs) = do { let {!yyr = reduce189 yy1}; YYM.pure (YYNTqvarop yyr, yyvs)}; private yyprod189 yyvals = yybadprod 189 yyvals; -private yyprod190 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNToperator (yy1), yyvs); +private yyprod190 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce190 yy1}; YYM.pure (YYNTqvarop yyr, yyvs)}; private yyprod190 yyvals = yybadprod 190 yyvals; -private yyprod191 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTunop (yy1), yyvs); +private yyprod191 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNToperator (yy1), yyvs); private yyprod191 yyvals = yybadprod 191 yyvals; private yyprod192 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTunop (yy1), yyvs); private yyprod192 yyvals = yybadprod 192 yyvals; -private yyprod193 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce193 yy1 yy2 ;YYM.pure (YYNTfixity yyr, yyvs)}; +private yyprod193 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTunop (yy1), yyvs); private yyprod193 yyvals = yybadprod 193 yyvals; private yyprod194 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce194 yy1 yy2 ;YYM.pure (YYNTfixity yyr, yyvs)}; private yyprod194 yyvals = yybadprod 194 yyvals; private yyprod195 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce195 yy1 yy2 ;YYM.pure (YYNTfixity yyr, yyvs)}; private yyprod195 yyvals = yybadprod 195 yyvals; -private yyprod196 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce196 yy1}; YYM.pure (YYNTopstring yyr, yyvs)}; +private yyprod196 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce196 yy1 yy2 ;YYM.pure (YYNTfixity yyr, yyvs)}; private yyprod196 yyvals = yybadprod 196 yyvals; -private yyprod197 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce197 yy1}; YYM.pure (YYNTopstring yyr, yyvs)}; +private yyprod197 ((_, (YYNToperator yy1)):yyvs) = do { let {!yyr = reduce197 yy1}; YYM.pure (YYNTopstring yyr, yyvs)}; private yyprod197 yyvals = yybadprod 197 yyvals; private yyprod198 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce198 yy1}; YYM.pure (YYNTopstring yyr, yyvs)}; private yyprod198 yyvals = yybadprod 198 yyvals; -private yyprod199 ((_, (YYNTopstring yy1)):yyvs) = do { let {!yyr = reduce199 yy1}; YYM.pure (YYNToperators yyr, yyvs)}; +private yyprod199 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce199 yy1}; YYM.pure (YYNTopstring yyr, yyvs)}; private yyprod199 yyvals = yybadprod 199 yyvals; -private yyprod200 ((_, (YYNToperators yy2)):(_, (YYNTopstring yy1)):yyvs) = do { let {!yyr = reduce200 yy1 yy2}; YYM.pure (YYNToperators yyr, yyvs)}; +private yyprod200 ((_, (YYNTopstring yy1)):yyvs) = do { let {!yyr = reduce200 yy1}; YYM.pure (YYNToperators yyr, yyvs)}; private yyprod200 yyvals = yybadprod 200 yyvals; -private yyprod201 ((_, (YYNToperators yy2)):(_, (YYNTfixity yy1)):yyvs) = do { let {!yyr = reduce201 yy1 yy2}; YYM.pure (YYNTinfix yyr, yyvs)}; +private yyprod201 ((_, (YYNToperators yy2)):(_, (YYNTopstring yy1)):yyvs) = do { let {!yyr = reduce201 yy1 yy2}; YYM.pure (YYNToperators yyr, yyvs)}; private yyprod201 yyvals = yybadprod 201 yyvals; -private yyprod202 ((_, (YYNTsigma yy3)):(_, (YYTok yy2)):(_, (YYNTannoitems yy1)):yyvs) = do { let {!yyr = reduce202 yy1 yy2 yy3}; YYM.pure (YYNTannotation yyr, yyvs)}; +private yyprod202 ((_, (YYNToperators yy2)):(_, (YYNTfixity yy1)):yyvs) = do { let {!yyr = reduce202 yy1 yy2}; YYM.pure (YYNTinfix yyr, yyvs)}; private yyprod202 yyvals = yybadprod 202 yyvals; -private yyprod203 ((_, (YYNTvarid yy1)):yyvs) = YYM.pure (YYNTannoitem (yy1), yyvs); +private yyprod203 ((_, (YYNTsigma yy3)):(_, (YYTok yy2)):(_, (YYNTannoitems yy1)):yyvs) = do { let {!yyr = reduce203 yy1 yy2 yy3}; YYM.pure (YYNTannotation yyr, yyvs)}; private yyprod203 yyvals = yybadprod 203 yyvals; -private yyprod204 ((_, (YYTok yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce204 yy1 yy2 yy3 ;YYM.pure (YYNTannoitem yyr, yyvs)}; +private yyprod204 ((_, (YYNTvarid yy1)):yyvs) = YYM.pure (YYNTannoitem (yy1), yyvs); private yyprod204 yyvals = yybadprod 204 yyvals; -private yyprod205 ((_, (YYTok yy3)):(_, (YYNTunop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce205 yy1 yy2 yy3}; YYM.pure (YYNTannoitem yyr, yyvs)}; +private yyprod205 ((_, (YYTok yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce205 yy1 yy2 yy3 ;YYM.pure (YYNTannoitem yyr, yyvs)}; private yyprod205 yyvals = yybadprod 205 yyvals; -private yyprod206 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce206 yy1 yy2 yy3}; YYM.pure (YYNTannoitem yyr, yyvs)}; +private yyprod206 ((_, (YYTok yy3)):(_, (YYNTunop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce206 yy1 yy2 yy3}; YYM.pure (YYNTannoitem yyr, yyvs)}; private yyprod206 yyvals = yybadprod 206 yyvals; -private yyprod207 ((_, (YYNTannoitem yy1)):yyvs) = do { let {!yyr = reduce207 yy1}; YYM.pure (YYNTannoitems yyr, yyvs)}; +private yyprod207 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce207 yy1 yy2 yy3}; YYM.pure (YYNTannoitem yyr, yyvs)}; private yyprod207 yyvals = yybadprod 207 yyvals; -private yyprod208 ((_, (YYNTannoitems yy3)):(_, (YYTok yy2)):(_, (YYNTannoitem yy1)):yyvs) = do { let {!yyr = reduce208 yy1 yy2 yy3}; YYM.pure (YYNTannoitems yyr, yyvs)}; +private yyprod208 ((_, (YYNTannoitem yy1)):yyvs) = do { let {!yyr = reduce208 yy1}; YYM.pure (YYNTannoitems yyr, yyvs)}; private yyprod208 yyvals = yybadprod 208 yyvals; -private yyprod209 ((_, (YYNTimpurenativedef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce209 yy1 yy2}; YYM.pure (YYNTnativedef yyr, yyvs)}; +private yyprod209 ((_, (YYNTannoitems yy3)):(_, (YYTok yy2)):(_, (YYNTannoitem yy1)):yyvs) = do { let {!yyr = reduce209 yy1 yy2 yy3}; YYM.pure (YYNTannoitems yyr, yyvs)}; private yyprod209 yyvals = yybadprod 209 yyvals; -private yyprod210 ((_, (YYNTimpurenativedef yy1)):yyvs) = YYM.pure (YYNTnativedef (yy1), yyvs); +private yyprod210 ((_, (YYNTimpurenativedef yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce210 yy1 yy2}; YYM.pure (YYNTnativedef yyr, yyvs)}; private yyprod210 yyvals = yybadprod 210 yyvals; -private yyprod211 ((_, (YYNTannoitem yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); +private yyprod211 ((_, (YYNTimpurenativedef yy1)):yyvs) = YYM.pure (YYNTnativedef (yy1), yyvs); private yyprod211 yyvals = yybadprod 211 yyvals; -private yyprod212 ((_, (YYNTunop yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); +private yyprod212 ((_, (YYNTannoitem yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); private yyprod212 yyvals = yybadprod 212 yyvals; -private yyprod213 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); +private yyprod213 ((_, (YYNTunop yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); private yyprod213 yyvals = yybadprod 213 yyvals; -private yyprod214 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce214 yy1 ;YYM.pure (YYNTfitem yyr, yyvs)}; +private yyprod214 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTfitem (yy1), yyvs); private yyprod214 yyvals = yybadprod 214 yyvals; -private yyprod215 ((_, (YYNTnativename yy1)):yyvs) = YYM.pure (YYNTjitem (yy1), yyvs); +private yyprod215 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce215 yy1 ;YYM.pure (YYNTfitem yyr, yyvs)}; private yyprod215 yyvals = yybadprod 215 yyvals; -private yyprod216 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce216 yy1 ;YYM.pure (YYNTjitem yyr, yyvs)}; +private yyprod216 ((_, (YYNTnativename yy1)):yyvs) = YYM.pure (YYNTjitem (yy1), yyvs); private yyprod216 yyvals = yybadprod 216 yyvals; -private yyprod217 ((_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce217 yy1}; YYM.pure (YYNTjitem yyr, yyvs)}; +private yyprod217 ((_, (YYNToperator yy1)):yyvs) = do { yyr <- reduce217 yy1 ;YYM.pure (YYNTjitem yyr, yyvs)}; private yyprod217 yyvals = yybadprod 217 yyvals; -private yyprod218 ((_, (YYNTgargs yy3)):(_, (YYNTjitem yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce218 yy1 yy2 yy3}; YYM.pure (YYNTmethodspec yyr, yyvs)}; +private yyprod218 ((_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce218 yy1}; YYM.pure (YYNTjitem yyr, yyvs)}; private yyprod218 yyvals = yybadprod 218 yyvals; -private yyprod219 ((_, (YYNTjitem yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce219 yy1 yy2}; YYM.pure (YYNTmethodspec yyr, yyvs)}; +private yyprod219 ((_, (YYNTgargs yy3)):(_, (YYNTjitem yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce219 yy1 yy2 yy3}; YYM.pure (YYNTmethodspec yyr, yyvs)}; private yyprod219 yyvals = yybadprod 219 yyvals; -private yyprod220 ((_, (YYNTgargs yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce220 yy1 yy2}; YYM.pure (YYNTmethodspec yyr, yyvs)}; +private yyprod220 ((_, (YYNTjitem yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce220 yy1 yy2}; YYM.pure (YYNTmethodspec yyr, yyvs)}; private yyprod220 yyvals = yybadprod 220 yyvals; -private yyprod221 ((_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce221 yy1}; YYM.pure (YYNTmethodspec yyr, yyvs)}; +private yyprod221 ((_, (YYNTgargs yy2)):(_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce221 yy1 yy2}; YYM.pure (YYNTmethodspec yyr, yyvs)}; private yyprod221 yyvals = yybadprod 221 yyvals; -private yyprod222 ((_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYNTsigma yy1)):yyvs) = do { let {!yyr = reduce222 yy1 yy2 yy3}; YYM.pure (YYNTsigex yyr, yyvs)}; +private yyprod222 ((_, (YYNTfitem yy1)):yyvs) = do { let {!yyr = reduce222 yy1}; YYM.pure (YYNTmethodspec yyr, yyvs)}; private yyprod222 yyvals = yybadprod 222 yyvals; -private yyprod223 ((_, (YYNTsigma yy1)):yyvs) = do { let {!yyr = reduce223 yy1}; YYM.pure (YYNTsigex yyr, yyvs)}; +private yyprod223 ((_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYNTsigma yy1)):yyvs) = do { let {!yyr = reduce223 yy1 yy2 yy3}; YYM.pure (YYNTsigex yyr, yyvs)}; private yyprod223 yyvals = yybadprod 223 yyvals; -private yyprod224 ((_, (YYNTsigex yy1)):yyvs) = do { let {!yyr = reduce224 yy1}; YYM.pure (YYNTsigexs yyr, yyvs)}; +private yyprod224 ((_, (YYNTsigma yy1)):yyvs) = do { let {!yyr = reduce224 yy1}; YYM.pure (YYNTsigex yyr, yyvs)}; private yyprod224 yyvals = yybadprod 224 yyvals; -private yyprod225 ((_, (YYNTsigexs yy3)):(_, (YYTok yy2)):(_, (YYNTsigex yy1)):yyvs) = do { let {!yyr = reduce225 yy1 yy2 yy3}; YYM.pure (YYNTsigexs yyr, yyvs)}; +private yyprod225 ((_, (YYNTsigex yy1)):yyvs) = do { let {!yyr = reduce225 yy1}; YYM.pure (YYNTsigexs yyr, yyvs)}; private yyprod225 yyvals = yybadprod 225 yyvals; -private yyprod226 ((_, (YYNTsigexs yy4)):(_, (YYTok yy3)):(_, (YYNTmethodspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce226 yy1 yy2 yy3 yy4}; YYM.pure (YYNTimpurenativedef yyr, yyvs)}; +private yyprod226 ((_, (YYNTsigexs yy3)):(_, (YYTok yy2)):(_, (YYNTsigex yy1)):yyvs) = do { let {!yyr = reduce226 yy1 yy2 yy3}; YYM.pure (YYNTsigexs yyr, yyvs)}; private yyprod226 yyvals = yybadprod 226 yyvals; -private yyprod227 ((_, (YYNTforall yy1)):yyvs) = YYM.pure (YYNTsigma (yy1), yyvs); +private yyprod227 ((_, (YYNTsigexs yy4)):(_, (YYTok yy3)):(_, (YYNTmethodspec yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce227 yy1 yy2 yy3 yy4}; YYM.pure (YYNTimpurenativedef yyr, yyvs)}; private yyprod227 yyvals = yybadprod 227 yyvals; -private yyprod228 ((_, (YYNTrho yy1)):yyvs) = do { let {!yyr = reduce228 yy1}; YYM.pure (YYNTsigma yyr, yyvs)}; +private yyprod228 ((_, (YYNTforall yy1)):yyvs) = YYM.pure (YYNTsigma (yy1), yyvs); private yyprod228 yyvals = yybadprod 228 yyvals; -private yyprod229 ((_, (YYNTrho yy4)):(_, (YYNTmbdot yy3)):(_, (YYNTdvars yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce229 yy1 yy2 yy3 yy4}; YYM.pure (YYNTforall yyr, yyvs)}; +private yyprod229 ((_, (YYNTrho yy1)):yyvs) = do { let {!yyr = reduce229 yy1}; YYM.pure (YYNTsigma yyr, yyvs)}; private yyprod229 yyvals = yybadprod 229 yyvals; -private yyprod230 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTmbdot (yy1), yyvs); +private yyprod230 ((_, (YYNTrho yy4)):(_, (YYNTmbdot yy3)):(_, (YYNTdvars yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce230 yy1 yy2 yy3 yy4}; YYM.pure (YYNTforall yyr, yyvs)}; private yyprod230 yyvals = yybadprod 230 yyvals; -private yyprod231 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce231 yy1 ;YYM.pure (YYNTmbdot yyr, yyvs)}; +private yyprod231 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTmbdot (yy1), yyvs); private yyprod231 yyvals = yybadprod 231 yyvals; -private yyprod232 ((_, (YYNTrhofun yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { yyr <- reduce232 yy1 yy2 yy3 ;YYM.pure (YYNTrho yyr, yyvs)}; +private yyprod232 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce232 yy1 ;YYM.pure (YYNTmbdot yyr, yyvs)}; private yyprod232 yyvals = yybadprod 232 yyvals; -private yyprod233 ((_, (YYNTrhofun yy1)):yyvs) = YYM.pure (YYNTrho (yy1), yyvs); +private yyprod233 ((_, (YYNTrhofun yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { yyr <- reduce233 yy1 yy2 yy3 ;YYM.pure (YYNTrho yyr, yyvs)}; private yyprod233 yyvals = yybadprod 233 yyvals; -private yyprod234 ((_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce234 yy1}; YYM.pure (YYNTrhofun yyr, yyvs)}; +private yyprod234 ((_, (YYNTrhofun yy1)):yyvs) = YYM.pure (YYNTrho (yy1), yyvs); private yyprod234 yyvals = yybadprod 234 yyvals; -private yyprod235 ((_, (YYNTrhofun yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce235 yy1 yy2 yy3}; YYM.pure (YYNTrhofun yyr, yyvs)}; +private yyprod235 ((_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce235 yy1}; YYM.pure (YYNTrhofun yyr, yyvs)}; private yyprod235 yyvals = yybadprod 235 yyvals; -private yyprod236 ((_, (YYNTtapp yy1)):yyvs) = YYM.pure (YYNTtau (yy1), yyvs); +private yyprod236 ((_, (YYNTrhofun yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce236 yy1 yy2 yy3}; YYM.pure (YYNTrhofun yyr, yyvs)}; private yyprod236 yyvals = yybadprod 236 yyvals; -private yyprod237 ((_, (YYNTforall yy1)):yyvs) = do { let {!yyr = reduce237 yy1}; YYM.pure (YYNTtau yyr, yyvs)}; +private yyprod237 ((_, (YYNTtapp yy1)):yyvs) = YYM.pure (YYNTtau (yy1), yyvs); private yyprod237 yyvals = yybadprod 237 yyvals; -private yyprod238 ((_, (YYNTtau yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce238 yy1 yy2 yy3}; YYM.pure (YYNTtau yyr, yyvs)}; +private yyprod238 ((_, (YYNTforall yy1)):yyvs) = do { let {!yyr = reduce238 yy1}; YYM.pure (YYNTtau yyr, yyvs)}; private yyprod238 yyvals = yybadprod 238 yyvals; -private yyprod239 ((_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce239 yy1}; YYM.pure (YYNTtauSC yyr, yyvs)}; +private yyprod239 ((_, (YYNTtau yy3)):(_, (YYTok yy2)):(_, (YYNTtapp yy1)):yyvs) = do { let {!yyr = reduce239 yy1 yy2 yy3}; YYM.pure (YYNTtau yyr, yyvs)}; private yyprod239 yyvals = yybadprod 239 yyvals; -private yyprod240 ((_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce240 yy1 yy2 yy3}; YYM.pure (YYNTtauSC yyr, yyvs)}; +private yyprod240 ((_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce240 yy1}; YYM.pure (YYNTtauSC yyr, yyvs)}; private yyprod240 yyvals = yybadprod 240 yyvals; -private yyprod241 ((_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce241 yy1}; YYM.pure (YYNTtauSB yyr, yyvs)}; +private yyprod241 ((_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce241 yy1 yy2 yy3}; YYM.pure (YYNTtauSC yyr, yyvs)}; private yyprod241 yyvals = yybadprod 241 yyvals; -private yyprod242 ((_, (YYNTtauSB yy3)):(_, (YYTok yy2)):(_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce242 yy1 yy2 yy3}; YYM.pure (YYNTtauSB yyr, yyvs)}; +private yyprod242 ((_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce242 yy1}; YYM.pure (YYNTtauSB yyr, yyvs)}; private yyprod242 yyvals = yybadprod 242 yyvals; -private yyprod243 ((_, (YYNTsimpletypes yy1)):yyvs) = do { let {!yyr = reduce243 yy1}; YYM.pure (YYNTtapp yyr, yyvs)}; +private yyprod243 ((_, (YYNTtauSB yy3)):(_, (YYTok yy2)):(_, (YYNTtau yy1)):yyvs) = do { let {!yyr = reduce243 yy1 yy2 yy3}; YYM.pure (YYNTtauSB yyr, yyvs)}; private yyprod243 yyvals = yybadprod 243 yyvals; -private yyprod244 ((_, (YYNTtyvar yy1)):yyvs) = YYM.pure (YYNTsimpletype (yy1), yyvs); +private yyprod244 ((_, (YYNTsimpletypes yy1)):yyvs) = do { let {!yyr = reduce244 yy1}; YYM.pure (YYNTtapp yyr, yyvs)}; private yyprod244 yyvals = yybadprod 244 yyvals; -private yyprod245 ((_, (YYNTtyname yy1)):yyvs) = do { let {!yyr = reduce245 yy1}; YYM.pure (YYNTsimpletype yyr, yyvs)}; +private yyprod245 ((_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce245 yy1}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod245 yyvals = yybadprod 245 yyvals; -private yyprod246 ((_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce246 yy1 yy2 yy3}; YYM.pure (YYNTsimpletype yyr, yyvs)}; +private yyprod246 ((_, (YYNTtyname yy1)):yyvs) = do { let {!yyr = reduce246 yy1}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod246 yyvals = yybadprod 246 yyvals; -private yyprod247 ((_, (YYTok yy5)):(_, (YYNTtauSC yy4)):(_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce247 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTsimpletype yyr, yyvs)}; +private yyprod247 ((_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce247 yy1 yy2 yy3}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod247 yyvals = yybadprod 247 yyvals; -private yyprod248 ((_, (YYTok yy5)):(_, (YYNTtauSB yy4)):(_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce248 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTsimpletype yyr, yyvs)}; +private yyprod248 ((_, (YYTok yy5)):(_, (YYNTtauSC yy4)):(_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce248 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod248 yyvals = yybadprod 248 yyvals; -private yyprod249 ((_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce249 yy1 yy2 yy3}; YYM.pure (YYNTsimpletype yyr, yyvs)}; +private yyprod249 ((_, (YYTok yy5)):(_, (YYNTtauSB yy4)):(_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce249 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod249 yyvals = yybadprod 249 yyvals; -private yyprod250 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce250 yy1}; YYM.pure (YYNTtyvar yyr, yyvs)}; +private yyprod250 ((_, (YYTok yy3)):(_, (YYNTtau yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce250 yy1 yy2 yy3}; YYM.pure (YYNTsimpletype yyr, yyvs)}; private yyprod250 yyvals = yybadprod 250 yyvals; -private yyprod251 ((_, (YYTok yy5)):(_, (YYNTkind yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce251 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtyvar yyr, yyvs)}; +private yyprod251 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce251 yy1}; YYM.pure (YYNTtyvar yyr, yyvs)}; private yyprod251 yyvals = yybadprod 251 yyvals; -private yyprod252 ((_, (YYTok yy5)):(_, (YYNTtauSC yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce252 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtyvar yyr, yyvs)}; +private yyprod252 ((_, (YYTok yy5)):(_, (YYNTkind yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce252 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtyvar yyr, yyvs)}; private yyprod252 yyvals = yybadprod 252 yyvals; -private yyprod253 ((_, (YYTok yy4)):(_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce253 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtyvar yyr, yyvs)}; +private yyprod253 ((_, (YYTok yy5)):(_, (YYNTtauSC yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce253 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtyvar yyr, yyvs)}; private yyprod253 yyvals = yybadprod 253 yyvals; -private yyprod254 ((_, (YYTok yy4)):(_, (YYNTtapp yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce254 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtyvar yyr, yyvs)}; +private yyprod254 ((_, (YYTok yy4)):(_, (YYNTtauSC yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce254 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtyvar yyr, yyvs)}; private yyprod254 yyvals = yybadprod 254 yyvals; -private yyprod255 ((_, (YYNTqconid yy1)):yyvs) = YYM.pure (YYNTtyname (yy1), yyvs); +private yyprod255 ((_, (YYTok yy4)):(_, (YYNTtapp yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce255 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtyvar yyr, yyvs)}; private yyprod255 yyvals = yybadprod 255 yyvals; -private yyprod256 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce256 yy1 yy2}; YYM.pure (YYNTtyname yyr, yyvs)}; +private yyprod256 ((_, (YYNTqconid yy1)):yyvs) = YYM.pure (YYNTtyname (yy1), yyvs); private yyprod256 yyvals = yybadprod 256 yyvals; private yyprod257 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce257 yy1 yy2}; YYM.pure (YYNTtyname yyr, yyvs)}; private yyprod257 yyvals = yybadprod 257 yyvals; -private yyprod258 ((_, (YYTok yy3)):(_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce258 yy1 yy2 yy3}; YYM.pure (YYNTtyname yyr, yyvs)}; +private yyprod258 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce258 yy1 yy2}; YYM.pure (YYNTtyname yyr, yyvs)}; private yyprod258 yyvals = yybadprod 258 yyvals; -private yyprod259 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce259 yy1 yy2 yy3}; YYM.pure (YYNTtyname yyr, yyvs)}; +private yyprod259 ((_, (YYTok yy3)):(_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce259 yy1 yy2 yy3}; YYM.pure (YYNTtyname yyr, yyvs)}; private yyprod259 yyvals = yybadprod 259 yyvals; -private yyprod260 ((_, (YYNTkind yy3)):(_, (YYTok yy2)):(_, (YYNTsimplekind yy1)):yyvs) = do { let {!yyr = reduce260 yy1 yy2 yy3}; YYM.pure (YYNTkind yyr, yyvs)}; +private yyprod260 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce260 yy1 yy2 yy3}; YYM.pure (YYNTtyname yyr, yyvs)}; private yyprod260 yyvals = yybadprod 260 yyvals; -private yyprod261 ((_, (YYNTsimplekind yy1)):yyvs) = YYM.pure (YYNTkind (yy1), yyvs); +private yyprod261 ((_, (YYNTkind yy3)):(_, (YYTok yy2)):(_, (YYNTsimplekind yy1)):yyvs) = do { let {!yyr = reduce261 yy1 yy2 yy3}; YYM.pure (YYNTkind yyr, yyvs)}; private yyprod261 yyvals = yybadprod 261 yyvals; -private yyprod262 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce262 yy1 ;YYM.pure (YYNTsimplekind yyr, yyvs)}; +private yyprod262 ((_, (YYNTsimplekind yy1)):yyvs) = YYM.pure (YYNTkind (yy1), yyvs); private yyprod262 yyvals = yybadprod 262 yyvals; -private yyprod263 ((_, (YYTok yy3)):(_, (YYNTkind yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce263 yy1 yy2 yy3}; YYM.pure (YYNTsimplekind yyr, yyvs)}; +private yyprod263 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce263 yy1 ;YYM.pure (YYNTsimplekind yyr, yyvs)}; private yyprod263 yyvals = yybadprod 263 yyvals; -private yyprod264 ((_, (YYNTtyvar yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce264 yy1 yy2}; YYM.pure (YYNTscontext yyr, yyvs)}; +private yyprod264 ((_, (YYTok yy3)):(_, (YYNTkind yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce264 yy1 yy2 yy3}; YYM.pure (YYNTsimplekind yyr, yyvs)}; private yyprod264 yyvals = yybadprod 264 yyvals; -private yyprod265 ((_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce265 yy1}; YYM.pure (YYNTscontexts yyr, yyvs)}; +private yyprod265 ((_, (YYNTtyvar yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce265 yy1 yy2}; YYM.pure (YYNTscontext yyr, yyvs)}; private yyprod265 yyvals = yybadprod 265 yyvals; -private yyprod266 ((_, (YYTok yy2)):(_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce266 yy1 yy2}; YYM.pure (YYNTscontexts yyr, yyvs)}; +private yyprod266 ((_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce266 yy1}; YYM.pure (YYNTscontexts yyr, yyvs)}; private yyprod266 yyvals = yybadprod 266 yyvals; -private yyprod267 ((_, (YYNTscontexts yy3)):(_, (YYTok yy2)):(_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce267 yy1 yy2 yy3}; YYM.pure (YYNTscontexts yyr, yyvs)}; +private yyprod267 ((_, (YYTok yy2)):(_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce267 yy1 yy2}; YYM.pure (YYNTscontexts yyr, yyvs)}; private yyprod267 yyvals = yybadprod 267 yyvals; -private yyprod268 ((_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce268 yy1}; YYM.pure (YYNTccontext yyr, yyvs)}; +private yyprod268 ((_, (YYNTscontexts yy3)):(_, (YYTok yy2)):(_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce268 yy1 yy2 yy3}; YYM.pure (YYNTscontexts yyr, yyvs)}; private yyprod268 yyvals = yybadprod 268 yyvals; -private yyprod269 ((_, (YYTok yy3)):(_, (YYNTscontexts yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce269 yy1 yy2 yy3}; YYM.pure (YYNTccontext yyr, yyvs)}; +private yyprod269 ((_, (YYNTscontext yy1)):yyvs) = do { let {!yyr = reduce269 yy1}; YYM.pure (YYNTccontext yyr, yyvs)}; private yyprod269 yyvals = yybadprod 269 yyvals; -private yyprod270 ((_, (YYNTwheredef yy6)):(_, (YYNTtyvar yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTccontext yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce270 yy1 yy2 yy3 yy4 yy5 yy6 ;YYM.pure (YYNTclassdef yyr, yyvs)}; +private yyprod270 ((_, (YYTok yy3)):(_, (YYNTscontexts yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce270 yy1 yy2 yy3}; YYM.pure (YYNTccontext yyr, yyvs)}; private yyprod270 yyvals = yybadprod 270 yyvals; -private yyprod271 ((_, (YYNTwheredef yy3)):(_, (YYNTccontext yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce271 yy1 yy2 yy3 ;YYM.pure (YYNTclassdef yyr, yyvs)}; +private yyprod271 ((_, (YYNTwheredef yy6)):(_, (YYNTtyvar yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTccontext yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce271 yy1 yy2 yy3 yy4 yy5 yy6 ;YYM.pure (YYNTclassdef yyr, yyvs)}; private yyprod271 yyvals = yybadprod 271 yyvals; -private yyprod272 ((_, (YYNTsimpletype yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce272 yy1 yy2}; YYM.pure (YYNTsicontext yyr, yyvs)}; +private yyprod272 ((_, (YYNTwheredef yy3)):(_, (YYNTccontext yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce272 yy1 yy2 yy3 ;YYM.pure (YYNTclassdef yyr, yyvs)}; private yyprod272 yyvals = yybadprod 272 yyvals; -private yyprod273 ((_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce273 yy1}; YYM.pure (YYNTsicontexts yyr, yyvs)}; +private yyprod273 ((_, (YYNTsimpletype yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce273 yy1 yy2}; YYM.pure (YYNTsicontext yyr, yyvs)}; private yyprod273 yyvals = yybadprod 273 yyvals; -private yyprod274 ((_, (YYTok yy2)):(_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce274 yy1 yy2}; YYM.pure (YYNTsicontexts yyr, yyvs)}; +private yyprod274 ((_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce274 yy1}; YYM.pure (YYNTsicontexts yyr, yyvs)}; private yyprod274 yyvals = yybadprod 274 yyvals; -private yyprod275 ((_, (YYNTsicontexts yy3)):(_, (YYTok yy2)):(_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce275 yy1 yy2 yy3}; YYM.pure (YYNTsicontexts yyr, yyvs)}; +private yyprod275 ((_, (YYTok yy2)):(_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce275 yy1 yy2}; YYM.pure (YYNTsicontexts yyr, yyvs)}; private yyprod275 yyvals = yybadprod 275 yyvals; -private yyprod276 ((_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce276 yy1}; YYM.pure (YYNTicontext yyr, yyvs)}; +private yyprod276 ((_, (YYNTsicontexts yy3)):(_, (YYTok yy2)):(_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce276 yy1 yy2 yy3}; YYM.pure (YYNTsicontexts yyr, yyvs)}; private yyprod276 yyvals = yybadprod 276 yyvals; -private yyprod277 ((_, (YYTok yy3)):(_, (YYNTsicontexts yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce277 yy1 yy2 yy3}; YYM.pure (YYNTicontext yyr, yyvs)}; +private yyprod277 ((_, (YYNTsicontext yy1)):yyvs) = do { let {!yyr = reduce277 yy1}; YYM.pure (YYNTicontext yyr, yyvs)}; private yyprod277 yyvals = yybadprod 277 yyvals; -private yyprod278 ((_, (YYNTsimpletype yy4)):(_, (YYNTtyname yy3)):(_, (YYTok yy2)):(_, (YYNTicontext yy1)):yyvs) = do { let {!yyr = reduce278 yy1 yy2 yy3 yy4}; YYM.pure (YYNTinsthead yyr, yyvs)}; +private yyprod278 ((_, (YYTok yy3)):(_, (YYNTsicontexts yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce278 yy1 yy2 yy3}; YYM.pure (YYNTicontext yyr, yyvs)}; private yyprod278 yyvals = yybadprod 278 yyvals; -private yyprod279 ((_, (YYNTicontext yy1)):yyvs) = do { yyr <- reduce279 yy1 ;YYM.pure (YYNTinsthead yyr, yyvs)}; +private yyprod279 ((_, (YYNTsimpletype yy4)):(_, (YYNTtyname yy3)):(_, (YYTok yy2)):(_, (YYNTicontext yy1)):yyvs) = do { let {!yyr = reduce279 yy1 yy2 yy3 yy4}; YYM.pure (YYNTinsthead yyr, yyvs)}; private yyprod279 yyvals = yybadprod 279 yyvals; -private yyprod280 ((_, (YYNTwheredef yy3)):(_, (YYNTinsthead yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce280 yy1 yy2 yy3}; YYM.pure (YYNTinstdef yyr, yyvs)}; +private yyprod280 ((_, (YYNTicontext yy1)):yyvs) = do { yyr <- reduce280 yy1 ;YYM.pure (YYNTinsthead yyr, yyvs)}; private yyprod280 yyvals = yybadprod 280 yyvals; -private yyprod281 ((_, (YYNTinsthead yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce281 yy1 yy2}; YYM.pure (YYNTderivedef yyr, yyvs)}; +private yyprod281 ((_, (YYNTwheredef yy3)):(_, (YYNTinsthead yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce281 yy1 yy2 yy3}; YYM.pure (YYNTinstdef yyr, yyvs)}; private yyprod281 yyvals = yybadprod 281 yyvals; -private yyprod282 ((_, (YYNTwheredef yy2)):(_, (YYNTdatainit yy1)):yyvs) = do { let {!yyr = reduce282 yy1 yy2}; YYM.pure (YYNTdatadef yyr, yyvs)}; +private yyprod282 ((_, (YYNTinsthead yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce282 yy1 yy2}; YYM.pure (YYNTderivedef yyr, yyvs)}; private yyprod282 yyvals = yybadprod 282 yyvals; -private yyprod283 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce283 yy1 yy2}; YYM.pure (YYNTnativepur yyr, yyvs)}; +private yyprod283 ((_, (YYNTwheredef yy2)):(_, (YYNTdatainit yy1)):yyvs) = do { let {!yyr = reduce283 yy1 yy2}; YYM.pure (YYNTdatadef yyr, yyvs)}; private yyprod283 yyvals = yybadprod 283 yyvals; -private yyprod284 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce284 yy1}; YYM.pure (YYNTnativepur yyr, yyvs)}; +private yyprod284 ((_, (YYNTwheredef yy2)):(_, (YYNTdatajavainit yy1)):yyvs) = do { let {!yyr = reduce284 yy1 yy2}; YYM.pure (YYNTdatajavadef yyr, yyvs)}; private yyprod284 yyvals = yybadprod 284 yyvals; -private yyprod285 ((_, (YYNTnativename yy1)):yyvs) = do { let {!yyr = reduce285 yy1}; YYM.pure (YYNTnativespec yyr, yyvs)}; +private yyprod285 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce285 yy1 yy2}; YYM.pure (YYNTnativepur yyr, yyvs)}; private yyprod285 yyvals = yybadprod 285 yyvals; -private yyprod286 ((_, (YYNTgargs yy2)):(_, (YYNTnativename yy1)):yyvs) = do { let {!yyr = reduce286 yy1 yy2}; YYM.pure (YYNTnativespec yyr, yyvs)}; +private yyprod286 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce286 yy1}; YYM.pure (YYNTnativepur yyr, yyvs)}; private yyprod286 yyvals = yybadprod 286 yyvals; -private yyprod287 ((_, (YYTok yy3)):(_, (YYNTtauSC yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce287 yy1 yy2 yy3}; YYM.pure (YYNTgargs yyr, yyvs)}; +private yyprod287 ((_, (YYNTnativename yy1)):yyvs) = do { let {!yyr = reduce287 yy1}; YYM.pure (YYNTnativespec yyr, yyvs)}; private yyprod287 yyvals = yybadprod 287 yyvals; -private yyprod288 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce288 yy1 yy2}; YYM.pure (YYNTgargs yyr, yyvs)}; +private yyprod288 ((_, (YYNTgargs yy2)):(_, (YYNTnativename yy1)):yyvs) = do { let {!yyr = reduce288 yy1 yy2}; YYM.pure (YYNTnativespec yyr, yyvs)}; private yyprod288 yyvals = yybadprod 288 yyvals; -private yyprod289 ((_, (YYNTnativespec yy5)):(_, (YYNTnativepur yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce289 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod289 ((_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce289 yy1}; YYM.pure (YYNTgargvars yyr, yyvs)}; private yyprod289 yyvals = yybadprod 289 yyvals; -private yyprod290 ((_, (YYNTnativespec yy6)):(_, (YYNTnativepur yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce290 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod290 ((_, (YYNTgargvars yy3)):(_, (YYTok yy2)):(_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce290 yy1 yy2 yy3}; YYM.pure (YYNTgargvars yyr, yyvs)}; private yyprod290 yyvals = yybadprod 290 yyvals; -private yyprod291 ((_, (YYNTdalts yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce291 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod291 ((_, (YYTok yy3)):(_, (YYNTgargvars yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce291 yy1 yy2 yy3}; YYM.pure (YYNTgargs yyr, yyvs)}; private yyprod291 yyvals = yybadprod 291 yyvals; -private yyprod292 ((_, (YYNTdalts yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce292 yy1 yy2 yy3 yy4}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod292 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce292 yy1 yy2}; YYM.pure (YYNTgargs yyr, yyvs)}; private yyprod292 yyvals = yybadprod 292 yyvals; -private yyprod293 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce293 yy1 yy2}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod293 ((_, (YYNTdalts yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce293 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatainit yyr, yyvs)}; private yyprod293 yyvals = yybadprod 293 yyvals; -private yyprod294 ((_, (YYNTdalt yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce294 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod294 ((_, (YYNTdalts yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce294 yy1 yy2 yy3 yy4}; YYM.pure (YYNTdatainit yyr, yyvs)}; private yyprod294 yyvals = yybadprod 294 yyvals; -private yyprod295 ((_, (YYNTdalt yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce295 yy1 yy2 yy3 yy4}; YYM.pure (YYNTdatainit yyr, yyvs)}; +private yyprod295 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce295 yy1 yy2}; YYM.pure (YYNTdatainit yyr, yyvs)}; private yyprod295 yyvals = yybadprod 295 yyvals; -private yyprod296 ((_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce296 yy1}; YYM.pure (YYNTdvars yyr, yyvs)}; +private yyprod296 ((_, (YYNTdalt yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce296 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatainit yyr, yyvs)}; private yyprod296 yyvals = yybadprod 296 yyvals; -private yyprod297 ((_, (YYNTdvars yy2)):(_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce297 yy1 yy2}; YYM.pure (YYNTdvars yyr, yyvs)}; +private yyprod297 ((_, (YYNTdalt yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce297 yy1 yy2 yy3 yy4}; YYM.pure (YYNTdatainit yyr, yyvs)}; private yyprod297 yyvals = yybadprod 297 yyvals; -private yyprod298 ((_, (YYNTdalt yy1)):yyvs) = do { let {!yyr = reduce298 yy1}; YYM.pure (YYNTdalts yyr, yyvs)}; +private yyprod298 ((_, (YYNTnativespec yy5)):(_, (YYNTnativepur yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce298 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTdatajavainit yyr, yyvs)}; private yyprod298 yyvals = yybadprod 298 yyvals; -private yyprod299 ((_, (YYNTdalts yy3)):(_, (YYTok yy2)):(_, (YYNTdalt yy1)):yyvs) = do { let {!yyr = reduce299 yy1 yy2 yy3}; YYM.pure (YYNTdalts yyr, yyvs)}; +private yyprod299 ((_, (YYNTnativespec yy6)):(_, (YYNTnativepur yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce299 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTdatajavainit yyr, yyvs)}; private yyprod299 yyvals = yybadprod 299 yyvals; -private yyprod300 ((_, (YYNTvisdalt yy1)):yyvs) = YYM.pure (YYNTdalt (yy1), yyvs); +private yyprod300 ((_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce300 yy1}; YYM.pure (YYNTdvars yyr, yyvs)}; private yyprod300 yyvals = yybadprod 300 yyvals; -private yyprod301 ((_, (YYTok yy2)):(_, (YYNTvisdalt yy1)):yyvs) = do { let {!yyr = reduce301 yy1 yy2}; YYM.pure (YYNTdalt yyr, yyvs)}; +private yyprod301 ((_, (YYNTdvars yy2)):(_, (YYNTtyvar yy1)):yyvs) = do { let {!yyr = reduce301 yy1 yy2}; YYM.pure (YYNTdvars yyr, yyvs)}; private yyprod301 yyvals = yybadprod 301 yyvals; -private yyprod302 ((_, (YYNTvisdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce302 yy1 yy2}; YYM.pure (YYNTdalt yyr, yyvs)}; +private yyprod302 ((_, (YYNTdalt yy1)):yyvs) = do { let {!yyr = reduce302 yy1}; YYM.pure (YYNTdalts yyr, yyvs)}; private yyprod302 yyvals = yybadprod 302 yyvals; -private yyprod303 ((_, (YYNTstrictdalt yy1)):yyvs) = YYM.pure (YYNTvisdalt (yy1), yyvs); +private yyprod303 ((_, (YYNTdalts yy3)):(_, (YYTok yy2)):(_, (YYNTdalt yy1)):yyvs) = do { let {!yyr = reduce303 yy1 yy2 yy3}; YYM.pure (YYNTdalts yyr, yyvs)}; private yyprod303 yyvals = yybadprod 303 yyvals; -private yyprod304 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce304 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; +private yyprod304 ((_, (YYNTvisdalt yy1)):yyvs) = YYM.pure (YYNTdalt (yy1), yyvs); private yyprod304 yyvals = yybadprod 304 yyvals; -private yyprod305 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce305 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; +private yyprod305 ((_, (YYTok yy2)):(_, (YYNTvisdalt yy1)):yyvs) = do { let {!yyr = reduce305 yy1 yy2}; YYM.pure (YYNTdalt yyr, yyvs)}; private yyprod305 yyvals = yybadprod 305 yyvals; -private yyprod306 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce306 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; +private yyprod306 ((_, (YYNTvisdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce306 yy1 yy2}; YYM.pure (YYNTdalt yyr, yyvs)}; private yyprod306 yyvals = yybadprod 306 yyvals; -private yyprod307 ((_, (YYNTsimpledalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce307 yy1 yy2}; YYM.pure (YYNTstrictdalt yyr, yyvs)}; +private yyprod307 ((_, (YYNTstrictdalt yy1)):yyvs) = YYM.pure (YYNTvisdalt (yy1), yyvs); private yyprod307 yyvals = yybadprod 307 yyvals; -private yyprod308 ((_, (YYNTsimpledalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce308 yy1 yy2}; YYM.pure (YYNTstrictdalt yyr, yyvs)}; +private yyprod308 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce308 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; private yyprod308 yyvals = yybadprod 308 yyvals; -private yyprod309 ((_, (YYNTsimpledalt yy1)):yyvs) = YYM.pure (YYNTstrictdalt (yy1), yyvs); +private yyprod309 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce309 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; private yyprod309 yyvals = yybadprod 309 yyvals; -private yyprod310 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce310 yy1}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; +private yyprod310 ((_, (YYNTstrictdalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce310 yy1 yy2}; YYM.pure (YYNTvisdalt yyr, yyvs)}; private yyprod310 yyvals = yybadprod 310 yyvals; -private yyprod311 ((_, (YYTok yy4)):(_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce311 yy1 yy2 yy3 yy4}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; +private yyprod311 ((_, (YYNTsimpledalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce311 yy1 yy2}; YYM.pure (YYNTstrictdalt yyr, yyvs)}; private yyprod311 yyvals = yybadprod 311 yyvals; -private yyprod312 ((_, (YYNTcontypes yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce312 yy1 yy2}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; +private yyprod312 ((_, (YYNTsimpledalt yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce312 yy1 yy2}; YYM.pure (YYNTstrictdalt yyr, yyvs)}; private yyprod312 yyvals = yybadprod 312 yyvals; -private yyprod313 ((_, (YYNTstrictcontype yy1)):yyvs) = do { let {!yyr = reduce313 yy1}; YYM.pure (YYNTcontypes yyr, yyvs)}; +private yyprod313 ((_, (YYNTsimpledalt yy1)):yyvs) = YYM.pure (YYNTstrictdalt (yy1), yyvs); private yyprod313 yyvals = yybadprod 313 yyvals; -private yyprod314 ((_, (YYNTcontypes yy2)):(_, (YYNTstrictcontype yy1)):yyvs) = do { let {!yyr = reduce314 yy1 yy2}; YYM.pure (YYNTcontypes yyr, yyvs)}; +private yyprod314 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce314 yy1}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; private yyprod314 yyvals = yybadprod 314 yyvals; -private yyprod315 ((_, (YYNTcontype yy1)):yyvs) = YYM.pure (YYNTstrictcontype (yy1), yyvs); +private yyprod315 ((_, (YYTok yy4)):(_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce315 yy1 yy2 yy3 yy4}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; private yyprod315 yyvals = yybadprod 315 yyvals; -private yyprod316 ((_, (YYNTcontype yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce316 yy1 yy2}; YYM.pure (YYNTstrictcontype yyr, yyvs)}; +private yyprod316 ((_, (YYNTcontypes yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce316 yy1 yy2}; YYM.pure (YYNTsimpledalt yyr, yyvs)}; private yyprod316 yyvals = yybadprod 316 yyvals; -private yyprod317 ((_, (YYNTcontype yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce317 yy1 yy2}; YYM.pure (YYNTstrictcontype yyr, yyvs)}; +private yyprod317 ((_, (YYNTstrictcontype yy1)):yyvs) = do { let {!yyr = reduce317 yy1}; YYM.pure (YYNTcontypes yyr, yyvs)}; private yyprod317 yyvals = yybadprod 317 yyvals; -private yyprod318 ((_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce318 yy1}; YYM.pure (YYNTcontype yyr, yyvs)}; +private yyprod318 ((_, (YYNTcontypes yy2)):(_, (YYNTstrictcontype yy1)):yyvs) = do { let {!yyr = reduce318 yy1 yy2}; YYM.pure (YYNTcontypes yyr, yyvs)}; private yyprod318 yyvals = yybadprod 318 yyvals; -private yyprod319 ((_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce319 yy1}; YYM.pure (YYNTsimpletypes yyr, yyvs)}; +private yyprod319 ((_, (YYNTcontype yy1)):yyvs) = YYM.pure (YYNTstrictcontype (yy1), yyvs); private yyprod319 yyvals = yybadprod 319 yyvals; -private yyprod320 ((_, (YYNTsimpletypes yy2)):(_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce320 yy1 yy2}; YYM.pure (YYNTsimpletypes yyr, yyvs)}; +private yyprod320 ((_, (YYNTcontype yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce320 yy1 yy2}; YYM.pure (YYNTstrictcontype yyr, yyvs)}; private yyprod320 yyvals = yybadprod 320 yyvals; -private yyprod321 ((_, (YYNTconfld yy1)):yyvs) = YYM.pure (YYNTconflds (yy1), yyvs); +private yyprod321 ((_, (YYNTcontype yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce321 yy1 yy2}; YYM.pure (YYNTstrictcontype yyr, yyvs)}; private yyprod321 yyvals = yybadprod 321 yyvals; -private yyprod322 ((_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce322 yy1 yy2}; YYM.pure (YYNTconflds yyr, yyvs)}; +private yyprod322 ((_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce322 yy1}; YYM.pure (YYNTcontype yyr, yyvs)}; private yyprod322 yyvals = yybadprod 322 yyvals; -private yyprod323 ((_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce323 yy1 yy2}; YYM.pure (YYNTconflds yyr, yyvs)}; +private yyprod323 ((_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce323 yy1}; YYM.pure (YYNTsimpletypes yyr, yyvs)}; private yyprod323 yyvals = yybadprod 323 yyvals; -private yyprod324 ((_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce324 yy1 yy2 yy3}; YYM.pure (YYNTconflds yyr, yyvs)}; +private yyprod324 ((_, (YYNTsimpletypes yy2)):(_, (YYNTsimpletype yy1)):yyvs) = do { let {!yyr = reduce324 yy1 yy2}; YYM.pure (YYNTsimpletypes yyr, yyvs)}; private yyprod324 yyvals = yybadprod 324 yyvals; -private yyprod325 ((_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce325 yy1 yy2 yy3}; YYM.pure (YYNTconflds yyr, yyvs)}; +private yyprod325 ((_, (YYNTconfld yy1)):yyvs) = YYM.pure (YYNTconflds (yy1), yyvs); private yyprod325 yyvals = yybadprod 325 yyvals; -private yyprod326 ((_, (YYNTsigma yy4)):(_, (YYTok yy3)):(_, (YYNTfldids yy2)):(_, (YYNTdocsO yy1)):yyvs) = do { let {!yyr = reduce326 yy1 yy2 yy3 yy4}; YYM.pure (YYNTconfld yyr, yyvs)}; +private yyprod326 ((_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce326 yy1 yy2}; YYM.pure (YYNTconflds yyr, yyvs)}; private yyprod326 yyvals = yybadprod 326 yyvals; -private yyprod327 ((_, (YYNTfldid yy1)):yyvs) = do { let {!yyr = reduce327 yy1}; YYM.pure (YYNTfldids yyr, yyvs)}; +private yyprod327 ((_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce327 yy1 yy2}; YYM.pure (YYNTconflds yyr, yyvs)}; private yyprod327 yyvals = yybadprod 327 yyvals; -private yyprod328 ((_, (YYNTfldids yy3)):(_, (YYTok yy2)):(_, (YYNTfldid yy1)):yyvs) = do { let {!yyr = reduce328 yy1 yy2 yy3}; YYM.pure (YYNTfldids yyr, yyvs)}; +private yyprod328 ((_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce328 yy1 yy2 yy3}; YYM.pure (YYNTconflds yyr, yyvs)}; private yyprod328 yyvals = yybadprod 328 yyvals; -private yyprod329 ((_, (YYNTstrictfldid yy1)):yyvs) = YYM.pure (YYNTfldid (yy1), yyvs); +private yyprod329 ((_, (YYNTconflds yy3)):(_, (YYTok yy2)):(_, (YYNTconfld yy1)):yyvs) = do { let {!yyr = reduce329 yy1 yy2 yy3}; YYM.pure (YYNTconflds yyr, yyvs)}; private yyprod329 yyvals = yybadprod 329 yyvals; -private yyprod330 ((_, (YYNTstrictfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce330 yy1 yy2}; YYM.pure (YYNTfldid yyr, yyvs)}; +private yyprod330 ((_, (YYNTsigma yy4)):(_, (YYTok yy3)):(_, (YYNTfldids yy2)):(_, (YYNTdocsO yy1)):yyvs) = do { let {!yyr = reduce330 yy1 yy2 yy3 yy4}; YYM.pure (YYNTconfld yyr, yyvs)}; private yyprod330 yyvals = yybadprod 330 yyvals; -private yyprod331 ((_, (YYNTstrictfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce331 yy1 yy2}; YYM.pure (YYNTfldid yyr, yyvs)}; +private yyprod331 ((_, (YYNTfldid yy1)):yyvs) = do { let {!yyr = reduce331 yy1}; YYM.pure (YYNTfldids yyr, yyvs)}; private yyprod331 yyvals = yybadprod 331 yyvals; -private yyprod332 ((_, (YYNTplainfldid yy1)):yyvs) = YYM.pure (YYNTstrictfldid (yy1), yyvs); +private yyprod332 ((_, (YYNTfldids yy3)):(_, (YYTok yy2)):(_, (YYNTfldid yy1)):yyvs) = do { let {!yyr = reduce332 yy1 yy2 yy3}; YYM.pure (YYNTfldids yyr, yyvs)}; private yyprod332 yyvals = yybadprod 332 yyvals; -private yyprod333 ((_, (YYNTplainfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce333 yy1 yy2}; YYM.pure (YYNTstrictfldid yyr, yyvs)}; +private yyprod333 ((_, (YYNTstrictfldid yy1)):yyvs) = YYM.pure (YYNTfldid (yy1), yyvs); private yyprod333 yyvals = yybadprod 333 yyvals; -private yyprod334 ((_, (YYNTplainfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce334 yy1 yy2}; YYM.pure (YYNTstrictfldid yyr, yyvs)}; +private yyprod334 ((_, (YYNTstrictfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce334 yy1 yy2}; YYM.pure (YYNTfldid yyr, yyvs)}; private yyprod334 yyvals = yybadprod 334 yyvals; -private yyprod335 ((_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce335 yy1}; YYM.pure (YYNTplainfldid yyr, yyvs)}; +private yyprod335 ((_, (YYNTstrictfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce335 yy1 yy2}; YYM.pure (YYNTfldid yyr, yyvs)}; private yyprod335 yyvals = yybadprod 335 yyvals; -private yyprod336 ((_, (YYNTsigma yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce336 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtypedef yyr, yyvs)}; +private yyprod336 ((_, (YYNTplainfldid yy1)):yyvs) = YYM.pure (YYNTstrictfldid (yy1), yyvs); private yyprod336 yyvals = yybadprod 336 yyvals; -private yyprod337 ((_, (YYNTsigma yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce337 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtypedef yyr, yyvs)}; +private yyprod337 ((_, (YYNTplainfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce337 yy1 yy2}; YYM.pure (YYNTstrictfldid yyr, yyvs)}; private yyprod337 yyvals = yybadprod 337 yyvals; -private yyprod338 yyvs = do { let {!yyr = reduce338 }; YYM.pure (YYNTwheredef yyr, yyvs)}; -private yyprod339 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce339 yy1 yy2 yy3}; YYM.pure (YYNTwheredef yyr, yyvs)}; +private yyprod338 ((_, (YYNTplainfldid yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce338 yy1 yy2}; YYM.pure (YYNTstrictfldid yyr, yyvs)}; +private yyprod338 yyvals = yybadprod 338 yyvals; +private yyprod339 ((_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce339 yy1}; YYM.pure (YYNTplainfldid yyr, yyvs)}; private yyprod339 yyvals = yybadprod 339 yyvals; -private yyprod340 ((_, (YYTok yy4)):(_, (YYNTlocaldefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce340 yy1 yy2 yy3 yy4}; YYM.pure (YYNTwheredef yyr, yyvs)}; +private yyprod340 ((_, (YYNTsigma yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce340 yy1 yy2 yy3 yy4}; YYM.pure (YYNTtypedef yyr, yyvs)}; private yyprod340 yyvals = yybadprod 340 yyvals; -private yyprod341 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce341 yy1 yy2 yy3}; YYM.pure (YYNTwherelet yyr, yyvs)}; +private yyprod341 ((_, (YYNTsigma yy5)):(_, (YYTok yy4)):(_, (YYNTdvars yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce341 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTtypedef yyr, yyvs)}; private yyprod341 yyvals = yybadprod 341 yyvals; -private yyprod342 ((_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce342 yy1 yy2 yy3 yy4}; YYM.pure (YYNTwherelet yyr, yyvs)}; -private yyprod342 yyvals = yybadprod 342 yyvals; -private yyprod343 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTfunhead yy1)):yyvs) = do { let {!yyr = reduce343 yy1 yy2 yy3}; YYM.pure (YYNTfundef yyr, yyvs)}; +private yyprod342 yyvs = do { let {!yyr = reduce342 }; YYM.pure (YYNTwheredef yyr, yyvs)}; +private yyprod343 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce343 yy1 yy2 yy3}; YYM.pure (YYNTwheredef yyr, yyvs)}; private yyprod343 yyvals = yybadprod 343 yyvals; -private yyprod344 ((_, (YYNTguards yy2)):(_, (YYNTfunhead yy1)):yyvs) = do { let {!yyr = reduce344 yy1 yy2}; YYM.pure (YYNTfundef yyr, yyvs)}; +private yyprod344 ((_, (YYTok yy4)):(_, (YYNTlocaldefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce344 yy1 yy2 yy3 yy4}; YYM.pure (YYNTwheredef yyr, yyvs)}; private yyprod344 yyvals = yybadprod 344 yyvals; -private yyprod345 ((_, (YYNTwherelet yy2)):(_, (YYNTfundef yy1)):yyvs) = do { yyr <- reduce345 yy1 yy2 ;YYM.pure (YYNTfundef yyr, yyvs)}; +private yyprod345 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce345 yy1 yy2 yy3}; YYM.pure (YYNTwherelet yyr, yyvs)}; private yyprod345 yyvals = yybadprod 345 yyvals; -private yyprod346 ((_, (YYNTbinex yy1)):yyvs) = do { yyr <- reduce346 yy1 ;YYM.pure (YYNTfunhead yyr, yyvs)}; +private yyprod346 ((_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce346 yy1 yy2 yy3 yy4}; YYM.pure (YYNTwherelet yyr, yyvs)}; private yyprod346 yyvals = yybadprod 346 yyvals; -private yyprod347 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce347 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod347 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTfunhead yy1)):yyvs) = do { let {!yyr = reduce347 yy1 yy2 yy3}; YYM.pure (YYNTfundef yyr, yyvs)}; private yyprod347 yyvals = yybadprod 347 yyvals; -private yyprod348 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce348 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod348 ((_, (YYNTguards yy2)):(_, (YYNTfunhead yy1)):yyvs) = do { let {!yyr = reduce348 yy1 yy2}; YYM.pure (YYNTfundef yyr, yyvs)}; private yyprod348 yyvals = yybadprod 348 yyvals; -private yyprod349 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce349 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod349 ((_, (YYNTwherelet yy2)):(_, (YYNTfundef yy1)):yyvs) = do { yyr <- reduce349 yy1 yy2 ;YYM.pure (YYNTfundef yyr, yyvs)}; private yyprod349 yyvals = yybadprod 349 yyvals; -private yyprod350 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce350 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod350 ((_, (YYNTbinex yy1)):yyvs) = do { yyr <- reduce350 yy1 ;YYM.pure (YYNTfunhead yyr, yyvs)}; private yyprod350 yyvals = yybadprod 350 yyvals; -private yyprod351 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce351 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod351 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce351 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod351 yyvals = yybadprod 351 yyvals; -private yyprod352 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce352 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod352 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce352 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod352 yyvals = yybadprod 352 yyvals; private yyprod353 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce353 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod353 yyvals = yybadprod 353 yyvals; private yyprod354 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce354 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod354 yyvals = yybadprod 354 yyvals; -private yyprod355 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce355 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; +private yyprod355 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce355 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod355 yyvals = yybadprod 355 yyvals; private yyprod356 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce356 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod356 yyvals = yybadprod 356 yyvals; private yyprod357 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce357 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod357 yyvals = yybadprod 357 yyvals; -private yyprod358 ((_, (YYNTexpr yy1)):yyvs) = YYM.pure (YYNTpattern (yy1), yyvs); +private yyprod358 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce358 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod358 yyvals = yybadprod 358 yyvals; -private yyprod359 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTaeq (yy1), yyvs); +private yyprod359 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce359 yy1}; YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod359 yyvals = yybadprod 359 yyvals; -private yyprod360 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTaeq (yy1), yyvs); +private yyprod360 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce360 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod360 yyvals = yybadprod 360 yyvals; -private yyprod361 ((_, (YYNTgqual yy1)):yyvs) = YYM.pure (YYNTlcqual (yy1), yyvs); +private yyprod361 ((_, (YYTok yy1)):yyvs) = do { yyr <- reduce361 yy1 ;YYM.pure (YYNTliteral yyr, yyvs)}; private yyprod361 yyvals = yybadprod 361 yyvals; -private yyprod362 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { yyr <- reduce362 yy1 yy2 yy3 ;YYM.pure (YYNTlcqual yyr, yyvs)}; +private yyprod362 ((_, (YYNTexpr yy1)):yyvs) = YYM.pure (YYNTpattern (yy1), yyvs); private yyprod362 yyvals = yybadprod 362 yyvals; -private yyprod363 ((_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce363 yy1 yy2 yy3 yy4}; YYM.pure (YYNTlcqual yyr, yyvs)}; +private yyprod363 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTaeq (yy1), yyvs); private yyprod363 yyvals = yybadprod 363 yyvals; -private yyprod364 ((_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce364 yy1}; YYM.pure (YYNTlcquals yyr, yyvs)}; +private yyprod364 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTaeq (yy1), yyvs); private yyprod364 yyvals = yybadprod 364 yyvals; -private yyprod365 ((_, (YYNTlcquals yy3)):(_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce365 yy1 yy2 yy3}; YYM.pure (YYNTlcquals yyr, yyvs)}; +private yyprod365 ((_, (YYNTgqual yy1)):yyvs) = YYM.pure (YYNTlcqual (yy1), yyvs); private yyprod365 yyvals = yybadprod 365 yyvals; -private yyprod366 ((_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce366 yy1 yy2}; YYM.pure (YYNTlcquals yyr, yyvs)}; +private yyprod366 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { yyr <- reduce366 yy1 yy2 yy3 ;YYM.pure (YYNTlcqual yyr, yyvs)}; private yyprod366 yyvals = yybadprod 366 yyvals; -private yyprod367 ((_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce367 yy1}; YYM.pure (YYNTdodefs yyr, yyvs)}; +private yyprod367 ((_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce367 yy1 yy2 yy3 yy4}; YYM.pure (YYNTlcqual yyr, yyvs)}; private yyprod367 yyvals = yybadprod 367 yyvals; -private yyprod368 ((_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce368 yy1 yy2}; YYM.pure (YYNTdodefs yyr, yyvs)}; +private yyprod368 ((_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce368 yy1}; YYM.pure (YYNTlcquals yyr, yyvs)}; private yyprod368 yyvals = yybadprod 368 yyvals; -private yyprod369 ((_, (YYNTdodefs yy3)):(_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce369 yy1 yy2 yy3}; YYM.pure (YYNTdodefs yyr, yyvs)}; +private yyprod369 ((_, (YYNTlcquals yy3)):(_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce369 yy1 yy2 yy3}; YYM.pure (YYNTlcquals yyr, yyvs)}; private yyprod369 yyvals = yybadprod 369 yyvals; -private yyprod370 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce370 yy1}; YYM.pure (YYNTgqual yyr, yyvs)}; +private yyprod370 ((_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce370 yy1 yy2}; YYM.pure (YYNTlcquals yyr, yyvs)}; private yyprod370 yyvals = yybadprod 370 yyvals; -private yyprod371 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce371 yy1 yy2 yy3}; YYM.pure (YYNTgqual yyr, yyvs)}; +private yyprod371 ((_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce371 yy1}; YYM.pure (YYNTdodefs yyr, yyvs)}; private yyprod371 yyvals = yybadprod 371 yyvals; -private yyprod372 ((_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce372 yy1}; YYM.pure (YYNTgquals yyr, yyvs)}; +private yyprod372 ((_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce372 yy1 yy2}; YYM.pure (YYNTdodefs yyr, yyvs)}; private yyprod372 yyvals = yybadprod 372 yyvals; -private yyprod373 ((_, (YYNTgquals yy3)):(_, (YYTok yy2)):(_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce373 yy1 yy2 yy3}; YYM.pure (YYNTgquals yyr, yyvs)}; +private yyprod373 ((_, (YYNTdodefs yy3)):(_, (YYTok yy2)):(_, (YYNTlcqual yy1)):yyvs) = do { let {!yyr = reduce373 yy1 yy2 yy3}; YYM.pure (YYNTdodefs yyr, yyvs)}; private yyprod373 yyvals = yybadprod 373 yyvals; -private yyprod374 ((_, (YYTok yy2)):(_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce374 yy1 yy2}; YYM.pure (YYNTgquals yyr, yyvs)}; +private yyprod374 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce374 yy1}; YYM.pure (YYNTgqual yyr, yyvs)}; private yyprod374 yyvals = yybadprod 374 yyvals; -private yyprod375 ((_, (YYNTexpr yy4)):(_, (YYNTaeq yy3)):(_, (YYNTgquals yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce375 yy1 yy2 yy3 yy4}; YYM.pure (YYNTguard yyr, yyvs)}; +private yyprod375 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce375 yy1 yy2 yy3}; YYM.pure (YYNTgqual yyr, yyvs)}; private yyprod375 yyvals = yybadprod 375 yyvals; -private yyprod376 ((_, (YYNTguard yy1)):yyvs) = do { let {!yyr = reduce376 yy1}; YYM.pure (YYNTguards yyr, yyvs)}; +private yyprod376 ((_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce376 yy1}; YYM.pure (YYNTgquals yyr, yyvs)}; private yyprod376 yyvals = yybadprod 376 yyvals; -private yyprod377 ((_, (YYNTguards yy2)):(_, (YYNTguard yy1)):yyvs) = do { let {!yyr = reduce377 yy1 yy2}; YYM.pure (YYNTguards yyr, yyvs)}; +private yyprod377 ((_, (YYNTgquals yy3)):(_, (YYTok yy2)):(_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce377 yy1 yy2 yy3}; YYM.pure (YYNTgquals yyr, yyvs)}; private yyprod377 yyvals = yybadprod 377 yyvals; -private yyprod378 ((_, (YYNTexpr yy3)):(_, (YYNTaeq yy2)):(_, (YYNTpattern yy1)):yyvs) = do { let {!yyr = reduce378 yy1 yy2 yy3}; YYM.pure (YYNTcalt yyr, yyvs)}; +private yyprod378 ((_, (YYTok yy2)):(_, (YYNTgqual yy1)):yyvs) = do { let {!yyr = reduce378 yy1 yy2}; YYM.pure (YYNTgquals yyr, yyvs)}; private yyprod378 yyvals = yybadprod 378 yyvals; -private yyprod379 ((_, (YYNTguards yy2)):(_, (YYNTpattern yy1)):yyvs) = do { let {!yyr = reduce379 yy1 yy2}; YYM.pure (YYNTcalt yyr, yyvs)}; +private yyprod379 ((_, (YYNTexpr yy4)):(_, (YYNTaeq yy3)):(_, (YYNTgquals yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce379 yy1 yy2 yy3 yy4}; YYM.pure (YYNTguard yyr, yyvs)}; private yyprod379 yyvals = yybadprod 379 yyvals; -private yyprod380 ((_, (YYNTwherelet yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce380 yy1 yy2}; YYM.pure (YYNTcalt yyr, yyvs)}; +private yyprod380 ((_, (YYNTguard yy1)):yyvs) = do { let {!yyr = reduce380 yy1}; YYM.pure (YYNTguards yyr, yyvs)}; private yyprod380 yyvals = yybadprod 380 yyvals; -private yyprod381 ((_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce381 yy1}; YYM.pure (YYNTcalts yyr, yyvs)}; +private yyprod381 ((_, (YYNTguards yy2)):(_, (YYNTguard yy1)):yyvs) = do { let {!yyr = reduce381 yy1 yy2}; YYM.pure (YYNTguards yyr, yyvs)}; private yyprod381 yyvals = yybadprod 381 yyvals; -private yyprod382 ((_, (YYNTcalts yy3)):(_, (YYTok yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce382 yy1 yy2 yy3}; YYM.pure (YYNTcalts yyr, yyvs)}; +private yyprod382 ((_, (YYNTexpr yy3)):(_, (YYNTaeq yy2)):(_, (YYNTpattern yy1)):yyvs) = do { let {!yyr = reduce382 yy1 yy2 yy3}; YYM.pure (YYNTcalt yyr, yyvs)}; private yyprod382 yyvals = yybadprod 382 yyvals; -private yyprod383 ((_, (YYTok yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce383 yy1 yy2}; YYM.pure (YYNTcalts yyr, yyvs)}; +private yyprod383 ((_, (YYNTguards yy2)):(_, (YYNTpattern yy1)):yyvs) = do { let {!yyr = reduce383 yy1 yy2}; YYM.pure (YYNTcalt yyr, yyvs)}; private yyprod383 yyvals = yybadprod 383 yyvals; -private yyprod384 ((_, (YYNTlambdabody yy3)):(_, (YYNTapats yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce384 yy1 yy2 yy3}; YYM.pure (YYNTlambda yyr, yyvs)}; +private yyprod384 ((_, (YYNTwherelet yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce384 yy1 yy2}; YYM.pure (YYNTcalt yyr, yyvs)}; private yyprod384 yyvals = yybadprod 384 yyvals; -private yyprod385 ((_, (YYNTlambda yy1)):yyvs) = YYM.pure (YYNTlambdabody (yy1), yyvs); +private yyprod385 ((_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce385 yy1}; YYM.pure (YYNTcalts yyr, yyvs)}; private yyprod385 yyvals = yybadprod 385 yyvals; -private yyprod386 ((_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce386 yy1 yy2}; YYM.pure (YYNTlambdabody yyr, yyvs)}; +private yyprod386 ((_, (YYNTcalts yy3)):(_, (YYTok yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce386 yy1 yy2 yy3}; YYM.pure (YYNTcalts yyr, yyvs)}; private yyprod386 yyvals = yybadprod 386 yyvals; -private yyprod387 ((_, (YYNTsigma yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce387 yy1 yy2 yy3}; YYM.pure (YYNTexpr yyr, yyvs)}; +private yyprod387 ((_, (YYTok yy2)):(_, (YYNTcalt yy1)):yyvs) = do { let {!yyr = reduce387 yy1 yy2}; YYM.pure (YYNTcalts yyr, yyvs)}; private yyprod387 yyvals = yybadprod 387 yyvals; -private yyprod388 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTexpr (yy1), yyvs); +private yyprod388 ((_, (YYNTlambdabody yy3)):(_, (YYNTapats yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce388 yy1 yy2 yy3}; YYM.pure (YYNTlambda yyr, yyvs)}; private yyprod388 yyvals = yybadprod 388 yyvals; -private yyprod389 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce389 yy1 yy2}; YYM.pure (YYNTthenx yyr, yyvs)}; +private yyprod389 ((_, (YYNTlambda yy1)):yyvs) = YYM.pure (YYNTlambdabody (yy1), yyvs); private yyprod389 yyvals = yybadprod 389 yyvals; -private yyprod390 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTthenx (yy1), yyvs); +private yyprod390 ((_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce390 yy1 yy2}; YYM.pure (YYNTlambdabody yyr, yyvs)}; private yyprod390 yyvals = yybadprod 390 yyvals; -private yyprod391 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce391 yy1 yy2}; YYM.pure (YYNTelsex yyr, yyvs)}; +private yyprod391 ((_, (YYNTsigma yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce391 yy1 yy2 yy3}; YYM.pure (YYNTexpr yyr, yyvs)}; private yyprod391 yyvals = yybadprod 391 yyvals; -private yyprod392 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTelsex (yy1), yyvs); +private yyprod392 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTexpr (yy1), yyvs); private yyprod392 yyvals = yybadprod 392 yyvals; -private yyprod393 ((_, (YYNTbinex yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce393 yy1 yy2 yy3}; YYM.pure (YYNTbinex yyr, yyvs)}; -private yyprod393 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); +private yyprod393 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce393 yy1 yy2}; YYM.pure (YYNTthenx yyr, yyvs)}; private yyprod393 yyvals = yybadprod 393 yyvals; -private yyprod394 ((_, (YYNTbinex yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce394 yy1 yy2 yy3}; YYM.pure (YYNTbinex yyr, yyvs)}; -private yyprod394 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); +private yyprod394 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTthenx (yy1), yyvs); private yyprod394 yyvals = yybadprod 394 yyvals; -private yyprod395 ((_, (YYNTtopex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce395 yy1 yy2}; YYM.pure (YYNTbinex yyr, yyvs)}; +private yyprod395 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce395 yy1 yy2}; YYM.pure (YYNTelsex yyr, yyvs)}; private yyprod395 yyvals = yybadprod 395 yyvals; -private yyprod396 ((_, (YYNTtopex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); +private yyprod396 ((_, (YYTok yy1)):yyvs) = YYM.pure (YYNTelsex (yy1), yyvs); private yyprod396 yyvals = yybadprod 396 yyvals; -private yyprod397 ((_, (YYNTexpr yy6)):(_, (YYNTelsex yy5)):(_, (YYNTexpr yy4)):(_, (YYNTthenx yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce397 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; +private yyprod397 ((_, (YYNTbinex yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce397 yy1 yy2 yy3}; YYM.pure (YYNTbinex yyr, yyvs)}; +private yyprod397 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); private yyprod397 yyvals = yybadprod 397 yyvals; -private yyprod398 ((_, (YYTok yy6)):(_, (YYNTcalts yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce398 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; +private yyprod398 ((_, (YYNTbinex yy3)):(_, (YYTok yy2)):(_, (YYNTbinex yy1)):yyvs) = do { let {!yyr = reduce398 yy1 yy2 yy3}; YYM.pure (YYNTbinex yyr, yyvs)}; +private yyprod398 ((_, (YYNTbinex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); private yyprod398 yyvals = yybadprod 398 yyvals; -private yyprod399 ((_, (YYNTexpr yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce399 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; +private yyprod399 ((_, (YYNTtopex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce399 yy1 yy2}; YYM.pure (YYNTbinex yyr, yyvs)}; private yyprod399 yyvals = yybadprod 399 yyvals; -private yyprod400 ((_, (YYNTlambda yy1)):yyvs) = YYM.pure (YYNTtopex (yy1), yyvs); +private yyprod400 ((_, (YYNTtopex yy1)):yyvs) = YYM.pure (YYNTbinex (yy1), yyvs); private yyprod400 yyvals = yybadprod 400 yyvals; -private yyprod401 ((_, (YYNTappex yy1)):yyvs) = do { let {!yyr = reduce401 yy1}; YYM.pure (YYNTtopex yyr, yyvs)}; +private yyprod401 ((_, (YYNTexpr yy6)):(_, (YYNTelsex yy5)):(_, (YYNTexpr yy4)):(_, (YYNTthenx yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce401 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; private yyprod401 yyvals = yybadprod 401 yyvals; -private yyprod402 ((_, (YYNTunex yy1)):yyvs) = YYM.pure (YYNTappex (yy1), yyvs); +private yyprod402 ((_, (YYTok yy6)):(_, (YYNTcalts yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce402 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; private yyprod402 yyvals = yybadprod 402 yyvals; -private yyprod403 ((_, (YYNTunex yy2)):(_, (YYNTappex yy1)):yyvs) = do { let {!yyr = reduce403 yy1 yy2}; YYM.pure (YYNTappex yyr, yyvs)}; +private yyprod403 ((_, (YYNTexpr yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYNTletdefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce403 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTtopex yyr, yyvs)}; private yyprod403 yyvals = yybadprod 403 yyvals; -private yyprod404 ((_, (YYNTprimary yy1)):yyvs) = YYM.pure (YYNTunex (yy1), yyvs); +private yyprod404 ((_, (YYNTlambda yy1)):yyvs) = YYM.pure (YYNTtopex (yy1), yyvs); private yyprod404 yyvals = yybadprod 404 yyvals; -private yyprod405 ((_, (YYNTunex yy2)):(_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce405 yy1 yy2}; YYM.pure (YYNTunex yyr, yyvs)}; +private yyprod405 ((_, (YYNTappex yy1)):yyvs) = do { let {!yyr = reduce405 yy1}; YYM.pure (YYNTtopex yyr, yyvs)}; private yyprod405 yyvals = yybadprod 405 yyvals; -private yyprod406 ((_, (YYNTunex yy1)):yyvs) = do { let {!yyr = reduce406 yy1}; YYM.pure (YYNTapats yyr, yyvs)}; +private yyprod406 ((_, (YYNTunex yy1)):yyvs) = YYM.pure (YYNTappex (yy1), yyvs); private yyprod406 yyvals = yybadprod 406 yyvals; -private yyprod407 ((_, (YYNTapats yy2)):(_, (YYNTunex yy1)):yyvs) = do { let {!yyr = reduce407 yy1 yy2}; YYM.pure (YYNTapats yyr, yyvs)}; +private yyprod407 ((_, (YYNTunex yy2)):(_, (YYNTappex yy1)):yyvs) = do { let {!yyr = reduce407 yy1 yy2}; YYM.pure (YYNTappex yyr, yyvs)}; private yyprod407 yyvals = yybadprod 407 yyvals; -private yyprod408 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce408 yy1}; YYM.pure (YYNTqualifiers yyr, yyvs)}; +private yyprod408 ((_, (YYNTprimary yy1)):yyvs) = YYM.pure (YYNTunex (yy1), yyvs); private yyprod408 yyvals = yybadprod 408 yyvals; -private yyprod409 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce409 yy1 yy2}; YYM.pure (YYNTqualifiers yyr, yyvs)}; +private yyprod409 ((_, (YYNTunex yy2)):(_, (YYNTunop yy1)):yyvs) = do { let {!yyr = reduce409 yy1 yy2}; YYM.pure (YYNTunex yyr, yyvs)}; private yyprod409 yyvals = yybadprod 409 yyvals; -private yyprod410 ((_, (YYNTterm yy1)):yyvs) = YYM.pure (YYNTprimary (yy1), yyvs); +private yyprod410 ((_, (YYNTunex yy1)):yyvs) = do { let {!yyr = reduce410 yy1}; YYM.pure (YYNTapats yyr, yyvs)}; private yyprod410 yyvals = yybadprod 410 yyvals; -private yyprod411 ((_, (YYTok yy4)):(_, (YYNTdodefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce411 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod411 ((_, (YYNTapats yy2)):(_, (YYNTunex yy1)):yyvs) = do { let {!yyr = reduce411 yy1 yy2}; YYM.pure (YYNTapats yyr, yyvs)}; private yyprod411 yyvals = yybadprod 411 yyvals; -private yyprod412 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce412 yy1 yy2 yy3}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod412 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce412 yy1}; YYM.pure (YYNTqualifiers yyr, yyvs)}; private yyprod412 yyvals = yybadprod 412 yyvals; -private yyprod413 ((_, (YYNToperator yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { yyr <- reduce413 yy1 yy2 yy3 ;YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod413 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce413 yy1 yy2}; YYM.pure (YYNTqualifiers yyr, yyvs)}; private yyprod413 yyvals = yybadprod 413 yyvals; -private yyprod414 ((_, (YYNTunop yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce414 yy1 yy2 yy3}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod414 ((_, (YYNTterm yy1)):yyvs) = YYM.pure (YYNTprimary (yy1), yyvs); private yyprod414 yyvals = yybadprod 414 yyvals; -private yyprod415 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce415 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod415 ((_, (YYTok yy4)):(_, (YYNTdodefs yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce415 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod415 yyvals = yybadprod 415 yyvals; -private yyprod416 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce416 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod416 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce416 yy1 yy2 yy3}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod416 yyvals = yybadprod 416 yyvals; -private yyprod417 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce417 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod417 ((_, (YYNToperator yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { yyr <- reduce417 yy1 yy2 yy3 ;YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod417 yyvals = yybadprod 417 yyvals; -private yyprod418 ((_, (YYTok yy4)):(_, (YYNTgetfields yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce418 yy1 yy2 yy3 yy4}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod418 ((_, (YYNTunop yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce418 yy1 yy2 yy3}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod418 yyvals = yybadprod 418 yyvals; -private yyprod419 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce419 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod419 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce419 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod419 yyvals = yybadprod 419 yyvals; -private yyprod420 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce420 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod420 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce420 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod420 yyvals = yybadprod 420 yyvals; -private yyprod421 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce421 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod421 ((_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce421 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod421 yyvals = yybadprod 421 yyvals; -private yyprod422 ((_, (YYTok yy5)):(_, (YYNTgetfields yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce422 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod422 ((_, (YYTok yy4)):(_, (YYNTgetfields yy3)):(_, (YYTok yy2)):(_, (YYNTqualifiers yy1)):yyvs) = do { let {!yyr = reduce422 yy1 yy2 yy3 yy4}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod422 yyvals = yybadprod 422 yyvals; -private yyprod423 ((_, (YYTok yy5)):(_, (YYNTexpr yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce423 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; +private yyprod423 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce423 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod423 yyvals = yybadprod 423 yyvals; -private yyprod424 ((_, (YYNTqvarid yy1)):yyvs) = do { let {!yyr = reduce424 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod424 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce424 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod424 yyvals = yybadprod 424 yyvals; -private yyprod425 ((_, (YYNTliteral yy1)):yyvs) = YYM.pure (YYNTterm (yy1), yyvs); +private yyprod425 ((_, (YYTok yy6)):(_, (YYTok yy5)):(_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce425 yy1 yy2 yy3 yy4 yy5 yy6}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod425 yyvals = yybadprod 425 yyvals; -private yyprod426 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce426 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod426 ((_, (YYTok yy5)):(_, (YYNTgetfields yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce426 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod426 yyvals = yybadprod 426 yyvals; -private yyprod427 ((_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce427 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod427 ((_, (YYTok yy5)):(_, (YYNTexpr yy4)):(_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTprimary yy1)):yyvs) = do { let {!yyr = reduce427 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTprimary yyr, yyvs)}; private yyprod427 yyvals = yybadprod 427 yyvals; -private yyprod428 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce428 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod428 ((_, (YYNTqvarid yy1)):yyvs) = do { let {!yyr = reduce428 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod428 yyvals = yybadprod 428 yyvals; -private yyprod429 ((_, (YYTok yy4)):(_, (YYNTfields yy3)):(_, (YYTok yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce429 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod429 ((_, (YYNTliteral yy1)):yyvs) = YYM.pure (YYNTterm (yy1), yyvs); private yyprod429 yyvals = yybadprod 429 yyvals; -private yyprod430 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce430 yy1 yy2}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod430 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce430 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod430 yyvals = yybadprod 430 yyvals; -private yyprod431 ((_, (YYTok yy3)):(_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce431 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod431 ((_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce431 yy1}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod431 yyvals = yybadprod 431 yyvals; -private yyprod432 ((_, (YYTok yy3)):(_, (YYNTunop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce432 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod432 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce432 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod432 yyvals = yybadprod 432 yyvals; -private yyprod433 ((_, (YYTok yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce433 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod433 ((_, (YYTok yy4)):(_, (YYNTfields yy3)):(_, (YYTok yy2)):(_, (YYNTqconid yy1)):yyvs) = do { let {!yyr = reduce433 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod433 yyvals = yybadprod 433 yyvals; -private yyprod434 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce434 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod434 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce434 yy1 yy2}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod434 yyvals = yybadprod 434 yyvals; -private yyprod435 ((_, (YYTok yy4)):(_, (YYNTexpr yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce435 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod435 ((_, (YYTok yy3)):(_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce435 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod435 yyvals = yybadprod 435 yyvals; -private yyprod436 ((_, (YYTok yy4)):(_, (YYNToperator yy3)):(_, (YYNTbinex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce436 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod436 ((_, (YYTok yy3)):(_, (YYNTunop yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce436 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod436 yyvals = yybadprod 436 yyvals; -private yyprod437 ((_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTbinex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce437 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod437 ((_, (YYTok yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce437 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod437 yyvals = yybadprod 437 yyvals; -private yyprod438 ((_, (YYTok yy5)):(_, (YYNTexprSC yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce438 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod438 ((_, (YYTok yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce438 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod438 yyvals = yybadprod 438 yyvals; -private yyprod439 ((_, (YYTok yy5)):(_, (YYNTexprSS yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce439 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod439 ((_, (YYTok yy4)):(_, (YYNTexpr yy3)):(_, (YYNToperator yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce439 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod439 yyvals = yybadprod 439 yyvals; -private yyprod440 ((_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce440 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod440 ((_, (YYTok yy4)):(_, (YYNToperator yy3)):(_, (YYNTbinex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce440 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod440 yyvals = yybadprod 440 yyvals; -private yyprod441 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce441 yy1 yy2}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod441 ((_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTbinex yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce441 yy1 yy2 yy3 yy4}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod441 yyvals = yybadprod 441 yyvals; -private yyprod442 ((_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce442 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod442 ((_, (YYTok yy5)):(_, (YYNTexprSC yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce442 yy1 yy2 yy3 yy4 yy5}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod442 yyvals = yybadprod 442 yyvals; -private yyprod443 ((_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce443 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod443 ((_, (YYTok yy5)):(_, (YYNTexprSS yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce443 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; private yyprod443 yyvals = yybadprod 443 yyvals; -private yyprod444 ((_, (YYTok yy5)):(_, (YYNTexpr yy4)):(_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce444 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod444 ((_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce444 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod444 yyvals = yybadprod 444 yyvals; -private yyprod445 ((_, (YYTok yy5)):(_, (YYNTlcquals yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce445 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; +private yyprod445 ((_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce445 yy1 yy2}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod445 yyvals = yybadprod 445 yyvals; -private yyprod446 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce446 yy1}; YYM.pure (YYNTcommata yyr, yyvs)}; +private yyprod446 ((_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce446 yy1 yy2 yy3}; YYM.pure (YYNTterm yyr, yyvs)}; private yyprod446 yyvals = yybadprod 446 yyvals; -private yyprod447 ((_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce447 yy1 yy2}; YYM.pure (YYNTcommata yyr, yyvs)}; +private yyprod447 ((_, (YYTok yy4)):(_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce447 yy1 yy2 yy3 yy4 ;YYM.pure (YYNTterm yyr, yyvs)}; private yyprod447 yyvals = yybadprod 447 yyvals; -private yyprod448 ((_, (YYNTfield yy1)):yyvs) = do { let {!yyr = reduce448 yy1}; YYM.pure (YYNTfields yyr, yyvs)}; +private yyprod448 ((_, (YYTok yy5)):(_, (YYNTexpr yy4)):(_, (YYTok yy3)):(_, (YYNTexprSC yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce448 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; private yyprod448 yyvals = yybadprod 448 yyvals; -private yyprod449 ((_, (YYNTfields yy3)):(_, (YYTok yy2)):(_, (YYNTfield yy1)):yyvs) = do { yyr <- reduce449 yy1 yy2 yy3 ;YYM.pure (YYNTfields yyr, yyvs)}; +private yyprod449 ((_, (YYTok yy5)):(_, (YYNTlcquals yy4)):(_, (YYTok yy3)):(_, (YYNTexpr yy2)):(_, (YYTok yy1)):yyvs) = do { yyr <- reduce449 yy1 yy2 yy3 yy4 yy5 ;YYM.pure (YYNTterm yyr, yyvs)}; private yyprod449 yyvals = yybadprod 449 yyvals; -private yyprod450 ((_, (YYTok yy2)):(_, (YYNTfield yy1)):yyvs) = do { let {!yyr = reduce450 yy1 yy2}; YYM.pure (YYNTfields yyr, yyvs)}; +private yyprod450 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce450 yy1}; YYM.pure (YYNTcommata yyr, yyvs)}; private yyprod450 yyvals = yybadprod 450 yyvals; -private yyprod451 ((_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce451 yy1}; YYM.pure (YYNTgetfields yyr, yyvs)}; +private yyprod451 ((_, (YYNTcommata yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce451 yy1 yy2}; YYM.pure (YYNTcommata yyr, yyvs)}; private yyprod451 yyvals = yybadprod 451 yyvals; -private yyprod452 ((_, (YYNTgetfields yy3)):(_, (YYTok yy2)):(_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce452 yy1 yy2 yy3}; YYM.pure (YYNTgetfields yyr, yyvs)}; +private yyprod452 ((_, (YYNTfield yy1)):yyvs) = do { let {!yyr = reduce452 yy1}; YYM.pure (YYNTfields yyr, yyvs)}; private yyprod452 yyvals = yybadprod 452 yyvals; -private yyprod453 ((_, (YYTok yy2)):(_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce453 yy1 yy2}; YYM.pure (YYNTgetfields yyr, yyvs)}; +private yyprod453 ((_, (YYNTfields yy3)):(_, (YYTok yy2)):(_, (YYNTfield yy1)):yyvs) = do { yyr <- reduce453 yy1 yy2 yy3 ;YYM.pure (YYNTfields yyr, yyvs)}; private yyprod453 yyvals = yybadprod 453 yyvals; -private yyprod454 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce454 yy1 yy2 yy3}; YYM.pure (YYNTgetfield yyr, yyvs)}; +private yyprod454 ((_, (YYTok yy2)):(_, (YYNTfield yy1)):yyvs) = do { let {!yyr = reduce454 yy1 yy2}; YYM.pure (YYNTfields yyr, yyvs)}; private yyprod454 yyvals = yybadprod 454 yyvals; -private yyprod455 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce455 yy1 yy2 yy3}; YYM.pure (YYNTgetfield yyr, yyvs)}; +private yyprod455 ((_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce455 yy1}; YYM.pure (YYNTgetfields yyr, yyvs)}; private yyprod455 yyvals = yybadprod 455 yyvals; -private yyprod456 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce456 yy1}; YYM.pure (YYNTgetfield yyr, yyvs)}; +private yyprod456 ((_, (YYNTgetfields yy3)):(_, (YYTok yy2)):(_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce456 yy1 yy2 yy3}; YYM.pure (YYNTgetfields yyr, yyvs)}; private yyprod456 yyvals = yybadprod 456 yyvals; -private yyprod457 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce457 yy1 yy2 yy3}; YYM.pure (YYNTfield yyr, yyvs)}; +private yyprod457 ((_, (YYTok yy2)):(_, (YYNTgetfield yy1)):yyvs) = do { let {!yyr = reduce457 yy1 yy2}; YYM.pure (YYNTgetfields yyr, yyvs)}; private yyprod457 yyvals = yybadprod 457 yyvals; -private yyprod458 ((_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce458 yy1}; YYM.pure (YYNTfield yyr, yyvs)}; +private yyprod458 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce458 yy1 yy2 yy3}; YYM.pure (YYNTgetfield yyr, yyvs)}; private yyprod458 yyvals = yybadprod 458 yyvals; -private yyprod459 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce459 yy1}; YYM.pure (YYNTexprSC yyr, yyvs)}; +private yyprod459 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce459 yy1 yy2 yy3}; YYM.pure (YYNTgetfield yyr, yyvs)}; private yyprod459 yyvals = yybadprod 459 yyvals; -private yyprod460 ((_, (YYNTexprSC yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce460 yy1 yy2 yy3}; YYM.pure (YYNTexprSC yyr, yyvs)}; +private yyprod460 ((_, (YYTok yy1)):yyvs) = do { let {!yyr = reduce460 yy1}; YYM.pure (YYNTgetfield yyr, yyvs)}; private yyprod460 yyvals = yybadprod 460 yyvals; -private yyprod461 ((_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce461 yy1 yy2}; YYM.pure (YYNTexprSC yyr, yyvs)}; +private yyprod461 ((_, (YYNTexpr yy3)):(_, (YYTok yy2)):(_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce461 yy1 yy2 yy3}; YYM.pure (YYNTfield yyr, yyvs)}; private yyprod461 yyvals = yybadprod 461 yyvals; -private yyprod462 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce462 yy1}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod462 ((_, (YYNTvarid yy1)):yyvs) = do { let {!yyr = reduce462 yy1}; YYM.pure (YYNTfield yyr, yyvs)}; private yyprod462 yyvals = yybadprod 462 yyvals; -private yyprod463 ((_, (YYNTexprSS yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce463 yy1 yy2 yy3}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod463 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce463 yy1}; YYM.pure (YYNTexprSC yyr, yyvs)}; private yyprod463 yyvals = yybadprod 463 yyvals; -private yyprod464 ((_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce464 yy1 yy2}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod464 ((_, (YYNTexprSC yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce464 yy1 yy2 yy3}; YYM.pure (YYNTexprSC yyr, yyvs)}; private yyprod464 yyvals = yybadprod 464 yyvals; +private yyprod465 ((_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce465 yy1 yy2}; YYM.pure (YYNTexprSC yyr, yyvs)}; +private yyprod465 yyvals = yybadprod 465 yyvals; +private yyprod466 ((_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce466 yy1}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod466 yyvals = yybadprod 466 yyvals; +private yyprod467 ((_, (YYNTexprSS yy3)):(_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce467 yy1 yy2 yy3}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod467 yyvals = yybadprod 467 yyvals; +private yyprod468 ((_, (YYTok yy2)):(_, (YYNTexpr yy1)):yyvs) = do { let {!yyr = reduce468 yy1 yy2}; YYM.pure (YYNTexprSS yyr, yyvs)}; +private yyprod468 yyvals = yybadprod 468 yyvals; private yyprods = let @@ -8407,7 +8508,11 @@ private yyprods = let (461, yyprod461), (462, yyprod462), (463, yyprod463), - (464, yyprod464)]; + (464, yyprod464), + (465, yyprod465), + (466, yyprod466), + (467, yyprod467), + (468, yyprod468)]; in sub1 `seq` sub2 `seq` sub3 `seq` sub4 `seq` sub5 `seq` sub6 `seq` sub7 `seq` sub8 `seq` arrayFromIndexList (sub1 ++ sub2 ++ sub3 ++ sub4 ++ sub5 ++ sub6 ++ sub7 ++ sub8); private yyacts = let sub1 = [ (0, yyaction0), @@ -9136,7 +9241,18 @@ private yyacts = let (723, yyaction723), (724, yyaction724), (725, yyaction725), - (726, yyaction726)]; + (726, yyaction726), + (727, yyaction727), + (728, yyaction728), + (729, yyaction729), + (730, yyaction730), + (731, yyaction731), + (732, yyaction732), + (733, yyaction733), + (734, yyaction734), + (735, yyaction735), + (736, yyaction736), + (737, yyaction737)]; in sub1 `seq` sub2 `seq` sub3 `seq` sub4 `seq` sub5 `seq` sub6 `seq` sub7 `seq` sub8 `seq` sub9 `seq` sub10 `seq` sub11 `seq` sub12 `seq` arrayFromIndexList (sub1 ++ sub2 ++ sub3 ++ sub4 ++ sub5 ++ sub6 ++ sub7 ++ sub8 ++ sub9 ++ sub10 ++ sub11 ++ sub12); private yyrecs = let sub1 = [ (0, yybadstart 0 "a module"), @@ -9219,557 +9335,557 @@ private yyrecs = let (77, yyparsing 77 "a declaration"), (78, yyparsing 78 "a declaration"), (79, yyparsing 79 "a declaration"), - (80, yyparsing 80 "a local declaration"), + (80, yyparsing 80 "a declaration"), (81, yyparsing 81 "a local declaration"), - (82, yybadstart 82 "a where clause"), - (83, yyparsing 83 "an annotated item"), - (84, yyparsing 84 "a term"), + (82, yyparsing 82 "a local declaration"), + (83, yybadstart 83 "a where clause"), + (84, yyparsing 84 "an annotated item"), (85, yyparsing 85 "a term"), - (86, yyparsing 86 "unary expression"), - (87, yyparsing 87 "a fixity declaration"), - (88, yyexpect 88(yyfromId DCOLON)), - (89, yyparsing 89 "a list of items to annotate"), - (90, yyparsing 90 "a declaration of a native item"), - (91, yybadstart 91 "declarations local to a class, instance or type"), - (92, yyparsing 92 "a function or pattern binding"), - (93, yyparsing 93 "left hand side of a function or pattern binding"), - (94, yyparsing 94 "a term"), - (95, yyparsing 95 "a top level expression"), - (96, yyparsing 96 "binary expression"), + (86, yyparsing 86 "a term"), + (87, yyparsing 87 "unary expression"), + (88, yyparsing 88 "a fixity declaration"), + (89, yyexpect 89(yyfromId DCOLON)), + (90, yyparsing 90 "a list of items to annotate"), + (91, yyparsing 91 "a declaration of a native item"), + (92, yybadstart 92 "declarations local to a class, instance or type"), + (93, yybadstart 93 "declarations local to a class, instance or type"), + (94, yyparsing 94 "a function or pattern binding"), + (95, yyparsing 95 "left hand side of a function or pattern binding"), + (96, yyparsing 96 "a term"), (97, yyparsing 97 "a top level expression"), - (98, yyparsing 98 "function application"), - (99, yyparsing 99 "unary expression"), - (100, yyexpect 100(yyfromCh '{')), - (101, yyparsing 101 "a primary expression"), - (102, yyparsing 102 "a word"), - (103, yyexpect 103(yyfromCh '{')), - (104, yyparsing 104 "a module"), - (105, yyexpect 105(yyfromCh '(')), - (106, yyparsing 106 "words"), - (107, yyparsing 107 "a module name"), - (108, yyparsing 108 "a module name"), - (109, yyparsing 109 "a module clause"), - (110, yyparsing 110 "a variable or an operator"), - (111, yyparsing 111 "a qualified constructor or type name"), - (112, yyparsing 112 "a qualified variable name"), - (113, yyparsing 113 "a variable or an operator"), + (98, yyparsing 98 "binary expression"), + (99, yyparsing 99 "a top level expression"), + (100, yyparsing 100 "function application"), + (101, yyparsing 101 "unary expression"), + (102, yyexpect 102(yyfromCh '{')), + (103, yyparsing 103 "a primary expression"), + (104, yyparsing 104 "a word"), + (105, yyexpect 105(yyfromCh '{')), + (106, yyparsing 106 "a module"), + (107, yyexpect 107(yyfromCh '(')), + (108, yyparsing 108 "words"), + (109, yyparsing 109 "a module name"), + (110, yyparsing 110 "a module name"), + (111, yyparsing 111 "a module clause"), + (112, yyparsing 112 "a variable or an operator"), + (113, yyparsing 113 "a qualified constructor or type name"), (114, yyparsing 114 "a qualified variable name"), - (115, yyparsing 115 "a module import"), - (116, yyparsing 116 "the start of a fixity declaration"), - (117, yyparsing 117 "the start of a fixity declaration"), + (115, yyparsing 115 "a variable or an operator"), + (116, yyparsing 116 "a qualified variable name"), + (117, yyparsing 117 "a module import"), (118, yyparsing 118 "the start of a fixity declaration"), - (119, yyparsing 119 "a variable name"), - (120, yybadstart 120 "the type this module derives from"), - (121, yyparsing 121 "an operator"), - (122, yyparsing 122 "the frege name of the native method"), - (123, yyparsing 123 "an annotated item"), + (119, yyparsing 119 "the start of a fixity declaration"), + (120, yyparsing 120 "the start of a fixity declaration"), + (121, yyparsing 121 "a variable name"), + (122, yybadstart 122 "the type this module derives from"), + (123, yyparsing 123 "an operator"), (124, yyparsing 124 "the frege name of the native method"), - (125, yyparsing 125 "the frege name of the native method"), + (125, yyparsing 125 "an annotated item"), (126, yyparsing 126 "the frege name of the native method"), - (127, yyparsing 127 "a specification of a native item")]; - sub3 = [ (128, yyexpect 128(yyfromId DCOLON)), - (129, yyparsing 129 "a data definition"), - (130, yyparsing 130 "a data definition"), - (131, yyparsing 131 "a qualified constructor or type name"), - (132, yyparsing 132 "type class context"), - (133, yybadstart 133 "a type variable"), + (127, yyparsing 127 "the frege name of the native method")]; + sub3 = [ (128, yyparsing 128 "the frege name of the native method"), + (129, yyparsing 129 "a specification of a native item"), + (130, yyexpect 130(yyfromId DCOLON)), + (131, yyparsing 131 "a data definition"), + (132, yyparsing 132 "a data definition"), + (133, yyparsing 133 "a qualified constructor or type name"), (134, yyparsing 134 "type class context"), - (135, yybadstart 135 "declarations local to a class, instance or type"), - (136, yyparsing 136 "instance context"), - (137, yyparsing 137 "instance constraint"), + (135, yybadstart 135 "a type variable"), + (136, yyparsing 136 "type class context"), + (137, yybadstart 137 "declarations local to a class, instance or type"), (138, yyparsing 138 "instance context"), - (139, yyparsing 139 "instance head"), - (140, yybadstart 140 "declarations local to a class, instance or type"), - (141, yyparsing 141 "a protected or private declaration"), - (142, yyparsing 142 "a type declaration"), - (143, yyparsing 143 "a qualified variable name"), - (144, yyparsing 144 "a term"), - (145, yybadstart 145 "then branch"), - (146, yyparsing 146 "an expression"), - (147, yyexpect 147(yyfromId OF)), - (148, yyparsing 148 "an instance derivation"), - (149, yyparsing 149 "a top level expression"), - (150, yyparsing 150 "a primary expression"), - (151, yyparsing 151 "a declaration of a native item"), - (152, yyparsing 152 "a protected or private declaration"), - (153, yyparsing 153 "a protected or private declaration"), - (154, yyparsing 154 "a protected or private declaration"), - (155, yyparsing 155 "a declaration of a native item"), - (156, yyparsing 156 "binary expression"), - (157, yyparsing 157 "an annotated item"), - (158, yyparsing 158 "a term"), - (159, yybadstart 159 "a sequence of one or more ','"), + (139, yyparsing 139 "instance constraint"), + (140, yyparsing 140 "instance context"), + (141, yyparsing 141 "instance head"), + (142, yybadstart 142 "declarations local to a class, instance or type"), + (143, yyexpect 143(yyfromId CONID)), + (144, yyparsing 144 "a protected or private declaration"), + (145, yyparsing 145 "a type declaration"), + (146, yyparsing 146 "a qualified variable name"), + (147, yyparsing 147 "a term"), + (148, yybadstart 148 "then branch"), + (149, yyparsing 149 "an expression"), + (150, yyexpect 150(yyfromId OF)), + (151, yyparsing 151 "an instance derivation"), + (152, yyparsing 152 "a top level expression"), + (153, yyparsing 153 "a primary expression"), + (154, yyparsing 154 "a declaration of a native item"), + (155, yyparsing 155 "a protected or private declaration"), + (156, yyparsing 156 "a protected or private declaration"), + (157, yyparsing 157 "a protected or private declaration"), + (158, yyparsing 158 "a declaration of a native item"), + (159, yyparsing 159 "binary expression"), (160, yyparsing 160 "an annotated item"), - (161, yyparsing 161 "an annotated item"), - (162, yyexpect 162(yyfromCh ')')), - (163, yyparsing 163 "a term"), - (164, yybadstart 164 "an operator"), - (165, yyparsing 165 "a term"), + (161, yyparsing 161 "a term"), + (162, yybadstart 162 "a sequence of one or more ','"), + (163, yyparsing 163 "an annotated item"), + (164, yyparsing 164 "an annotated item"), + (165, yyexpect 165(yyfromCh ')')), (166, yyparsing 166 "a term"), - (167, yyparsing 167 "a term"), - (168, yyparsing 168 "a lambda abstraction"), - (169, yyparsing 169 "lambda patterns"), - (170, yyparsing 170 "a module"), - (171, yyparsing 171 "declarations"), - (172, yyexpect 172(yyfromCh '{')), - (173, yyparsing 173 "a function or pattern binding"), - (174, yyparsing 174 "a term"), - (175, yyparsing 175 "unary expression"), - (176, yyparsing 176 "an operator"), - (177, yyparsing 177 "an operator"), - (178, yyparsing 178 "an operator"), - (179, yyparsing 179 "some operators"), - (180, yyparsing 180 "a fixity declaration"), - (181, yyparsing 181 "an annotation"), - (182, yyparsing 182 "a list of items to annotate"), - (183, yyexpect 183(yyfromCh '{')), - (184, yyparsing 184 "a data definition"), - (185, yyparsing 185 "a guarded expression"), - (186, yyparsing 186 "a function or pattern binding"), - (187, yyparsing 187 "a function or pattern binding"), - (188, yyparsing 188 "guarded expressions"), - (189, yyparsing 189 "binary expression"), - (190, yyparsing 190 "binary expression"), - (191, yyparsing 191 "function application")]; - sub4 = [ (192, yyparsing 192 "a primary expression"), - (193, yyexpect 193(yyfromId VARID)), - (194, yyparsing 194 "a module"), - (195, yyparsing 195 "a module"), - (196, yyparsing 196 "a module clause"), - (197, yyparsing 197 "words"), - (198, yyparsing 198 "a module name"), - (199, yyparsing 199 "a qualified constructor or type name"), - (200, yyparsing 200 "a qualified variable name"), - (201, yyparsing 201 "a module import"), - (202, yyparsing 202 "a module import"), - (203, yyparsing 203 "an import list"), - (204, yyparsing 204 "an import list"), + (167, yybadstart 167 "an operator"), + (168, yyparsing 168 "a term"), + (169, yyparsing 169 "a term"), + (170, yyparsing 170 "a term"), + (171, yyparsing 171 "a lambda abstraction"), + (172, yyparsing 172 "lambda patterns"), + (173, yyparsing 173 "a module"), + (174, yyparsing 174 "declarations"), + (175, yyexpect 175(yyfromCh '{')), + (176, yyparsing 176 "a function or pattern binding"), + (177, yyparsing 177 "a term"), + (178, yyparsing 178 "unary expression"), + (179, yyparsing 179 "an operator"), + (180, yyparsing 180 "an operator"), + (181, yyparsing 181 "an operator"), + (182, yyparsing 182 "some operators"), + (183, yyparsing 183 "a fixity declaration"), + (184, yyparsing 184 "an annotation"), + (185, yyparsing 185 "a list of items to annotate"), + (186, yyexpect 186(yyfromCh '{')), + (187, yyparsing 187 "a data definition"), + (188, yyparsing 188 "a data definition for a native type"), + (189, yyparsing 189 "a guarded expression"), + (190, yyparsing 190 "a function or pattern binding"), + (191, yyparsing 191 "a function or pattern binding")]; + sub4 = [ (192, yyparsing 192 "guarded expressions"), + (193, yyparsing 193 "binary expression"), + (194, yyparsing 194 "binary expression"), + (195, yyparsing 195 "function application"), + (196, yyparsing 196 "a primary expression"), + (197, yyexpect 197(yyfromId VARID)), + (198, yyparsing 198 "a module"), + (199, yyparsing 199 "a module"), + (200, yyparsing 200 "a module clause"), + (201, yyparsing 201 "words"), + (202, yyparsing 202 "a module name"), + (203, yyparsing 203 "a qualified constructor or type name"), + (204, yyparsing 204 "a qualified variable name"), (205, yyparsing 205 "a module import"), - (206, yyexpect 206(yyfromCh '(')), - (207, yyparsing 207 "the type this module derives from"), - (208, yybadstart 208 "the interfaces this module implements"), - (209, yyexpect 209(yyfromCh ')')), - (210, yyexpect 210(yyfromCh ')')), - (211, yyexpect 211(yyfromCh ')')), - (212, yyparsing 212 "a valid java identifier"), - (213, yyparsing 213 "a valid java identifier"), - (214, yybadstart 214 "a valid java identifier"), - (215, yyparsing 215 "a valid java identifier"), + (206, yyparsing 206 "a module import"), + (207, yyparsing 207 "an import list"), + (208, yyparsing 208 "an import list"), + (209, yyparsing 209 "a module import"), + (210, yyexpect 210(yyfromCh '(')), + (211, yyparsing 211 "the type this module derives from"), + (212, yybadstart 212 "the interfaces this module implements"), + (213, yyexpect 213(yyfromCh ')')), + (214, yyexpect 214(yyfromCh ')')), + (215, yyexpect 215(yyfromCh ')')), (216, yyparsing 216 "a valid java identifier"), - (217, yyparsing 217 "native generic type arguments"), - (218, yyparsing 218 "a native item"), + (217, yyparsing 217 "a valid java identifier"), + (218, yybadstart 218 "a valid java identifier"), (219, yyparsing 219 "a valid java identifier"), - (220, yyparsing 220 "a native item"), - (221, yyparsing 221 "a native item"), - (222, yybadstart 222 "native generic type arguments"), - (223, yyparsing 223 "a specification of a native item"), - (224, yyparsing 224 "a declaration of a native item"), - (225, yyparsing 225 "a type variable"), - (226, yyparsing 226 "a type variable"), - (227, yyparsing 227 "a data definition"), - (228, yyexpect 228(yyfromCh '=')), - (229, yyparsing 229 "type variables bound in forall or data/type/newtype"), - (230, yyparsing 230 "a data definition"), - (231, yyexpect 231(yyfromCh '=')), - (232, yyexpect 232(yyfromId CONID)), - (233, yyparsing 233 "simple constraints"), - (234, yyexpect 234(yyfromCh ')')), - (235, yyparsing 235 "simple constraint"), + (220, yyparsing 220 "a valid java identifier"), + (221, yyparsing 221 "native generic type arguments"), + (222, yyparsing 222 "a native item"), + (223, yyparsing 223 "a valid java identifier"), + (224, yyparsing 224 "a native item"), + (225, yyparsing 225 "a native item"), + (226, yybadstart 226 "native generic type arguments"), + (227, yyparsing 227 "a specification of a native item"), + (228, yyparsing 228 "a declaration of a native item"), + (229, yyparsing 229 "a type variable"), + (230, yyparsing 230 "a type variable"), + (231, yyparsing 231 "a data definition"), + (232, yyexpect 232(yyfromCh '=')), + (233, yyparsing 233 "type variables bound in forall or data/type/newtype"), + (234, yyparsing 234 "a data definition"), + (235, yyexpect 235(yyfromCh '=')), (236, yyexpect 236(yyfromId CONID)), - (237, yyparsing 237 "a type class declaration"), - (238, yyparsing 238 "instance constraints"), - (239, yyexpect 239(yyfromCh ')')), - (240, yyparsing 240 "a non function type"), - (241, yyparsing 241 "a non function type"), - (242, yyparsing 242 "a type constructor"), - (243, yyparsing 243 "instance constraint"), + (237, yyparsing 237 "simple constraints"), + (238, yyexpect 238(yyfromCh ')')), + (239, yyparsing 239 "simple constraint"), + (240, yyexpect 240(yyfromId CONID)), + (241, yyparsing 241 "a type class declaration"), + (242, yyparsing 242 "instance constraints"), + (243, yyexpect 243(yyfromCh ')')), (244, yyparsing 244 "a non function type"), (245, yyparsing 245 "a non function type"), - (246, yyparsing 246 "instance head"), - (247, yyparsing 247 "an instance declaration"), - (248, yyparsing 248 "a type declaration"), - (249, yyexpect 249(yyfromCh '=')), - (250, yyparsing 250 "binary expression"), - (251, yyparsing 251 "a term"), - (252, yyparsing 252 "unary expression"), - (253, yyparsing 253 "then branch"), - (254, yyexpect 254(yyfromId THEN)), - (255, yyparsing 255 "a top level expression")]; - sub5 = [ (256, yyparsing 256 "an expression"), - (257, yyexpect 257(yyfromCh '{')), - (258, yyparsing 258 "a function or pattern binding"), - (259, yybadstart 259 "a where clause"), - (260, yyparsing 260 "declarations in a let expression or where clause"), - (261, yyexpect 261(yyfromCh '}')), + (246, yyparsing 246 "a type constructor"), + (247, yyparsing 247 "instance constraint"), + (248, yyparsing 248 "a non function type"), + (249, yyparsing 249 "a non function type"), + (250, yyparsing 250 "instance head"), + (251, yyparsing 251 "an instance declaration"), + (252, yyparsing 252 "a data definition"), + (253, yyparsing 253 "a type declaration"), + (254, yyexpect 254(yyfromCh '=')), + (255, yyparsing 255 "binary expression")]; + sub5 = [ (256, yyparsing 256 "a term"), + (257, yyparsing 257 "unary expression"), + (258, yyparsing 258 "then branch"), + (259, yyexpect 259(yyfromId THEN)), + (260, yyparsing 260 "a top level expression"), + (261, yyparsing 261 "an expression"), (262, yyexpect 262(yyfromCh '{')), - (263, yyparsing 263 "a list comprehension qualifier"), - (264, yyparsing 264 "do expression qualifiers"), - (265, yyparsing 265 "a list comprehension qualifier"), + (263, yyparsing 263 "a function or pattern binding"), + (264, yybadstart 264 "a where clause"), + (265, yyparsing 265 "declarations in a let expression or where clause"), (266, yyexpect 266(yyfromCh '}')), - (267, yyparsing 267 "an annotated item"), - (268, yyparsing 268 "a sequence of one or more ','"), - (269, yyparsing 269 "an annotated item"), - (270, yyexpect 270(yyfromCh ')')), - (271, yyparsing 271 "an annotated item"), - (272, yyparsing 272 "a term"), - (273, yyparsing 273 "a term"), - (274, yyparsing 274 "a term"), - (275, yyparsing 275 "a term"), - (276, yyparsing 276 "an operator"), - (277, yyparsing 277 "binary expression"), - (278, yyexpect 278(yyfromCh ')')), - (279, yyparsing 279 "list of expressions separated by ','"), + (267, yyexpect 267(yyfromCh '{')), + (268, yyparsing 268 "a list comprehension qualifier"), + (269, yyparsing 269 "do expression qualifiers"), + (270, yyparsing 270 "a list comprehension qualifier"), + (271, yyexpect 271(yyfromCh '}')), + (272, yyparsing 272 "an annotated item"), + (273, yyparsing 273 "a sequence of one or more ','"), + (274, yyparsing 274 "an annotated item"), + (275, yyexpect 275(yyfromCh ')')), + (276, yyparsing 276 "an annotated item"), + (277, yyparsing 277 "a term"), + (278, yyparsing 278 "a term"), + (279, yyparsing 279 "a term"), (280, yyparsing 280 "a term"), - (281, yyparsing 281 "a term"), - (282, yyparsing 282 "a term"), - (283, yyparsing 283 "a lambda body"), - (284, yyparsing 284 "a lambda body"), - (285, yyparsing 285 "a lambda abstraction"), - (286, yyparsing 286 "lambda patterns"), - (287, yyparsing 287 "declarations"), - (288, yyparsing 288 "a where clause"), - (289, yyparsing 289 "a term"), - (290, yyparsing 290 "field"), - (291, yyexpect 291(yyfromCh '}')), - (292, yyparsing 292 "field list"), - (293, yyparsing 293 "some operators"), - (294, yyparsing 294 "a qualified type"), - (295, yyparsing 295 "an annotation"), - (296, yyparsing 296 "a qualified type"), - (297, yyparsing 297 "a qualified type"), - (298, yyparsing 298 "a constrained type"), - (299, yyparsing 299 "a constrained type"), - (300, yyparsing 300 "a type application"), - (301, yyparsing 301 "non function types"), - (302, yyparsing 302 "a list of items to annotate"), - (303, yyparsing 303 "declarations local to a class, instance or type"), - (304, yyparsing 304 "a guard qualifier"), - (305, yyparsing 305 "guard qualifiers"), - (306, yybadstart 306 "'='"), - (307, yyparsing 307 "a function or pattern binding"), - (308, yyparsing 308 "guarded expressions"), - (309, yyparsing 309 "binary expression"), - (310, yyparsing 310 "binary expression"), - (311, yyparsing 311 "a primary expression"), - (312, yyexpect 312(yyfromId VARID)), - (313, yyparsing 313 "a primary expression"), - (314, yyparsing 314 "a primary expression"), - (315, yyparsing 315 "a primary expression"), + (281, yyparsing 281 "an operator"), + (282, yyparsing 282 "binary expression"), + (283, yyexpect 283(yyfromCh ')')), + (284, yyparsing 284 "list of expressions separated by ','"), + (285, yyparsing 285 "a term"), + (286, yyparsing 286 "a term"), + (287, yyparsing 287 "a term"), + (288, yyparsing 288 "a lambda body"), + (289, yyparsing 289 "a lambda body"), + (290, yyparsing 290 "a lambda abstraction"), + (291, yyparsing 291 "lambda patterns"), + (292, yyparsing 292 "declarations"), + (293, yyparsing 293 "a where clause"), + (294, yyparsing 294 "a term"), + (295, yyparsing 295 "field"), + (296, yyexpect 296(yyfromCh '}')), + (297, yyparsing 297 "field list"), + (298, yyparsing 298 "some operators"), + (299, yyparsing 299 "a qualified type"), + (300, yyparsing 300 "an annotation"), + (301, yyparsing 301 "a qualified type"), + (302, yyparsing 302 "a qualified type"), + (303, yyparsing 303 "a constrained type"), + (304, yyparsing 304 "a constrained type"), + (305, yyparsing 305 "a type application"), + (306, yyparsing 306 "non function types"), + (307, yyparsing 307 "a list of items to annotate"), + (308, yyparsing 308 "declarations local to a class, instance or type"), + (309, yyparsing 309 "a guard qualifier"), + (310, yyparsing 310 "guard qualifiers"), + (311, yybadstart 311 "'='"), + (312, yyparsing 312 "a function or pattern binding"), + (313, yyparsing 313 "guarded expressions"), + (314, yyparsing 314 "binary expression"), + (315, yyparsing 315 "binary expression"), (316, yyparsing 316 "a primary expression"), - (317, yyexpect 317(yyfromCh '}')), - (318, yyparsing 318 "field list"), - (319, yyexpect 319(yyfromCh '}'))]; - sub6 = [ (320, yyparsing 320 "a qualified variable name"), - (321, yyexpect 321(yyfromCh ')')), - (322, yyparsing 322 "a qualified variable name"), - (323, yyparsing 323 "a list of qualified variable names"), - (324, yyparsing 324 "a qualified variable name"), - (325, yyparsing 325 "a module import"), - (326, yyparsing 326 "a module import"), - (327, yyparsing 327 "an import list"), - (328, yyparsing 328 "an import item"), + (317, yyexpect 317(yyfromId VARID)), + (318, yyparsing 318 "a primary expression"), + (319, yyparsing 319 "a primary expression")]; + sub6 = [ (320, yyparsing 320 "a primary expression"), + (321, yyparsing 321 "a primary expression"), + (322, yyexpect 322(yyfromCh '}')), + (323, yyparsing 323 "field list"), + (324, yyexpect 324(yyfromCh '}')), + (325, yyparsing 325 "a qualified variable name"), + (326, yyexpect 326(yyfromCh ')')), + (327, yyparsing 327 "a qualified variable name"), + (328, yyparsing 328 "a list of qualified variable names"), (329, yyparsing 329 "a qualified variable name"), - (330, yyparsing 330 "an import specification"), - (331, yyparsing 331 "an import list"), - (332, yyexpect 332(yyfromCh ')')), - (333, yyparsing 333 "a list of import items"), - (334, yyparsing 334 "an import specification"), - (335, yyparsing 335 "an import item"), - (336, yyparsing 336 "an import item"), - (337, yyparsing 337 "an import item"), - (338, yyparsing 338 "an import item"), - (339, yyparsing 339 "an import list"), - (340, yyparsing 340 "the type this module derives from"), - (341, yyparsing 341 "a non function type"), - (342, yyparsing 342 "a non function type"), - (343, yyparsing 343 "the interfaces this module implements"), - (344, yyexpect 344(yyfromId WHERE)), - (345, yyparsing 345 "an annotated item"), - (346, yyparsing 346 "an annotated item"), - (347, yyparsing 347 "an annotated item"), - (348, yybadstart 348 "a valid java identifier"), - (349, yyparsing 349 "a valid java identifier"), - (350, yybadstart 350 "a valid java identifier"), - (351, yyparsing 351 "native generic type arguments"), - (352, yyparsing 352 "a list of types"), - (353, yyexpect 353(yyfromCh '}')), - (354, yyparsing 354 "a specification of a native item"), - (355, yyparsing 355 "a method type with optional throws clause"), - (356, yyparsing 356 "method types with optional throws clauses"), - (357, yyparsing 357 "a declaration of a native item"), - (358, yyparsing 358 "a type variable"), - (359, yyparsing 359 "a type variable"), - (360, yyparsing 360 "a type variable"), - (361, yyparsing 361 "a variant of an algebraic datatype"), - (362, yyparsing 362 "a variant of an algebraic datatype"), - (363, yyparsing 363 "a variant of an algebraic datatype"), - (364, yyparsing 364 "a variant of an algebraic datatype"), - (365, yyparsing 365 "a variant of an algebraic datatype"), - (366, yyexpect 366(yyfromId CONID)), - (367, yyexpect 367(yyfromId CONID)), - (368, yyparsing 368 "a data definition"), + (330, yyparsing 330 "a module import"), + (331, yyparsing 331 "a module import"), + (332, yyparsing 332 "an import list"), + (333, yyparsing 333 "an import item"), + (334, yyparsing 334 "a qualified variable name"), + (335, yyparsing 335 "an import specification"), + (336, yyparsing 336 "an import list"), + (337, yyexpect 337(yyfromCh ')')), + (338, yyparsing 338 "a list of import items"), + (339, yyparsing 339 "an import specification"), + (340, yyparsing 340 "an import item"), + (341, yyparsing 341 "an import item"), + (342, yyparsing 342 "an import item"), + (343, yyparsing 343 "an import item"), + (344, yyparsing 344 "an import list"), + (345, yyparsing 345 "the type this module derives from"), + (346, yyparsing 346 "a non function type"), + (347, yyparsing 347 "a non function type"), + (348, yyparsing 348 "the interfaces this module implements"), + (349, yyexpect 349(yyfromId WHERE)), + (350, yyparsing 350 "an annotated item"), + (351, yyparsing 351 "an annotated item"), + (352, yyparsing 352 "an annotated item"), + (353, yybadstart 353 "a valid java identifier"), + (354, yyparsing 354 "a valid java identifier"), + (355, yybadstart 355 "a valid java identifier"), + (356, yyparsing 356 "native generic type arguments"), + (357, yyparsing 357 "a list of type variables separated by ','"), + (358, yyexpect 358(yyfromCh '}')), + (359, yyparsing 359 "a specification of a native item"), + (360, yyparsing 360 "a method type with optional throws clause"), + (361, yyparsing 361 "method types with optional throws clauses"), + (362, yyparsing 362 "a declaration of a native item"), + (363, yyparsing 363 "a type variable"), + (364, yyparsing 364 "a type variable"), + (365, yyparsing 365 "a type variable"), + (366, yyparsing 366 "a variant of an algebraic datatype"), + (367, yyparsing 367 "a variant of an algebraic datatype"), + (368, yyparsing 368 "a variant of an algebraic datatype"), (369, yyparsing 369 "a variant of an algebraic datatype"), (370, yyparsing 370 "a variant of an algebraic datatype"), - (371, yyparsing 371 "a variant of an algebraic datatype"), - (372, yyparsing 372 "a data definition"), - (373, yyparsing 373 "type variables bound in forall or data/type/newtype"), - (374, yyparsing 374 "a native data type"), - (375, yyexpect 375(yyfromId NATIVE)), - (376, yyparsing 376 "a data definition"), + (371, yyexpect 371(yyfromId CONID)), + (372, yyexpect 372(yyfromId CONID)), + (373, yyparsing 373 "a data definition"), + (374, yyparsing 374 "a variant of an algebraic datatype"), + (375, yyparsing 375 "a variant of an algebraic datatype"), + (376, yyparsing 376 "a variant of an algebraic datatype"), (377, yyparsing 377 "a data definition"), - (378, yyparsing 378 "an algebraic datatype"), - (379, yyparsing 379 "a data definition"), - (380, yyparsing 380 "simple constraints"), - (381, yyparsing 381 "type class context"), - (382, yybadstart 382 "a type variable"), - (383, yyparsing 383 "instance constraints")]; - sub7 = [ (384, yyparsing 384 "instance context"), - (385, yyparsing 385 "a type variable"), - (386, yyexpect 386(yyfromCh ')')), - (387, yyparsing 387 "a type constructor"), - (388, yyparsing 388 "a non function type"), - (389, yyexpect 389(yyfromCh ')')), - (390, yyparsing 390 "a type constructor"), - (391, yyexpect 391(yyfromCh ']')), - (392, yybadstart 392 "a sequence of one or more ','"), - (393, yyexpect 393(yyfromCh ']')), - (394, yyparsing 394 "instance head"), - (395, yyparsing 395 "a type declaration"), - (396, yyparsing 396 "a type declaration"), - (397, yyparsing 397 "a term"), - (398, yyparsing 398 "a term"), - (399, yyparsing 399 "a term"), - (400, yyparsing 400 "then branch"), - (401, yybadstart 401 "else branch"), - (402, yyparsing 402 "an expression"), - (403, yyparsing 403 "a top level expression"), - (404, yyparsing 404 "declarations in a let expression or where clause"), - (405, yyexpect 405(yyfromId IN)), - (406, yyparsing 406 "a list comprehension qualifier"), - (407, yyparsing 407 "a guard qualifier"), - (408, yyparsing 408 "a list comprehension qualifier"), - (409, yyparsing 409 "do expression qualifiers"), - (410, yyparsing 410 "a primary expression"), - (411, yyparsing 411 "a term"), - (412, yyparsing 412 "list of expressions separated by ';'"), - (413, yyexpect 413(yyfromCh ')')), - (414, yyparsing 414 "list of expressions separated by ','"), - (415, yyexpect 415(yyfromCh ')')), - (416, yyparsing 416 "a term"), - (417, yyparsing 417 "a term"), - (418, yyparsing 418 "list of expressions separated by ','"), - (419, yyparsing 419 "list comprehension qualifiers"), - (420, yyexpect 420(yyfromCh ']')), - (421, yyparsing 421 "a term"), - (422, yyexpect 422(yyfromCh ']')), - (423, yyparsing 423 "a lambda body"), - (424, yyparsing 424 "a where clause"), - (425, yyexpect 425(yyfromCh '}')), - (426, yyparsing 426 "field"), - (427, yyparsing 427 "a term"), - (428, yyparsing 428 "field list"), - (429, yybadstart 429 "'.' or '•'"), - (430, yyparsing 430 "a type"), - (431, yyparsing 431 "a constrained type"), - (432, yyparsing 432 "non function types"), - (433, yyparsing 433 "a protected or private local declaration"), - (434, yyparsing 434 "a protected or private local declaration"), - (435, yyparsing 435 "a protected or private local declaration"), - (436, yyparsing 436 "declarations local to a class, instance or type"), - (437, yyparsing 437 "a commented local declaration"), - (438, yyparsing 438 "a protected or private local declaration"), - (439, yyexpect 439(yyfromCh '}')), - (440, yyparsing 440 "local declarations"), - (441, yyparsing 441 "a commented local declaration"), - (442, yyparsing 442 "guard qualifiers"), - (443, yyparsing 443 "'='"), - (444, yyparsing 444 "'='"), - (445, yyparsing 445 "a guarded expression"), - (446, yyparsing 446 "a primary expression"), - (447, yyexpect 447(yyfromCh '}'))]; - sub8 = [ (448, yyexpect 448(yyfromCh ']')), - (449, yyparsing 449 "a primary expression"), - (450, yyexpect 450(yyfromCh '}')), - (451, yyparsing 451 "a primary expression"), - (452, yyparsing 452 "a primary expression"), - (453, yyparsing 453 "field list"), - (454, yyparsing 454 "a module"), - (455, yyparsing 455 "a qualified variable name"), - (456, yyparsing 456 "a qualified variable name"), - (457, yyparsing 457 "a module clause"), - (458, yyparsing 458 "a list of qualified variable names"), - (459, yyparsing 459 "a module import"), - (460, yyparsing 460 "an import item"), - (461, yyparsing 461 "a qualified variable name"), - (462, yyparsing 462 "an import specification"), - (463, yyparsing 463 "an import list"), - (464, yyparsing 464 "a list of import items"), - (465, yyparsing 465 "a simple name for a member or import item"), - (466, yyparsing 466 "a simple name for a member or import item"), - (467, yyparsing 467 "a simple name for a member or import item"), - (468, yyparsing 468 "an import specification"), - (469, yyexpect 469(yyfromCh ')')), - (470, yyparsing 470 "a non function type"), - (471, yyparsing 471 "the interfaces this module implements"), - (472, yyexpect 472(yyfromCh '{')), - (473, yyparsing 473 "specification for module class "), - (474, yyparsing 474 "a valid java identifier"), - (475, yyparsing 475 "a valid java identifier"), - (476, yyparsing 476 "a list of types"), - (477, yyparsing 477 "native generic type arguments"), - (478, yyparsing 478 "a method type with optional throws clause"), - (479, yyparsing 479 "method types with optional throws clauses"), - (480, yyparsing 480 "a type variable"), - (481, yyparsing 481 "a type variable"), - (482, yyexpect 482(yyfromCh ')')), - (483, yyexpect 483(yyfromCh ')')), - (484, yyparsing 484 "a variant of an algebraic datatype"), - (485, yyparsing 485 "constructor field represented by a type"), - (486, yyparsing 486 "constructor field represented by a type"), - (487, yyparsing 487 "constructor field represented by a type"), - (488, yyparsing 488 "a variant of an algebraic datatype"), - (489, yyparsing 489 "constructor fields represented by types"), - (490, yyparsing 490 "constructor field represented by a type"), - (491, yyparsing 491 "a variant of an algebraic datatype"), + (378, yyparsing 378 "type variables bound in forall or data/type/newtype"), + (379, yyparsing 379 "a native data type"), + (380, yyexpect 380(yyfromId NATIVE)), + (381, yyparsing 381 "a data definition for a native type"), + (382, yyparsing 382 "a data definition"), + (383, yyparsing 383 "an algebraic datatype")]; + sub7 = [ (384, yyparsing 384 "a data definition"), + (385, yyparsing 385 "simple constraints"), + (386, yyparsing 386 "type class context"), + (387, yybadstart 387 "a type variable"), + (388, yyparsing 388 "instance constraints"), + (389, yyparsing 389 "instance context"), + (390, yyparsing 390 "a type variable"), + (391, yyexpect 391(yyfromCh ')')), + (392, yyparsing 392 "a type constructor"), + (393, yyparsing 393 "a non function type"), + (394, yyexpect 394(yyfromCh ')')), + (395, yyparsing 395 "a type constructor"), + (396, yyexpect 396(yyfromCh ']')), + (397, yybadstart 397 "a sequence of one or more ','"), + (398, yyexpect 398(yyfromCh ']')), + (399, yyparsing 399 "instance head"), + (400, yyparsing 400 "a data definition"), + (401, yyexpect 401(yyfromCh '=')), + (402, yyparsing 402 "a type declaration"), + (403, yyparsing 403 "a type declaration"), + (404, yyparsing 404 "a term"), + (405, yyparsing 405 "a term"), + (406, yyparsing 406 "a term"), + (407, yyparsing 407 "then branch"), + (408, yybadstart 408 "else branch"), + (409, yyparsing 409 "an expression"), + (410, yyparsing 410 "a top level expression"), + (411, yyparsing 411 "declarations in a let expression or where clause"), + (412, yyexpect 412(yyfromId IN)), + (413, yyparsing 413 "a list comprehension qualifier"), + (414, yyparsing 414 "a guard qualifier"), + (415, yyparsing 415 "a list comprehension qualifier"), + (416, yyparsing 416 "do expression qualifiers"), + (417, yyparsing 417 "a primary expression"), + (418, yyparsing 418 "a term"), + (419, yyparsing 419 "list of expressions separated by ';'"), + (420, yyexpect 420(yyfromCh ')')), + (421, yyparsing 421 "list of expressions separated by ','"), + (422, yyexpect 422(yyfromCh ')')), + (423, yyparsing 423 "a term"), + (424, yyparsing 424 "a term"), + (425, yyparsing 425 "list of expressions separated by ','"), + (426, yyparsing 426 "list comprehension qualifiers"), + (427, yyexpect 427(yyfromCh ']')), + (428, yyparsing 428 "a term"), + (429, yyexpect 429(yyfromCh ']')), + (430, yyparsing 430 "a lambda body"), + (431, yyparsing 431 "a where clause"), + (432, yyexpect 432(yyfromCh '}')), + (433, yyparsing 433 "field"), + (434, yyparsing 434 "a term"), + (435, yyparsing 435 "field list"), + (436, yybadstart 436 "'.' or '•'"), + (437, yyparsing 437 "a type"), + (438, yyparsing 438 "a constrained type"), + (439, yyparsing 439 "non function types"), + (440, yyparsing 440 "a protected or private local declaration"), + (441, yyparsing 441 "a protected or private local declaration"), + (442, yyparsing 442 "a protected or private local declaration"), + (443, yyparsing 443 "declarations local to a class, instance or type"), + (444, yyparsing 444 "a commented local declaration"), + (445, yyparsing 445 "a protected or private local declaration"), + (446, yyexpect 446(yyfromCh '}')), + (447, yyparsing 447 "local declarations")]; + sub8 = [ (448, yyparsing 448 "a commented local declaration"), + (449, yyparsing 449 "guard qualifiers"), + (450, yyparsing 450 "'='"), + (451, yyparsing 451 "'='"), + (452, yyparsing 452 "a guarded expression"), + (453, yyparsing 453 "a primary expression"), + (454, yyexpect 454(yyfromCh '}')), + (455, yyexpect 455(yyfromCh ']')), + (456, yyparsing 456 "a primary expression"), + (457, yyexpect 457(yyfromCh '}')), + (458, yyparsing 458 "a primary expression"), + (459, yyparsing 459 "a primary expression"), + (460, yyparsing 460 "field list"), + (461, yyparsing 461 "a module"), + (462, yyparsing 462 "a qualified variable name"), + (463, yyparsing 463 "a qualified variable name"), + (464, yyparsing 464 "a module clause"), + (465, yyparsing 465 "a list of qualified variable names"), + (466, yyparsing 466 "a module import"), + (467, yyparsing 467 "an import item"), + (468, yyparsing 468 "a qualified variable name"), + (469, yyparsing 469 "an import specification"), + (470, yyparsing 470 "an import list"), + (471, yyparsing 471 "a list of import items"), + (472, yyparsing 472 "a simple name for a member or import item"), + (473, yyparsing 473 "a simple name for a member or import item"), + (474, yyparsing 474 "a simple name for a member or import item"), + (475, yyparsing 475 "an import specification"), + (476, yyexpect 476(yyfromCh ')')), + (477, yyparsing 477 "a non function type"), + (478, yyparsing 478 "a list of types"), + (479, yyparsing 479 "the interfaces this module implements"), + (480, yyexpect 480(yyfromCh '{')), + (481, yyparsing 481 "specification for module class "), + (482, yyparsing 482 "a valid java identifier"), + (483, yyparsing 483 "a valid java identifier"), + (484, yyparsing 484 "a list of type variables separated by ','"), + (485, yyparsing 485 "native generic type arguments"), + (486, yyparsing 486 "a method type with optional throws clause"), + (487, yyparsing 487 "method types with optional throws clauses"), + (488, yyparsing 488 "a type variable"), + (489, yyparsing 489 "a type variable"), + (490, yyexpect 490(yyfromCh ')')), + (491, yyexpect 491(yyfromCh ')')), (492, yyparsing 492 "a variant of an algebraic datatype"), - (493, yyparsing 493 "a variant of an algebraic datatype"), - (494, yyparsing 494 "a variant of an algebraic datatype"), - (495, yyparsing 495 "a variant of an algebraic datatype"), + (493, yyparsing 493 "constructor field represented by a type"), + (494, yyparsing 494 "constructor field represented by a type"), + (495, yyparsing 495 "constructor field represented by a type"), (496, yyparsing 496 "a variant of an algebraic datatype"), - (497, yyparsing 497 "a variant of an algebraic datatype"), - (498, yyparsing 498 "a data definition"), - (499, yyparsing 499 "a native data type"), - (500, yybadstart 500 "native generic type arguments"), - (501, yyparsing 501 "a data definition"), - (502, yyparsing 502 "an algebraic datatype"), - (503, yyparsing 503 "a data definition"), - (504, yyparsing 504 "a data definition"), - (505, yyparsing 505 "simple constraints"), - (506, yybadstart 506 "declarations local to a class, instance or type"), - (507, yyparsing 507 "instance constraints"), - (508, yyparsing 508 "a type constructor"), - (509, yyparsing 509 "a non function type"), - (510, yyparsing 510 "a non function type"), - (511, yyparsing 511 "a non function type")]; - sub9 = [ (512, yyparsing 512 "a type constructor"), - (513, yyparsing 513 "a non function type"), - (514, yyparsing 514 "instance head"), - (515, yyparsing 515 "a type declaration"), - (516, yyparsing 516 "else branch"), - (517, yyexpect 517(yyfromId ELSE)), - (518, yyparsing 518 "a top level expression"), - (519, yyparsing 519 "a pattern"), - (520, yyparsing 520 "case alternative"), - (521, yybadstart 521 "a where clause"), - (522, yyexpect 522(yyfromCh '}')), - (523, yyparsing 523 "declarations in a let expression or where clause"), - (524, yyparsing 524 "a top level expression"), - (525, yyexpect 525(yyfromCh '}')), - (526, yyparsing 526 "a guard qualifier"), - (527, yyparsing 527 "a list comprehension qualifier"), - (528, yyparsing 528 "do expression qualifiers"), - (529, yyparsing 529 "list of expressions separated by ';'"), - (530, yyparsing 530 "a term"), - (531, yyparsing 531 "a term"), - (532, yyparsing 532 "list comprehension qualifiers"), - (533, yyparsing 533 "a term"), - (534, yyparsing 534 "a term"), - (535, yyparsing 535 "a where clause"), - (536, yyparsing 536 "field"), - (537, yyparsing 537 "field list"), - (538, yyparsing 538 "'.' or '•'"), - (539, yyparsing 539 "'.' or '•'"), - (540, yyparsing 540 "a qualified type"), - (541, yyparsing 541 "a type"), - (542, yyparsing 542 "a type"), - (543, yyparsing 543 "a constrained type"), - (544, yyparsing 544 "a protected or private local declaration"), - (545, yyparsing 545 "a protected or private local declaration"), - (546, yyparsing 546 "a protected or private local declaration"), - (547, yyparsing 547 "a commented local declaration"), - (548, yyparsing 548 "declarations local to a class, instance or type"), - (549, yyparsing 549 "local declarations"), - (550, yyparsing 550 "guard qualifiers"), - (551, yyparsing 551 "a guarded expression"), - (552, yyparsing 552 "a primary expression"), - (553, yyexpect 553(yyfromCh '}')), - (554, yyparsing 554 "a primary expression"), - (555, yyparsing 555 "a primary expression"), - (556, yyparsing 556 "a primary expression"), - (557, yyparsing 557 "a primary expression"), - (558, yyparsing 558 "field"), - (559, yyparsing 559 "a primary expression"), - (560, yyparsing 560 "a primary expression"), - (561, yyparsing 561 "field"), - (562, yyparsing 562 "field"), - (563, yyparsing 563 "field list"), - (564, yyparsing 564 "a qualified variable name"), - (565, yyparsing 565 "a list of qualified variable names"), - (566, yyparsing 566 "a member import specification"), - (567, yyparsing 567 "an import item"), - (568, yyexpect 568(yyfromCh ')')), - (569, yyparsing 569 "a member import specification"), - (570, yyparsing 570 "a list of member imports"), - (571, yyparsing 571 "a list of import items"), - (572, yyparsing 572 "an import list"), - (573, yyparsing 573 "a non function type"), - (574, yyparsing 574 "java code"), - (575, yyparsing 575 "a list of types")]; - sub10 = [ (576, yyparsing 576 "a method type with optional throws clause"), - (577, yyparsing 577 "method types with optional throws clauses"), - (578, yyexpect 578(yyfromCh ')')), - (579, yyparsing 579 "a type kind"), - (580, yyparsing 580 "a type kind"), - (581, yyexpect 581(yyfromCh ')')), - (582, yyparsing 582 "a type kind"), - (583, yyparsing 583 "a type variable"), - (584, yyparsing 584 "a type variable"), - (585, yyparsing 585 "a constructor field"), - (586, yyexpect 586(yyfromCh '}')), - (587, yyparsing 587 "constructor fields"), - (588, yyparsing 588 "constructor field represented by a type"), - (589, yyparsing 589 "constructor field represented by a type"), - (590, yyparsing 590 "constructor fields represented by types"), - (591, yyparsing 591 "a native generic type"), - (592, yyparsing 592 "an algebraic datatype"), - (593, yyparsing 593 "a data definition"), - (594, yyparsing 594 "a type class declaration"), - (595, yyexpect 595(yyfromCh ')')), - (596, yyparsing 596 "a list of types separated by '|'"), - (597, yyexpect 597(yyfromCh ')')), - (598, yyparsing 598 "else branch"), - (599, yyparsing 599 "a top level expression"), - (600, yyparsing 600 "case alternative"), - (601, yyparsing 601 "case alternative"), - (602, yyparsing 602 "list of case alternatives"), - (603, yyparsing 603 "case alternative"), - (604, yyparsing 604 "a top level expression"), - (605, yyparsing 605 "a top level expression"), - (606, yyparsing 606 "a list comprehension qualifier"), - (607, yyparsing 607 "list of expressions separated by ';'"), - (608, yyparsing 608 "list comprehension qualifiers"), - (609, yyparsing 609 "a qualified type"), - (610, yyparsing 610 "local declarations"), - (611, yyparsing 611 "a primary expression"), - (612, yyparsing 612 "a primary expression"), - (613, yyparsing 613 "a primary expression"), - (614, yyparsing 614 "field"), - (615, yyparsing 615 "field"), - (616, yyparsing 616 "a member import specification"), - (617, yyparsing 617 "an import item"), - (618, yyparsing 618 "a member import specification"), - (619, yyparsing 619 "a list of member imports"), - (620, yyparsing 620 "java token"), - (621, yyparsing 621 "java token"), - (622, yyparsing 622 "java token"), - (623, yyparsing 623 "java token"), - (624, yyparsing 624 "java token"), - (625, yyparsing 625 "java token"), - (626, yyparsing 626 "java token"), - (627, yyparsing 627 "java token"), - (628, yyparsing 628 "java token"), - (629, yyparsing 629 "java token"), - (630, yyparsing 630 "java token"), + (497, yyparsing 497 "constructor fields represented by types"), + (498, yyparsing 498 "constructor field represented by a type"), + (499, yyparsing 499 "a variant of an algebraic datatype"), + (500, yyparsing 500 "a variant of an algebraic datatype"), + (501, yyparsing 501 "a variant of an algebraic datatype"), + (502, yyparsing 502 "a variant of an algebraic datatype"), + (503, yyparsing 503 "a variant of an algebraic datatype"), + (504, yyparsing 504 "a variant of an algebraic datatype"), + (505, yyparsing 505 "a variant of an algebraic datatype"), + (506, yyparsing 506 "a data definition"), + (507, yyparsing 507 "a native data type"), + (508, yybadstart 508 "native generic type arguments"), + (509, yyparsing 509 "a data definition for a native type"), + (510, yyparsing 510 "an algebraic datatype"), + (511, yyparsing 511 "a data definition for a native type")]; + sub9 = [ (512, yyparsing 512 "a data definition"), + (513, yyparsing 513 "simple constraints"), + (514, yybadstart 514 "declarations local to a class, instance or type"), + (515, yyparsing 515 "instance constraints"), + (516, yyparsing 516 "a type constructor"), + (517, yyparsing 517 "a non function type"), + (518, yyparsing 518 "a non function type"), + (519, yyparsing 519 "a non function type"), + (520, yyparsing 520 "a type constructor"), + (521, yyparsing 521 "a non function type"), + (522, yyparsing 522 "instance head"), + (523, yyparsing 523 "a data definition"), + (524, yyparsing 524 "a type declaration"), + (525, yyparsing 525 "else branch"), + (526, yyexpect 526(yyfromId ELSE)), + (527, yyparsing 527 "a top level expression"), + (528, yyparsing 528 "a pattern"), + (529, yyparsing 529 "case alternative"), + (530, yybadstart 530 "a where clause"), + (531, yyexpect 531(yyfromCh '}')), + (532, yyparsing 532 "declarations in a let expression or where clause"), + (533, yyparsing 533 "a top level expression"), + (534, yyexpect 534(yyfromCh '}')), + (535, yyparsing 535 "a guard qualifier"), + (536, yyparsing 536 "a list comprehension qualifier"), + (537, yyparsing 537 "do expression qualifiers"), + (538, yyparsing 538 "list of expressions separated by ';'"), + (539, yyparsing 539 "a term"), + (540, yyparsing 540 "a term"), + (541, yyparsing 541 "list comprehension qualifiers"), + (542, yyparsing 542 "a term"), + (543, yyparsing 543 "a term"), + (544, yyparsing 544 "a where clause"), + (545, yyparsing 545 "field"), + (546, yyparsing 546 "field list"), + (547, yyparsing 547 "'.' or '•'"), + (548, yyparsing 548 "'.' or '•'"), + (549, yyparsing 549 "a qualified type"), + (550, yyparsing 550 "a type"), + (551, yyparsing 551 "a type"), + (552, yyparsing 552 "a constrained type"), + (553, yyparsing 553 "a protected or private local declaration"), + (554, yyparsing 554 "a protected or private local declaration"), + (555, yyparsing 555 "a protected or private local declaration"), + (556, yyparsing 556 "a commented local declaration"), + (557, yyparsing 557 "declarations local to a class, instance or type"), + (558, yyparsing 558 "local declarations"), + (559, yyparsing 559 "guard qualifiers"), + (560, yyparsing 560 "a guarded expression"), + (561, yyparsing 561 "a primary expression"), + (562, yyexpect 562(yyfromCh '}')), + (563, yyparsing 563 "a primary expression"), + (564, yyparsing 564 "a primary expression"), + (565, yyparsing 565 "a primary expression"), + (566, yyparsing 566 "a primary expression"), + (567, yyparsing 567 "field"), + (568, yyparsing 568 "a primary expression"), + (569, yyparsing 569 "a primary expression"), + (570, yyparsing 570 "field"), + (571, yyparsing 571 "field"), + (572, yyparsing 572 "field list"), + (573, yyparsing 573 "a qualified variable name"), + (574, yyparsing 574 "a list of qualified variable names"), + (575, yyparsing 575 "a member import specification")]; + sub10 = [ (576, yyparsing 576 "an import item"), + (577, yyexpect 577(yyfromCh ')')), + (578, yyparsing 578 "a member import specification"), + (579, yyparsing 579 "a list of member imports"), + (580, yyparsing 580 "a list of import items"), + (581, yyparsing 581 "an import list"), + (582, yyparsing 582 "a non function type"), + (583, yyparsing 583 "a list of types"), + (584, yyparsing 584 "java code"), + (585, yyparsing 585 "a list of type variables separated by ','"), + (586, yyparsing 586 "a method type with optional throws clause"), + (587, yyparsing 587 "method types with optional throws clauses"), + (588, yyexpect 588(yyfromCh ')')), + (589, yyparsing 589 "a type kind"), + (590, yyparsing 590 "a type kind"), + (591, yyexpect 591(yyfromCh ')')), + (592, yyparsing 592 "a type kind"), + (593, yyparsing 593 "a type variable"), + (594, yyparsing 594 "a type variable"), + (595, yyparsing 595 "a constructor field"), + (596, yyexpect 596(yyfromCh '}')), + (597, yyparsing 597 "constructor fields"), + (598, yyparsing 598 "constructor field represented by a type"), + (599, yyparsing 599 "constructor field represented by a type"), + (600, yyparsing 600 "constructor fields represented by types"), + (601, yyparsing 601 "a native generic type"), + (602, yyparsing 602 "an algebraic datatype"), + (603, yyparsing 603 "a data definition for a native type"), + (604, yyparsing 604 "a type class declaration"), + (605, yyexpect 605(yyfromCh ')')), + (606, yyparsing 606 "a list of types separated by '|'"), + (607, yyexpect 607(yyfromCh ')')), + (608, yyparsing 608 "else branch"), + (609, yyparsing 609 "a top level expression"), + (610, yyparsing 610 "case alternative"), + (611, yyparsing 611 "case alternative"), + (612, yyparsing 612 "list of case alternatives"), + (613, yyparsing 613 "case alternative"), + (614, yyparsing 614 "a top level expression"), + (615, yyparsing 615 "a top level expression"), + (616, yyparsing 616 "a list comprehension qualifier"), + (617, yyparsing 617 "list of expressions separated by ';'"), + (618, yyparsing 618 "list comprehension qualifiers"), + (619, yyparsing 619 "a qualified type"), + (620, yyparsing 620 "local declarations"), + (621, yyparsing 621 "a primary expression"), + (622, yyparsing 622 "a primary expression"), + (623, yyparsing 623 "a primary expression"), + (624, yyparsing 624 "field"), + (625, yyparsing 625 "field"), + (626, yyparsing 626 "a member import specification"), + (627, yyparsing 627 "an import item"), + (628, yyparsing 628 "a member import specification"), + (629, yyparsing 629 "a list of member imports"), + (630, yyparsing 630 "a list of types"), (631, yyparsing 631 "java token"), (632, yyparsing 632 "java token"), (633, yyparsing 633 "java token"), @@ -9809,8 +9925,8 @@ private yyrecs = let (667, yyparsing 667 "java token"), (668, yyparsing 668 "java token"), (669, yyparsing 669 "java token"), - (670, yyparsing 670 "java tokens"), - (671, yyparsing 671 "java code"), + (670, yyparsing 670 "java token"), + (671, yyparsing 671 "java token"), (672, yyparsing 672 "java token"), (673, yyparsing 673 "java token"), (674, yyparsing 674 "java token"), @@ -9820,83 +9936,94 @@ private yyrecs = let (678, yyparsing 678 "java token"), (679, yyparsing 679 "java token"), (680, yyparsing 680 "java token"), - (681, yyparsing 681 "java token"), - (682, yyparsing 682 "java token"), - (683, yyexpect 683(yyfromCh '}')), - (684, yyparsing 684 "java tokens"), - (685, yyparsing 685 "a type variable"), - (686, yyexpect 686(yyfromCh ')')), - (687, yyparsing 687 "a type variable"), - (688, yyparsing 688 "a type kind"), - (689, yyparsing 689 "a field specification"), - (690, yyparsing 690 "a field specification"), - (691, yyexpect 691(yyfromId VARID)), - (692, yyexpect 692(yyfromId VARID)), - (693, yyparsing 693 "a field specification"), - (694, yyexpect 694(yyfromId DCOLON)), - (695, yyparsing 695 "field specifications"), - (696, yyparsing 696 "a field specification"), - (697, yyparsing 697 "a field specification"), - (698, yyparsing 698 "a variant of an algebraic datatype"), - (699, yyparsing 699 "constructor fields"), - (700, yyparsing 700 "constructor fields"), - (701, yyparsing 701 "a non function type"), - (702, yyparsing 702 "a list of types separated by '|'"), - (703, yyparsing 703 "a non function type")]; - sub12 = [ (704, yyparsing 704 "case alternative"), - (705, yyparsing 705 "list of case alternatives"), - (706, yyparsing 706 "a list of member imports"), - (707, yyparsing 707 "java tokens"), - (708, yyexpect 708(yyfromCh '}')), - (709, yyparsing 709 "java code"), - (710, yyparsing 710 "java tokens"), - (711, yyparsing 711 "a type kind"), - (712, yyparsing 712 "a type kind"), - (713, yyparsing 713 "a field specification"), - (714, yyparsing 714 "a field specification"), - (715, yyparsing 715 "a field specification"), - (716, yyparsing 716 "a field specification"), - (717, yyparsing 717 "a constructor field"), - (718, yyparsing 718 "field specifications"), - (719, yyparsing 719 "constructor fields"), - (720, yyparsing 720 "constructor fields"), - (721, yyparsing 721 "a list of types separated by '|'"), - (722, yyparsing 722 "java tokens"), - (723, yyparsing 723 "java tokens"), - (724, yyparsing 724 "a constructor field"), - (725, yyparsing 725 "field specifications"), - (726, yyparsing 726 "java tokens")]; + (681, yyparsing 681 "java tokens"), + (682, yyparsing 682 "java code"), + (683, yyparsing 683 "java token"), + (684, yyparsing 684 "java token"), + (685, yyparsing 685 "java token"), + (686, yyparsing 686 "java token"), + (687, yyparsing 687 "java token"), + (688, yyparsing 688 "java token"), + (689, yyparsing 689 "java token"), + (690, yyparsing 690 "java token"), + (691, yyparsing 691 "java token"), + (692, yyparsing 692 "java token"), + (693, yyparsing 693 "java token"), + (694, yyexpect 694(yyfromCh '}')), + (695, yyparsing 695 "java tokens"), + (696, yyparsing 696 "a type variable"), + (697, yyexpect 697(yyfromCh ')')), + (698, yyparsing 698 "a type variable"), + (699, yyparsing 699 "a type kind"), + (700, yyparsing 700 "a field specification"), + (701, yyparsing 701 "a field specification"), + (702, yyexpect 702(yyfromId VARID)), + (703, yyexpect 703(yyfromId VARID))]; + sub12 = [ (704, yyparsing 704 "a field specification"), + (705, yyexpect 705(yyfromId DCOLON)), + (706, yyparsing 706 "field specifications"), + (707, yyparsing 707 "a field specification"), + (708, yyparsing 708 "a field specification"), + (709, yyparsing 709 "a variant of an algebraic datatype"), + (710, yyparsing 710 "constructor fields"), + (711, yyparsing 711 "constructor fields"), + (712, yyparsing 712 "a non function type"), + (713, yyparsing 713 "a list of types separated by '|'"), + (714, yyparsing 714 "a non function type"), + (715, yyparsing 715 "case alternative"), + (716, yyparsing 716 "list of case alternatives"), + (717, yyparsing 717 "a list of member imports"), + (718, yyparsing 718 "java tokens"), + (719, yyexpect 719(yyfromCh '}')), + (720, yyparsing 720 "java code"), + (721, yyparsing 721 "java tokens"), + (722, yyparsing 722 "a type kind"), + (723, yyparsing 723 "a type kind"), + (724, yyparsing 724 "a field specification"), + (725, yyparsing 725 "a field specification"), + (726, yyparsing 726 "a field specification"), + (727, yyparsing 727 "a field specification"), + (728, yyparsing 728 "a constructor field"), + (729, yyparsing 729 "field specifications"), + (730, yyparsing 730 "constructor fields"), + (731, yyparsing 731 "constructor fields"), + (732, yyparsing 732 "a list of types separated by '|'"), + (733, yyparsing 733 "java tokens"), + (734, yyparsing 734 "java tokens"), + (735, yyparsing 735 "a constructor field"), + (736, yyparsing 736 "field specifications"), + (737, yyparsing 737 "java tokens")]; in sub1 `seq` sub2 `seq` sub3 `seq` sub4 `seq` sub5 `seq` sub6 `seq` sub7 `seq` sub8 `seq` sub9 `seq` sub10 `seq` sub11 `seq` sub12 `seq` arrayFromIndexList (sub1 ++ sub2 ++ sub3 ++ sub4 ++ sub5 ++ sub6 ++ sub7 ++ sub8 ++ sub9 ++ sub10 ++ sub11 ++ sub12); private yyeacts = let sub1 = [ (2, yyAccept), (4, (-19)), (5, (-17)), - (10, (-169)), + (10, (-170)), (11, (-12)), - (13, (-174)), - (14, (-175)), - (15, (-172)), - (16, (-170)), - (17, (-171)), - (18, (-173)), + (13, (-175)), + (14, (-176)), + (15, (-173)), + (16, (-171)), + (17, (-172)), + (18, (-174)), (19, (-15)), (21, (-20)), - (24, (-183)), + (24, (-184)), (26, (-114)), - (38, (-347)), - (39, (-348)), - (49, (-351)), - (50, (-350)), - (51, (-353)), - (52, (-354)), - (53, (-355)), - (54, (-356)), - (55, (-349)), - (56, (-357)), - (57, (-352)), - (61, (-192)), - (62, (-191)), - (64, (-426)), + (38, (-351)), + (39, (-352)), + (49, (-355)), + (50, (-354)), + (51, (-357)), + (52, (-358)), + (53, (-359)), + (54, (-360)), + (55, (-353)), + (56, (-361)), + (57, (-356)), + (61, (-193)), + (62, (-192)), + (64, (-430)), (66, (-26)), (67, (-29)), (68, (-30)), @@ -9911,375 +10038,380 @@ private yyeacts = let (77, (-118)), (78, (-119)), (79, (-120)), - (80, (-124)), + (80, (-121)), (81, (-125)), (82, (-126)), - (83, (-203)), - (84, (-424)), - (85, (-427)), - (90, (-210)), - (91, (-338)), - (94, (-425)), - (95, (-400)), - (96, (-396)), - (97, (-401)), - (98, (-402)), - (99, (-404)), - (101, (-410)), - (102, (-23)), - (107, (-14)), - (109, (-21)), - (110, (-184)), - (111, (-182)), - (113, (-185))]; - sub2 = [ (114, (-179)), - (115, (-142)), - (116, (-193)), - (117, (-195)), + (83, (-127)), + (84, (-204)), + (85, (-428)), + (86, (-431)), + (91, (-211)), + (92, (-342)), + (93, (-342)), + (96, (-429)), + (97, (-404)), + (98, (-400)), + (99, (-405)), + (100, (-406)), + (101, (-408)), + (103, (-414)), + (104, (-23)), + (109, (-14)), + (111, (-21)), + (112, (-185))]; + sub2 = [ (113, (-183)), + (115, (-186)), + (116, (-180)), + (117, (-143)), (118, (-194)), - (119, (-168)), - (121, (-190)), - (122, (-213)), + (119, (-196)), + (120, (-195)), + (121, (-169)), + (123, (-191)), (124, (-214)), - (125, (-212)), - (126, (-211)), - (130, (-293)), - (134, (-268)), - (135, (-338)), - (138, (-276)), - (139, (-279)), - (140, (-338)), - (141, (-35)), - (143, (-180)), - (146, (-388)), - (148, (-281)), - (152, (-32)), - (153, (-33)), - (154, (-34)), - (155, (-209)), - (156, (-395)), - (158, (-430)), - (165, (-441)), - (170, (-3)), - (171, (-27)), - (173, (-345)), - (175, (-405)), - (176, (-197)), - (177, (-198)), - (178, (-196)), - (179, (-199)), - (180, (-201)), - (184, (-282)), - (187, (-344)), - (188, (-376)), - (191, (-403)), - (195, (-1)), - (197, (-25)), - (198, (-13)), - (199, (-181)), - (200, (-178)), - (202, (-142)), - (203, (-142)), - (205, (-139)), - (212, (-5)), - (213, (-6)), - (215, (-7)), - (216, (-11)), - (218, (-215)), - (219, (-4)), - (220, (-216)), - (221, (-217)), - (223, (-220)), - (225, (-250)), - (235, (-264)), - (237, (-271)), - (242, (-255)), - (243, (-272)), - (244, (-244))]; - sub3 = [ (245, (-245)), - (247, (-280)), - (253, (-390)), - (258, (-134)), - (265, (-361)), - (268, (-447)), - (272, (-431)), - (274, (-440)), - (282, (-442)), - (284, (-385)), - (285, (-384)), - (286, (-407)), - (287, (-28)), - (289, (-428)), - (293, (-200)), - (295, (-202)), - (296, (-227)), - (297, (-228)), - (298, (-234)), - (299, (-233)), - (300, (-243)), - (301, (-319)), - (302, (-208)), - (307, (-343)), - (308, (-377)), - (309, (-393)), - (310, (-394)), - (311, (-412)), - (314, (-413)), - (315, (-414)), - (322, (-189)), - (324, (-188)), - (325, (-142)), - (326, (-141)), - (327, (-146)), - (331, (-144)), - (335, (-150)), - (336, (-153)), - (337, (-154)), - (338, (-155)), - (340, (-42)), - (341, (-237)), - (342, (-236)), - (345, (-206)), - (346, (-204)), - (347, (-205)), - (349, (-10)), - (351, (-288)), - (352, (-239)), - (354, (-218)), - (355, (-223)), - (356, (-224)), - (357, (-226)), - (361, (-310)), - (368, (-295)), - (369, (-300)), - (370, (-303)), - (371, (-309)), + (126, (-215)), + (127, (-213)), + (128, (-212)), + (132, (-295)), + (136, (-269)), + (137, (-342)), + (140, (-277)), + (141, (-280)), + (142, (-342)), + (144, (-35)), + (146, (-181)), + (149, (-392)), + (151, (-282)), + (155, (-32)), + (156, (-33)), + (157, (-34)), + (158, (-210)), + (159, (-399)), + (161, (-434)), + (168, (-445)), + (173, (-3)), + (174, (-27)), + (176, (-349)), + (178, (-409)), + (179, (-198)), + (180, (-199)), + (181, (-197)), + (182, (-200)), + (183, (-202)), + (187, (-283)), + (188, (-284)), + (191, (-348)), + (192, (-380)), + (195, (-407)), + (199, (-1)), + (201, (-25)), + (202, (-13)), + (203, (-182)), + (204, (-179)), + (206, (-143)), + (207, (-143)), + (209, (-140)), + (216, (-5)), + (217, (-6)), + (219, (-7)), + (220, (-11)), + (222, (-216)), + (223, (-4)), + (224, (-217)), + (225, (-218)), + (227, (-221)), + (229, (-251)), + (239, (-265)), + (241, (-272))]; + sub3 = [ (246, (-256)), + (247, (-273)), + (248, (-245)), + (249, (-246)), + (251, (-281)), + (252, (-295)), + (258, (-394)), + (263, (-135)), + (270, (-365)), + (273, (-451)), + (277, (-435)), + (279, (-444)), + (287, (-446)), + (289, (-389)), + (290, (-388)), + (291, (-411)), + (292, (-28)), + (294, (-432)), + (298, (-201)), + (300, (-203)), + (301, (-228)), + (302, (-229)), + (303, (-235)), + (304, (-234)), + (305, (-244)), + (306, (-323)), + (307, (-209)), + (312, (-347)), + (313, (-381)), + (314, (-397)), + (315, (-398)), + (316, (-416)), + (319, (-417)), + (320, (-418)), + (327, (-190)), + (329, (-189)), + (330, (-143)), + (331, (-142)), + (332, (-147)), + (336, (-145)), + (340, (-151)), + (341, (-154)), + (342, (-155)), + (343, (-156)), + (345, (-42)), + (346, (-238)), + (347, (-237)), + (350, (-207)), + (351, (-205)), + (352, (-206)), + (354, (-10)), + (356, (-292)), + (359, (-219)), + (360, (-224)), + (361, (-225)), + (362, (-227)), + (366, (-314)), (373, (-297)), - (374, (-284)), - (377, (-292)), - (378, (-298)), - (381, (-269)), - (384, (-277))]; - sub4 = [ (387, (-257)), - (390, (-256)), - (395, (-336)), - (397, (-434)), - (398, (-433)), - (399, (-432)), - (400, (-389)), - (402, (-387)), - (410, (-411)), - (411, (-435)), - (416, (-437)), - (417, (-436)), - (418, (-460)), - (421, (-443)), - (423, (-386)), - (424, (-341)), - (427, (-429)), - (432, (-320)), - (436, (-339)), - (438, (-127)), - (441, (-133)), - (443, (-359)), - (444, (-360)), - (452, (-418)), - (454, (-2)), - (456, (-187)), - (457, (-22)), - (459, (-140)), - (462, (-158)), - (463, (-145)), - (465, (-165)), - (466, (-166)), - (467, (-167)), - (468, (-157)), - (471, (-44)), - (473, (-40)), - (474, (-8)), - (475, (-9)), - (477, (-287)), - (487, (-318)), - (488, (-312)), - (489, (-313)), - (490, (-315)), - (491, (-302)), - (492, (-305)), - (493, (-306)), - (494, (-304)), - (495, (-308)), - (496, (-307)), - (497, (-301)), - (498, (-294)), - (499, (-283)), - (500, (-285)), - (501, (-289)), - (504, (-291)), - (505, (-267)), - (506, (-338)), - (507, (-275)), - (508, (-259)), - (509, (-246)), - (512, (-258)), - (513, (-249)), - (514, (-278)), - (515, (-337))]; - sub5 = [ (516, (-392)), - (519, (-358)), - (523, (-138)), - (526, (-371)), - (527, (-362)), - (528, (-369)), - (530, (-439)), - (531, (-438)), - (533, (-445)), - (534, (-444)), - (535, (-342)), - (536, (-457)), - (537, (-449)), - (538, (-231)), - (539, (-230)), - (541, (-234)), - (542, (-235)), - (543, (-232)), - (544, (-128)), - (545, (-129)), - (546, (-130)), - (547, (-132)), - (548, (-340)), - (550, (-373)), - (551, (-375)), - (555, (-422)), - (556, (-423)), - (557, (-417)), - (558, (-454)), - (559, (-415)), - (560, (-416)), - (561, (-455)), - (563, (-452)), - (564, (-186)), - (565, (-177)), - (567, (-152)), - (571, (-149)), - (572, (-143)), - (573, (-238)), - (575, (-240)), - (576, (-222)), - (577, (-225)), - (579, (-262)), - (583, (-253)), - (584, (-254)), - (588, (-317)), - (589, (-316)), - (590, (-314)), - (591, (-286)), - (592, (-299)), - (593, (-290)), - (594, (-270)), - (598, (-391)), - (599, (-397)), - (600, (-379)), - (603, (-380)), - (604, (-398)), - (605, (-399)), - (607, (-463)), - (608, (-365)), - (609, (-229)), - (610, (-123)), - (611, (-421)), - (612, (-419))]; - sub6 = [ (613, (-420)), - (616, (-161)), - (617, (-151)), - (618, (-160)), - (620, (-47)), - (621, (-48)), - (622, (-49)), - (623, (-52)), - (624, (-50)), - (625, (-51)), - (626, (-53)), - (627, (-54)), - (628, (-55)), - (629, (-56)), - (630, (-57)), - (631, (-58)), - (632, (-59)), - (633, (-60)), - (634, (-61)), - (635, (-62)), - (636, (-63)), - (637, (-64)), - (638, (-65)), - (639, (-66)), - (640, (-67)), - (641, (-68)), - (642, (-69)), - (643, (-70)), - (644, (-71)), - (645, (-72)), - (646, (-73)), - (647, (-74)), - (648, (-75)), - (649, (-76)), - (650, (-77)), - (651, (-78)), - (652, (-79)), - (653, (-80)), - (654, (-81)), - (655, (-82)), - (656, (-83)), - (657, (-84)), - (658, (-85)), - (659, (-86)), - (660, (-87)), - (661, (-88)), - (662, (-89)), - (663, (-90)), - (664, (-91)), - (665, (-92)), - (666, (-93)), - (667, (-94)), - (668, (-103)), - (669, (-104)), - (671, (-46)), - (672, (-101)), - (673, (-99)), - (674, (-100)), - (675, (-95)), - (676, (-96)), - (677, (-97)), - (678, (-98)), - (679, (-102)), - (680, (-105))]; - sub7 = [ (681, (-106)), - (682, (-107)), - (685, (-252)), - (687, (-251)), - (693, (-335)), - (696, (-329)), - (697, (-332)), - (698, (-311)), - (701, (-247)), - (703, (-248)), - (704, (-378)), - (705, (-382)), - (706, (-164)), - (709, (-45)), - (710, (-109)), - (711, (-263)), - (712, (-260)), - (713, (-331)), - (714, (-330)), - (715, (-334)), - (716, (-333)), - (719, (-325)), - (720, (-324)), - (721, (-242)), - (722, (-113)), - (724, (-326)), - (725, (-328)), - (726, (-111))]; + (374, (-304)), + (375, (-307)), + (376, (-313)), + (378, (-301)), + (379, (-286)), + (382, (-294))]; + sub4 = [ (383, (-302)), + (386, (-270)), + (389, (-278)), + (392, (-258)), + (395, (-257)), + (402, (-340)), + (404, (-438)), + (405, (-437)), + (406, (-436)), + (407, (-393)), + (409, (-391)), + (417, (-415)), + (418, (-439)), + (423, (-441)), + (424, (-440)), + (425, (-464)), + (428, (-447)), + (430, (-390)), + (431, (-345)), + (434, (-433)), + (439, (-324)), + (443, (-343)), + (445, (-128)), + (448, (-134)), + (450, (-363)), + (451, (-364)), + (459, (-422)), + (461, (-2)), + (463, (-188)), + (464, (-22)), + (466, (-141)), + (469, (-159)), + (470, (-146)), + (472, (-166)), + (473, (-167)), + (474, (-168)), + (475, (-158)), + (478, (-240)), + (479, (-44)), + (481, (-40)), + (482, (-8)), + (483, (-9)), + (485, (-291)), + (495, (-322)), + (496, (-316)), + (497, (-317)), + (498, (-319)), + (499, (-306)), + (500, (-309)), + (501, (-310)), + (502, (-308)), + (503, (-312)), + (504, (-311)), + (505, (-305)), + (506, (-296)), + (507, (-285)), + (508, (-287)), + (509, (-298)), + (512, (-293)), + (513, (-268)), + (514, (-342)), + (515, (-276)), + (516, (-260)), + (517, (-247))]; + sub5 = [ (520, (-259)), + (521, (-250)), + (522, (-279)), + (524, (-341)), + (525, (-396)), + (528, (-362)), + (532, (-139)), + (535, (-375)), + (536, (-366)), + (537, (-373)), + (539, (-443)), + (540, (-442)), + (542, (-449)), + (543, (-448)), + (544, (-346)), + (545, (-461)), + (546, (-453)), + (547, (-232)), + (548, (-231)), + (550, (-235)), + (551, (-236)), + (552, (-233)), + (553, (-129)), + (554, (-130)), + (555, (-131)), + (556, (-133)), + (557, (-344)), + (559, (-377)), + (560, (-379)), + (564, (-426)), + (565, (-427)), + (566, (-421)), + (567, (-458)), + (568, (-419)), + (569, (-420)), + (570, (-459)), + (572, (-456)), + (573, (-187)), + (574, (-178)), + (576, (-153)), + (580, (-150)), + (581, (-144)), + (582, (-239)), + (585, (-290)), + (586, (-223)), + (587, (-226)), + (589, (-263)), + (593, (-254)), + (594, (-255)), + (598, (-321)), + (599, (-320)), + (600, (-318)), + (601, (-288)), + (602, (-303)), + (603, (-299)), + (604, (-271)), + (608, (-395)), + (609, (-401)), + (610, (-383)), + (613, (-384)), + (614, (-402)), + (615, (-403)), + (617, (-467)), + (618, (-369))]; + sub6 = [ (619, (-230)), + (620, (-124)), + (621, (-425)), + (622, (-423)), + (623, (-424)), + (626, (-162)), + (627, (-152)), + (628, (-161)), + (630, (-241)), + (631, (-47)), + (632, (-48)), + (633, (-49)), + (634, (-52)), + (635, (-50)), + (636, (-51)), + (637, (-53)), + (638, (-54)), + (639, (-55)), + (640, (-56)), + (641, (-57)), + (642, (-58)), + (643, (-59)), + (644, (-60)), + (645, (-61)), + (646, (-62)), + (647, (-63)), + (648, (-64)), + (649, (-65)), + (650, (-66)), + (651, (-67)), + (652, (-68)), + (653, (-69)), + (654, (-70)), + (655, (-71)), + (656, (-72)), + (657, (-73)), + (658, (-74)), + (659, (-75)), + (660, (-76)), + (661, (-77)), + (662, (-78)), + (663, (-79)), + (664, (-80)), + (665, (-81)), + (666, (-82)), + (667, (-83)), + (668, (-84)), + (669, (-85)), + (670, (-86)), + (671, (-87)), + (672, (-88)), + (673, (-89)), + (674, (-90)), + (675, (-91)), + (676, (-92)), + (677, (-93)), + (678, (-94)), + (679, (-103)), + (680, (-104)), + (682, (-46)), + (683, (-101)), + (684, (-99)), + (685, (-100)), + (686, (-95))]; + sub7 = [ (687, (-96)), + (688, (-97)), + (689, (-98)), + (690, (-102)), + (691, (-105)), + (692, (-106)), + (693, (-107)), + (696, (-253)), + (698, (-252)), + (704, (-339)), + (707, (-333)), + (708, (-336)), + (709, (-315)), + (712, (-248)), + (714, (-249)), + (715, (-382)), + (716, (-386)), + (717, (-165)), + (720, (-45)), + (721, (-109)), + (722, (-264)), + (723, (-261)), + (724, (-335)), + (725, (-334)), + (726, (-338)), + (727, (-337)), + (730, (-329)), + (731, (-328)), + (732, (-243)), + (733, (-113)), + (735, (-330)), + (736, (-332)), + (737, (-111))]; in sub1 `seq` sub2 `seq` sub3 `seq` sub4 `seq` sub5 `seq` sub6 `seq` sub7 `seq` arrayFromIndexList (sub1 ++ sub2 ++ sub3 ++ sub4 ++ sub5 ++ sub6 ++ sub7); @@ -10291,218 +10423,223 @@ decodeArr s1 s2 = arrayFromIndexList (zip (un s1) (un s2)) private yygo0 = decodeArr "\u0001\u0002\u0003\u0010\u0011\u0012\u0013" "\u0002\u0002\u0002\u0004\u0004\u0003\u0003"; private yygo1 = decodeArr "\u0010\u0011" "\u0005\u0005"; private yygo3 = decodeArr "\u0014\u0015\u0016" "\t\t\t"; -private yygo6 = decodeArr "\f\r\u000e\u000f©ª«¬­®¯" "\u0013\u0013\u0013\u0015\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; -private yygo8 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwx|}~\u008b\u008c\u008d¨²³´µ¶·¿ÀÁÂÃÉÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "AAABBBEEEEDDDDJCFFFFFFOOOHHHSTTTUUUVVWWWIPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo9 = decodeArr "\u0017\u0018\u0019" "jii"; -private yygo12 = decodeArr "\f\r\u000e©ª«¬­®¯" "kkk\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; -private yygo22 = decodeArr "\f\r\u000e\u000f©ª«¬­®¯" "\u0013\u0013\u0013m\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; -private yygo25 = decodeArr "¸¹¿À" "rrqq"; -private yygo27 = decodeArr "\f\r\u000e\u000f©ª«¬­®¯" "\u0013\u0013\u0013s\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; -private yygo31 = decodeArr "¨¾¿ÀËÌÍÎÓÔÕÖÚÛÜÝ" "S|}}~~~~\u007f\u007f\u007f\u007f\u0080\u0080\u0080\u0080"; -private yygo34 = decodeArr "µ¶·ĈČč" "\u0085\u0085\u0085\u0086\u0087\u0087"; -private yygo35 = decodeArr "µ¶·ĐĔĕĖė" "\u0089\u0089\u0089\u008a\u008b\u008b\u008c\u008c"; -private yygo36 = decodeArr "ĚġĢģĤĥĦħ" "\u008d[[[[[[["; -private yygo40 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_\u0091\u0091\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo41 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_\u0093\u0093\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo42 = decodeArr "µ¶·ĐĔĕĖė" "\u0089\u0089\u0089\u008a\u008b\u008b\u0094\u0094"; -private yygo45 = decodeArr "stuvwx|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "\u0098\u0098\u0098\u0098\u0098\u0098OOOSTTTUUUVVPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo46 = decodeArr "stuvwx|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "\u0099\u0099\u0099\u0099\u0099\u0099OOOSTTTUUUVVPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo47 = decodeArr "stuvwx|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "\u009a\u009a\u009a\u009a\u009a\u009aOOOSTTTUUUVVPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo48 = decodeArr "â" "\u009b"; -private yygo58 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_\u009c\u009c\u009c\u009c\u009caabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo59 = decodeArr "²³´µ¶·¾¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿ" "TTTUUU ¡¡^^^^^^^^^^^_££¤¤¤¤`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee¢¢"; -private yygo60 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽNjnjǍ" "TTTUUUVV^^^^^^^^^^^_¦¦\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee§§§"; -private yygo63 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƖƗƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^©©¨¨ddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo82 = decodeArr "ŕŖ" "­­"; -private yygo86 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^¯¯ddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo87 = decodeArr "¾ÄÅÆÇÈ" "²³³³´´"; -private yygo91 = decodeArr "ŒœŔ" "¸¸¸"; -private yygo92 = decodeArr "ŷŸŹ" "¼»»"; -private yygo97 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^¿¿ddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo104 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwx|}~\u008b\u008c\u008d¨²³´µ¶·¿ÀÁÂÃÉÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ÃÃÃBBBEEEEDDDDJCFFFFFFOOOHHHSTTTUUUVVWWWIPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo106 = decodeArr "\u0017\u0018\u0019" "jÅÅ"; -private yygo108 = decodeArr "\f\r\u000e©ª«¬­®¯" "ÆÆÆ\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; -private yygo112 = decodeArr "¸¹¿À" "ÈÈqq"; -private yygo115 = decodeArr "\u008e\u008f\u0090\u0091\u0092¨" "ÍÍÍÍÍÎ"; -private yygo120 = decodeArr ")*" "ÐÐ"; -private yygo123 = decodeArr "¾¿À" "ÒÓÓ"; -private yygo127 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000b¾¿À×ØÙğĠ" "ÚÛÛÛÛÛÛÛÜÝÝÞÞÞßß"; -private yygo129 = decodeArr "úûüýþĨĩ" "åååååää"; -private yygo130 = decodeArr "úûüýþĨĩ" "åååååçç"; -private yygo132 = decodeArr "µ¶·ĈĉĊċ" "\u0085\u0085\u0085éêêê"; -private yygo133 = decodeArr "úûüýþ" "ëëëëë"; -private yygo135 = decodeArr "ŒœŔ" "ííí"; -private yygo136 = decodeArr "µ¶·ĐđĒē" "\u0089\u0089\u0089îïïï"; -private yygo137 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂă" "òòòóóóóóóôôôôôõõõõõ"; -private yygo140 = decodeArr "ŒœŔ" "÷÷÷"; -private yygo142 = decodeArr "úûüýþĨĩ" "åååååùù"; -private yygo144 = decodeArr "²³´µ¶·¾¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿ" "TTTUUUûüü^^^^^^^^^^^_££¤¤¤¤`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee¢¢"; -private yygo145 = decodeArr "ƅƆ" "ÿÿ"; -private yygo149 = decodeArr "\u0086\u0087\u0088\u0089\u008a¨²³´µ¶·¿ÀÊËÌÍÎÏÐŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ĄĄąąąSTTTUUUVVĂYYYYXXăăă\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo150 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťũŪūůŰűŲųƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ĈĈĈĊĊĊĉĉ_ćć\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo151 = decodeArr "¨¾¿ÀËÌÍÎÓÔÕÖÚÛÜÝ" "S|}}~~~~\u007f\u007f\u007f\u007f\u0080\u0080\u0080\u0080"; -private yygo157 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_\u009c\u009c\u009c\u009c\u009caabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo159 = decodeArr "ƾƿ" "ČČ"; -private yygo160 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĎĎ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo161 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^¯¯ddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo164 = decodeArr "¾" "Ė"; -private yygo168 = decodeArr "ƀƁƂ" "Ĝĝĝ"; -private yygo169 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƖƗƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^©©ĞĞddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo171 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwx|}~\u008b\u008c\u008d¨²³´µ¶·¿ÀÁÂÃÉÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ğğğBBBEEEEDDDDJCFFFFFFOOOHHHSTTTUUUVVWWWIPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo174 = decodeArr "¨ǀǁǂljNJ" "ĢģģģĤĤ"; -private yygo179 = decodeArr "¾ÄÅÆÇÈ" "²³³³ĥĥ"; -private yygo181 = decodeArr "µ¶·ãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòħħĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo182 = decodeArr "¨ËÌÍÎÏÐ" "SYYYYĮĮ"; -private yygo185 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťŲųŴŵŶƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ııIJIJIJ_İİ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo186 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ijij\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo188 = decodeArr "ŷŸŹ" "¼ĴĴ"; -private yygo189 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĵĵĵĵ`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo190 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĶĶĶĶ`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo192 = decodeArr "¾¿À" "ĺĻĻ"; -private yygo193 = decodeArr "ǃDŽDždžLJLj" "ĽĽĽľľľ"; -private yygo194 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwx|}~\u008b\u008c\u008d¨²³´µ¶·¿ÀÁÂÃÉÊËÌÍÎÏÐÑÒâĎďĘęĚġĢģĤĥĦħŐőŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ĿĿĿBBBEEEEDDDDJCFFFFFFOOOHHHSTTTUUUVVWWWIPYYYYXXQQZLLMNG[[[[[[[KKRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo196 = decodeArr "°±¸¹º»¼½¾¿À" "ŁŁńńŃŃŃŃłqq"; -private yygo202 = decodeArr "\u008e\u008f\u0090\u0091\u0092¨" "ņņņņņÎ"; -private yygo203 = decodeArr "\u008e\u008f\u0090\u0091\u0092¨" "ŇŇŇŇŇÎ"; -private yygo204 = decodeArr "\u0093\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e²³´µ¶·¾¿À" "ŌŌŌŎŎŎŎŎŎōōōŏŏŏŐŐŐőŒŒ"; -private yygo207 = decodeArr "µ¶·åìíîóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŕŔŔŔŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo208 = decodeArr "+," "ŘŘ"; -private yygo214 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ŝŝŝŝŝŝŝ"; -private yygo217 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠššŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo222 = decodeArr "ğĠ" "ŢŢ"; -private yygo224 = decodeArr "µ¶·Þßàáãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŤŤťťţţĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo227 = decodeArr "ĬĭĮįİıIJijĴĵĶķĸ" "ŰŰŰűűűűŲŲŲųųų"; -private yygo229 = decodeArr "úûüýþĨĩ" "åååååŵŵ"; -private yygo230 = decodeArr "ěĜĪīĬĭĮįİıIJijĴĵĶķĸ" "ŸŸŹŹźźźűűűűŲŲŲųųų"; -private yygo240 = decodeArr "µ¶·åìíîóôõö÷øùúûüýþÿĀāĂăĿŀƾƿ" "òòòŕƄƄƄŖĭĭĭĭĭĭôôôôôõõõõõĬĬƅƅ"; -private yygo241 = decodeArr "µ¶·åìíîóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŕƇƇƇŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo246 = decodeArr "µ¶·ÿĀāĂă" "òòòƊƊƊƊƊ"; -private yygo248 = decodeArr "µ¶·ãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòƋƋĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo250 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_\u009c\u009c\u009c\u009c\u009caabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo251 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĎĎ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo252 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^¯¯ddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo255 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ƑƑ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo256 = decodeArr "µ¶·ãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòƒƒĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo259 = decodeArr "ŕŖ" "­­"; -private yygo273 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽǎǏǐ" "TTTUUUVV^^^^^^^^^^^_ƜƜ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeeeƝƝƝ"; -private yygo275 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽNjnjǍ" "TTTUUUVV^^^^^^^^^^^_ƞƞ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeeeƟƟƟ"; -private yygo276 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĵĵĵĵ`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo277 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ĶĶĶĶ`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo279 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽNjnjǍ" "TTTUUUVV^^^^^^^^^^^_ƞƞ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeeeƢƢƢ"; -private yygo280 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťũŪūŬŭŮŲųƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ƣƣƣƤƤƤĉĉ_ćć\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo281 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ƦƦ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo283 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ƧƧ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo288 = decodeArr "\u0086\u0087\u0088\u0089\u008a¨²³´µ¶·¿ÀÊËÌÍÎÏÐŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ĄĄƩƩƩSTTTUUUVVĂYYYYXXăăă\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo294 = decodeArr "úûüýþĨĩ" "åååååƭƭ"; -private yygo301 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòĭĭĭĭĭĭôôôôôõõõõõưư"; -private yygo303 = decodeArr "ryz{|}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ƵƷƷƷƶƶƶƹƹƹƹƸƸƸSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo306 = decodeArr "ŧŨ" "ƽƽ"; -private yygo312 = decodeArr "ǃDŽDždžLJLj" "ƿƿƿľľľ"; -private yygo313 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ǀǀ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo320 = decodeArr "¸¹¿À" "LjLjqq"; -private yygo325 = decodeArr "\u008e\u008f\u0090\u0091\u0092¨" "NjNjNjNjNjÎ"; -private yygo329 = decodeArr "¸¹¿À" "rrqq"; -private yygo330 = decodeArr "\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e²³´µ¶·¾¿À" "ŎŎŎŎŎŎǎǎǎŏŏŏŐŐŐőŒŒ"; -private yygo334 = decodeArr "¥¦§¾" "ǔǔǔǓ"; -private yygo339 = decodeArr "\u0093\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e²³´µ¶·¾¿À" "ǕǕǕŎŎŎŎŎŎōōōŏŏŏŐŐŐőŒŒ"; -private yygo343 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠǗǗŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo344 = decodeArr "-." "ǙǙ"; -private yygo348 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ǚǚǚǚǚǚǚ"; -private yygo350 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ǛǛǛǛǛǛǛ"; -private yygo359 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠǢǢŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo360 = decodeArr "µ¶·óôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòǣĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo361 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂăĹĺĻļĽľ" "òòòǧǧǧǧǧǧôôôôôõõõõõǨǨǩǩǩǪ"; -private yygo362 = decodeArr "įİıIJijĴĵĶķĸ" "ǫǫǫǫŲŲŲųųų"; -private yygo363 = decodeArr "ijĴĵĶķĸ" "ǬǬǬųųų"; -private yygo364 = decodeArr "ijĴĵĶķĸ" "ǭǭǭųųų"; -private yygo365 = decodeArr "ijĴĵĶķĸ" "ǮǮǮųųų"; -private yygo366 = decodeArr "Ķķĸ" "ǯǯǯ"; -private yygo367 = decodeArr "Ķķĸ" "ǰǰǰ"; -private yygo372 = decodeArr "ĬĭĮįİıIJijĴĵĶķĸ" "DzDzDzűűűűŲŲŲųųų"; -private yygo376 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000bĝĞ" "ǴÛÛÛÛÛÛÛǵǵ"; -private yygo379 = decodeArr "ěĜĪīĬĭĮįİıIJijĴĵĶķĸ" "ǷǷǸǸźźźűűűűŲŲŲųųų"; -private yygo380 = decodeArr "µ¶·ĈĉĊċ" "\u0085\u0085\u0085éǹǹǹ"; -private yygo382 = decodeArr "úûüýþ" "ǺǺǺǺǺ"; -private yygo383 = decodeArr "µ¶·ĐđĒē" "\u0089\u0089\u0089îǻǻǻ"; -private yygo392 = decodeArr "ƾƿ" "ƅƅ"; -private yygo394 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂă" "òòòȂȂȂȂȂȂôôôôôõõõõõ"; -private yygo396 = decodeArr "µ¶·ãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòȃȃĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo401 = decodeArr "Ƈƈ" "ȆȆ"; -private yygo403 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťŦźŻżŽžſƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ȈȉȉȉȊȊȊ_ȇȇ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo404 = decodeArr "\u0086\u0087\u0088\u0089\u008a¨²³´µ¶·¿ÀÊËÌÍÎÏÐŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ĄĄȋȋȋSTTTUUUVVĂYYYYXXăăă\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo406 = decodeArr "\u0086\u0087\u0088\u0089\u008a¨²³´µ¶·¿ÀÊËÌÍÎÏÐŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ĄĄȍȍȍSTTTUUUVVĂYYYYXXăăă\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo407 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȎȎ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo408 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȏȏ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo409 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťũŪūůŰűŲųƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ĈĈĈȐȐȐĉĉ_ćć\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo426 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȘȘ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo428 = decodeArr "¨ǀǁǂljNJ" "ĢșșșĤĤ"; -private yygo429 = decodeArr "æç" "ȜȜ"; -private yygo430 = decodeArr "µ¶·êëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòȞȞȝĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo431 = decodeArr "µ¶·êëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòȟȟȝĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo433 = decodeArr "|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ȠȠȠSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo434 = decodeArr "|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ȡȡȡSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo435 = decodeArr "|}~¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ȢȢȢSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo437 = decodeArr "r|}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ƵƶƶƶƹƹƹƹȣȣȣSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo442 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťŲųŴŵŶƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ııȦȦȦ_İİ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo445 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȧȧ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo449 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȮȮ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo451 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȱȱ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo453 = decodeArr "ǃDŽDždžLJLj" "ȳȳȳľľľ"; -private yygo455 = decodeArr "¸¹¿À" "ȴȴqq"; -private yygo458 = decodeArr "°±¸¹º»¼½¾¿À" "ȵȵńńŃŃŃŃłqq"; -private yygo460 = decodeArr "\u009f ¡¢£¤¥¦§¾" "ȺȺȺȸȸȸȹȹȹǓ"; -private yygo461 = decodeArr "¸¹¿À" "ÈÈqq"; -private yygo464 = decodeArr "\u0093\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e²³´µ¶·¾¿À" "ȻȻȻŎŎŎŎŎŎōōōŏŏŏŐŐŐőŒŒ"; -private yygo470 = decodeArr "µ¶·åìíîóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŕȽȽȽŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo476 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠȿȿŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo478 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠɀɀŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo479 = decodeArr "µ¶·Þßàáãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŤŤɁɁţţĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo480 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠɂɂŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo481 = decodeArr "ĄąĆć" "ɅɅɆɆ"; -private yygo484 = decodeArr "\u0010\u0011\u0012\u0013ŁłŃńŅņ" "\u0004\u0004ɉɉɊɊɊɊɊɋ"; -private yygo485 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂăľ" "òòòǧǧǧǧǧǧôôôôôõõõõõɌ"; -private yygo486 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂăľ" "òòòǧǧǧǧǧǧôôôôôõõõõõɍ"; -private yygo489 = decodeArr "µ¶·ôõö÷øùúûüýþÿĀāĂăĹĺĻļĽľ" "òòòǧǧǧǧǧǧôôôôôõõõõõɎɎǩǩǩǪ"; -private yygo500 = decodeArr "ğĠ" "ɏɏ"; -private yygo502 = decodeArr "ĪīĬĭĮįİıIJijĴĵĶķĸ" "ɐɐźźźűűűűŲŲŲųųų"; -private yygo503 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000bĝĞ" "ǴÛÛÛÛÛÛÛɑɑ"; -private yygo506 = decodeArr "ŒœŔ" "ɒɒɒ"; -private yygo510 = decodeArr "µ¶·åìíîïðóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò੩ŠɓɓŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo511 = decodeArr "µ¶·åìíîñòóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŕɔɔɔɕɕŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo518 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ɗɗ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo520 = decodeArr "ŧŨŷŸŹ" "əə¼ɘɘ"; -private yygo521 = decodeArr "ŕŖ" "ɛɛ"; -private yygo524 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ɝɝ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo529 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽǎǏǐ" "TTTUUUVV^^^^^^^^^^^_ƜƜ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeeeɟɟɟ"; -private yygo532 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťũŪūŬŭŮŲųƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^ƣƣƣɠɠɠĉĉ_ćć\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo540 = decodeArr "µ¶·èéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòɡɡīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo549 = decodeArr "ryz{|}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085¨²³´µ¶·¿ÀÊËÌÍÎÏÐÑÒâŗŘřŚśŜŝŞşŠšŢţŤťƀƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "ƵɢɢɢƶƶƶƹƹƹƹƸƸƸSTTTUUUVVPYYYYXXQQZRRR\\^^^^^^^^^^^_]]]]`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo552 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȮȮ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo554 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȱȱ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo566 = decodeArr "\u009f ¡¥¦§¾" "ɨɨɨȹȹȹǓ"; -private yygo569 = decodeArr "¥¦§¾" "ɪɪɪǓ"; -private yygo574 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʫʫʫʫʫʫ"; -private yygo580 = decodeArr "ĄąĆć" "ʮʮɆɆ"; -private yygo585 = decodeArr "¨ŇňʼnŊŋŌōŎŏ" "ʵʶʶʷʷʷʸʸʸʹ"; -private yygo601 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ˀˀ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo602 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťŦźŻżŽžſƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^Ȉȉȉȉˁˁˁ_ȇȇ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo614 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȮȮ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo615 = decodeArr "²³´µ¶·¿ÀśŜŝŞşŠšŢţŤťƀƃƄƉƊƋƌƍƎƏƐƑƒƓƔƕƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽ" "TTTUUUVV^^^^^^^^^^^_ȱȱ\u0092\u0092\u0092\u0092`````aabbddcccccccccccccceeeeeeeeeeeeeeeeeeeeee"; -private yygo619 = decodeArr "\u009f ¡¢£¤¥¦§¾" "ȺȺȺ˂˂˂ȹȹȹǓ"; -private yygo670 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬ˄˄˄˄˄˄"; -private yygo684 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬˆˆˆˆˆˆ"; -private yygo688 = decodeArr "ĄąĆć" "ˈˈɆɆ"; -private yygo689 = decodeArr "¨ŌōŎŏ" "ʵˉˉˉʹ"; -private yygo690 = decodeArr "¨ŌōŎŏ" "ʵˊˊˊʹ"; -private yygo691 = decodeArr "¨ŏ" "ʵˋ"; -private yygo692 = decodeArr "¨ŏ" "ʵˌ"; -private yygo699 = decodeArr "\u0010\u0011\u0012\u0013ŁłŃńŅņ" "\u0004\u0004ɉɉˏˏˏˏˏɋ"; -private yygo700 = decodeArr "\u0010\u0011\u0012\u0013ŁłŃńŅņ" "\u0004\u0004ɉɉːːːːːɋ"; -private yygo702 = decodeArr "µ¶·åìíîñòóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòòŕɔɔɔˑˑŖĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo707 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬ˒˒˒˒˒˒"; -private yygo717 = decodeArr "µ¶·ãäåèéêëóôõö÷øùúûüýþÿĀāĂăĿŀ" "òòò˔˔ĨĩĩīīĪĭĭĭĭĭĭôôôôôõõõõõĬĬ"; -private yygo718 = decodeArr "¨ŇňʼnŊŋŌōŎŏ" "ʵ˕˕ʷʷʷʸʸʸʹ"; -private yygo723 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬʬ˖˖˖˖˖˖"; +private yygo6 = decodeArr "\f\r\u000e\u000fª«¬­®¯°" "\u0013\u0013\u0013\u0015\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; +private yygo8 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwxy}~\u007f\u008c\u008d\u008e©³´µ¶·¸ÀÁÂÃÄÊËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "AAABBBEEEEDDDDJCFFFFFFFPPPHHHTUUUVVVWWXXXIQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo9 = decodeArr "\u0017\u0018\u0019" "lkk"; +private yygo12 = decodeArr "\f\r\u000eª«¬­®¯°" "mmm\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; +private yygo22 = decodeArr "\f\r\u000e\u000fª«¬­®¯°" "\u0013\u0013\u0013o\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; +private yygo25 = decodeArr "¹ºÀÁ" "ttss"; +private yygo27 = decodeArr "\f\r\u000e\u000fª«¬­®¯°" "\u0013\u0013\u0013u\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; +private yygo31 = decodeArr "©¿ÀÁÌÍÎÏÔÕÖ×ÛÜÝÞ" "T~\u007f\u007f\u0080\u0080\u0080\u0080\u0081\u0081\u0081\u0081\u0082\u0082\u0082\u0082"; +private yygo34 = decodeArr "¶·¸ĉčĎ" "\u0087\u0087\u0087\u0088\u0089\u0089"; +private yygo35 = decodeArr "¶·¸đĕĖėĘ" "\u008b\u008b\u008b\u008c\u008d\u008d\u008e\u008e"; +private yygo36 = decodeArr "ěĥĦħĨĩ" "\u0090\\\\\\\\\\"; +private yygo40 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````a\u0094\u0094\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo41 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````a\u0096\u0096\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo42 = decodeArr "¶·¸đĕĖėĘ" "\u008b\u008b\u008b\u008c\u008d\u008d\u0097\u0097"; +private yygo45 = decodeArr "stuvwxy}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "\u009b\u009b\u009b\u009b\u009b\u009b\u009bPPPTUUUVVVWWQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo46 = decodeArr "stuvwxy}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "\u009c\u009c\u009c\u009c\u009c\u009c\u009cPPPTUUUVVVWWQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo47 = decodeArr "stuvwxy}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "\u009d\u009d\u009d\u009d\u009d\u009d\u009dPPPTUUUVVVWWQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo48 = decodeArr "ã" "\u009e"; +private yygo58 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````a\u009f\u009f\u009f\u009f\u009fccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo59 = decodeArr "³´µ¶·¸¿ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǂǃ" "UUUVVV£¤¤```````````a¦¦§§§§bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg¥¥"; +private yygo60 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǏǐǑ" "UUUVVVWW```````````a©©\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeeggggggggggggggggggggggªªª"; +private yygo63 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````¬¬««ffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo83 = decodeArr "řŚ" "°°"; +private yygo87 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````²²ffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo88 = decodeArr "¿ÅÆÇÈÉ" "µ¶¶¶··"; +private yygo92 = decodeArr "ŖŗŘ" "»»»"; +private yygo93 = decodeArr "ŖŗŘ" "¼¼¼"; +private yygo94 = decodeArr "ŻżŽ" "À¿¿"; +private yygo99 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ÃÃffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo106 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwxy}~\u007f\u008c\u008d\u008e©³´µ¶·¸ÀÁÂÃÄÊËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ÇÇÇBBBEEEEDDDDJCFFFFFFFPPPHHHTUUUVVVWWXXXIQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo108 = decodeArr "\u0017\u0018\u0019" "lÉÉ"; +private yygo110 = decodeArr "\f\r\u000eª«¬­®¯°" "ÊÊÊ\u0014\u0014\u0014\u0014\u0014\u0014\u0014"; +private yygo114 = decodeArr "¹ºÀÁ" "ÌÌss"; +private yygo117 = decodeArr "\u008f\u0090\u0091\u0092\u0093©" "ÑÑÑÑÑÒ"; +private yygo122 = decodeArr ")*" "ÔÔ"; +private yygo125 = decodeArr "¿ÀÁ" "Ö××"; +private yygo129 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000b¿ÀÁØÙÚģĤ" "Þßßßßßßßàááâââãã"; +private yygo131 = decodeArr "ûüýþÿĬĭ" "éééééèè"; +private yygo132 = decodeArr "ûüýþÿĬĭ" "éééééëë"; +private yygo134 = decodeArr "¶·¸ĉĊċČ" "\u0087\u0087\u0087íîîî"; +private yygo135 = decodeArr "ûüýþÿ" "ïïïïï"; +private yygo137 = decodeArr "ŖŗŘ" "ñññ"; +private yygo138 = decodeArr "¶·¸đĒēĔ" "\u008b\u008b\u008bòóóó"; +private yygo139 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂăĄ" "ööö÷÷÷÷÷÷øøøøøùùùùù"; +private yygo142 = decodeArr "ŖŗŘ" "ûûû"; +private yygo145 = decodeArr "ûüýþÿĬĭ" "éééééþþ"; +private yygo147 = decodeArr "³´µ¶·¸¿ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǂǃ" "UUUVVVĀāā```````````a¦¦§§§§bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg¥¥"; +private yygo148 = decodeArr "ƉƊ" "ĄĄ"; +private yygo152 = decodeArr "\u0087\u0088\u0089\u008a\u008b©³´µ¶·¸ÀÁËÌÍÎÏÐÑśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ĉĉĊĊĊTUUUVVVWWćZZZZYYĈĈĈ^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo153 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŭŮůųŴŵŶŷƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````čččďďďĎĎaČČ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo154 = decodeArr "©¿ÀÁÌÍÎÏÔÕÖ×ÛÜÝÞ" "T~\u007f\u007f\u0080\u0080\u0080\u0080\u0081\u0081\u0081\u0081\u0082\u0082\u0082\u0082"; +private yygo160 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````a\u009f\u009f\u009f\u009f\u009fccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo162 = decodeArr "ǂǃ" "đđ"; +private yygo163 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aēē\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo164 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````²²ffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo167 = decodeArr "¿" "ě"; +private yygo171 = decodeArr "ƄƅƆ" "ġĢĢ"; +private yygo172 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƚƛƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````¬¬ģģffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo174 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwxy}~\u007f\u008c\u008d\u008e©³´µ¶·¸ÀÁÂÃÄÊËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ĤĤĤBBBEEEEDDDDJCFFFFFFFPPPHHHTUUUVVVWWXXXIQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo177 = decodeArr "©DŽDždžǍǎ" "ħĨĨĨĩĩ"; +private yygo182 = decodeArr "¿ÅÆÇÈÉ" "µ¶¶¶ĪĪ"; +private yygo184 = decodeArr "¶·¸äåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööĬĬĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo185 = decodeArr "©ÌÍÎÏÐÑ" "TZZZZijij"; +private yygo189 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŶŷŸŹźƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ĶĶķķķaĵĵ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo190 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aĸĸ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo192 = decodeArr "ŻżŽ" "ÀĹĹ"; +private yygo193 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aĺĺĺĺbbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo194 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aĻĻĻĻbbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo196 = decodeArr "¿ÀÁ" "Ŀŀŀ"; +private yygo197 = decodeArr "LJLjljNJNjnj" "łłłŃŃŃ"; +private yygo198 = decodeArr "\u001a\u001b\u001c\u001d\u001e\u001f !\"#$%&'(rstuvwxy}~\u007f\u008c\u008d\u008e©³´µ¶·¸ÀÁÂÃÄÊËÌÍÎÏÐÑÒÓãďĐęĚěĜĥĦħĨĩĪīŔŕśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ńńńBBBEEEEDDDDJCFFFFFFFPPPHHHTUUUVVVWWXXXIQZZZZYYRR[MMNOGL\\\\\\\\\\]]KKSSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo200 = decodeArr "±²¹º»¼½¾¿ÀÁ" "ņņʼnʼnňňňňŇss"; +private yygo206 = decodeArr "\u008f\u0090\u0091\u0092\u0093©" "ŋŋŋŋŋÒ"; +private yygo207 = decodeArr "\u008f\u0090\u0091\u0092\u0093©" "ŌŌŌŌŌÒ"; +private yygo208 = decodeArr "\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e\u009f³´µ¶·¸¿ÀÁ" "őőőœœœœœœŒŒŒŔŔŔŕŕŕŖŗŗ"; +private yygo211 = decodeArr "¶·¸æíîïôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚřřřśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo212 = decodeArr "+," "ŝŝ"; +private yygo218 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ŢŢŢŢŢŢŢ"; +private yygo221 = decodeArr "ûüýþÿġĢ" "ťťťťťŦŦ"; +private yygo226 = decodeArr "ģĤ" "ŧŧ"; +private yygo228 = decodeArr "¶·¸ßàáâäåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööũũŪŪŨŨĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo231 = decodeArr "İıIJijĴĵĶķĸĹĺĻļ" "ŵŵŵŶŶŶŶŷŷŷŸŸŸ"; +private yygo233 = decodeArr "ûüýþÿĬĭ" "éééééźź"; +private yygo234 = decodeArr "ĝĞĮįİıIJijĴĵĶķĸĹĺĻļ" "ŽŽžžſſſŶŶŶŶŷŷŷŸŸŸ"; +private yygo244 = decodeArr "¶·¸æíîïôõö÷øùúûüýþÿĀāĂăĄŃńǂǃ" "öööŚƉƉƉśIJIJIJIJIJIJøøøøøùùùùùııƊƊ"; +private yygo245 = decodeArr "¶·¸æíîïôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚƌƌƌśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo250 = decodeArr "¶·¸ĀāĂăĄ" "öööƏƏƏƏƏ"; +private yygo252 = decodeArr "ûüýþÿĬĭ" "éééééƑƑ"; +private yygo253 = decodeArr "¶·¸äåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööƒƒĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo255 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````a\u009f\u009f\u009f\u009f\u009fccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo256 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aēē\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo257 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````²²ffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo260 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aƘƘ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo261 = decodeArr "¶·¸äåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööƙƙĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo264 = decodeArr "řŚ" "°°"; +private yygo278 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǒǓǔ" "UUUVVVWW```````````aƣƣ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeeggggggggggggggggggggggƤƤƤ"; +private yygo280 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǏǐǑ" "UUUVVVWW```````````aƥƥ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeeggggggggggggggggggggggƦƦƦ"; +private yygo281 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aĺĺĺĺbbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo282 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aĻĻĻĻbbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo284 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǏǐǑ" "UUUVVVWW```````````aƥƥ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeeggggggggggggggggggggggƩƩƩ"; +private yygo285 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŭŮůŰűŲŶŷƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ƪƪƪƫƫƫĎĎaČČ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo286 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aƭƭ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo288 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aƮƮ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo293 = decodeArr "\u0087\u0088\u0089\u008a\u008b©³´µ¶·¸ÀÁËÌÍÎÏÐÑśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ĉĉưưưTUUUVVVWWćZZZZYYĈĈĈ^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo299 = decodeArr "ûüýþÿĬĭ" "éééééƴƴ"; +private yygo306 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂăĄŃń" "öööIJIJIJIJIJIJøøøøøùùùùùƷƷ"; +private yygo308 = decodeArr "rz{|}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085\u0086©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ƼƾƾƾƽƽƽǀǀǀǀƿƿƿTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo311 = decodeArr "ūŬ" "DŽDŽ"; +private yygo317 = decodeArr "LJLjljNJNjnj" "dždždžŃŃŃ"; +private yygo318 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aLJLJ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo325 = decodeArr "¹ºÀÁ" "ǏǏss"; +private yygo330 = decodeArr "\u008f\u0090\u0091\u0092\u0093©" "ǒǒǒǒǒÒ"; +private yygo334 = decodeArr "¹ºÀÁ" "ttss"; +private yygo335 = decodeArr "\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e\u009f³´µ¶·¸¿ÀÁ" "œœœœœœǕǕǕŔŔŔŕŕŕŖŗŗ"; +private yygo339 = decodeArr "¦§¨¿" "ǛǛǛǚ"; +private yygo344 = decodeArr "\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e\u009f³´µ¶·¸¿ÀÁ" "ǜǜǜœœœœœœŒŒŒŔŔŔŕŕŕŖŗŗ"; +private yygo348 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞǟǟśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo349 = decodeArr "-." "ǡǡ"; +private yygo353 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ǢǢǢǢǢǢǢ"; +private yygo355 = decodeArr "\u0005\u0006\u0007\b\t\n\u000b" "ǣǣǣǣǣǣǣ"; +private yygo364 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞǪǪśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo365 = decodeArr "¶·¸ôõö÷øùúûüýþÿĀāĂăĄŃń" "öööǫIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo366 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂ㥼ľĿŀŁł" "öööǯǯǯǯǯǯøøøøøùùùùùǰǰDZDZDZDz"; +private yygo367 = decodeArr "ijĴĵĶķĸĹĺĻļ" "dzdzdzdzŷŷŷŸŸŸ"; +private yygo368 = decodeArr "ķĸĹĺĻļ" "ǴǴǴŸŸŸ"; +private yygo369 = decodeArr "ķĸĹĺĻļ" "ǵǵǵŸŸŸ"; +private yygo370 = decodeArr "ķĸĹĺĻļ" "ǶǶǶŸŸŸ"; +private yygo371 = decodeArr "ĺĻļ" "ǷǷǷ"; +private yygo372 = decodeArr "ĺĻļ" "ǸǸǸ"; +private yygo377 = decodeArr "İıIJijĴĵĶķĸĹĺĻļ" "ǺǺǺŶŶŶŶŷŷŷŸŸŸ"; +private yygo381 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000bğĠ" "Ǽßßßßßßßǽǽ"; +private yygo384 = decodeArr "ĝĞĮįİıIJijĴĵĶķĸĹĺĻļ" "ǿǿȀȀſſſŶŶŶŶŷŷŷŸŸŸ"; +private yygo385 = decodeArr "¶·¸ĉĊċČ" "\u0087\u0087\u0087íȁȁȁ"; +private yygo387 = decodeArr "ûüýþÿ" "ȂȂȂȂȂ"; +private yygo388 = decodeArr "¶·¸đĒēĔ" "\u008b\u008b\u008bòȃȃȃ"; +private yygo397 = decodeArr "ǂǃ" "ƊƊ"; +private yygo399 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂăĄ" "öööȊȊȊȊȊȊøøøøøùùùùù"; +private yygo400 = decodeArr "ĮįİıIJijĴĵĶķĸĹĺĻļ" "žžſſſŶŶŶŶŷŷŷŸŸŸ"; +private yygo403 = decodeArr "¶·¸äåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööȌȌĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo408 = decodeArr "Ƌƌ" "ȏȏ"; +private yygo410 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŪžſƀƁƂƃƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ȑȒȒȒȓȓȓaȐȐ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo411 = decodeArr "\u0087\u0088\u0089\u008a\u008b©³´µ¶·¸ÀÁËÌÍÎÏÐÑśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ĉĉȔȔȔTUUUVVVWWćZZZZYYĈĈĈ^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo413 = decodeArr "\u0087\u0088\u0089\u008a\u008b©³´µ¶·¸ÀÁËÌÍÎÏÐÑśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ĉĉȖȖȖTUUUVVVWWćZZZZYYĈĈĈ^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo414 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȗȗ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo415 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȘȘ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo416 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŭŮůųŴŵŶŷƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````čččșșșĎĎaČČ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo433 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȡȡ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo435 = decodeArr "©DŽDždžǍǎ" "ħȢȢȢĩĩ"; +private yygo436 = decodeArr "çè" "ȥȥ"; +private yygo437 = decodeArr "¶·¸ëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööȧȧȦIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo438 = decodeArr "¶·¸ëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööȨȨȦIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo440 = decodeArr "}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ȩȩȩTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo441 = decodeArr "}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ȪȪȪTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo442 = decodeArr "}~\u007f©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ȫȫȫTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo444 = decodeArr "r}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085\u0086©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ƼƽƽƽǀǀǀǀȬȬȬTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo449 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŶŷŸŹźƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ĶĶȯȯȯaĵĵ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo452 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȰȰ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo456 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȷȷ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo458 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȺȺ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo460 = decodeArr "LJLjljNJNjnj" "ȼȼȼŃŃŃ"; +private yygo462 = decodeArr "¹ºÀÁ" "ȽȽss"; +private yygo465 = decodeArr "±²¹º»¼½¾¿ÀÁ" "ȾȾʼnʼnňňňňŇss"; +private yygo467 = decodeArr " ¡¢£¤¥¦§¨¿" "ɃɃɃɁɁɁɂɂɂǚ"; +private yygo468 = decodeArr "¹ºÀÁ" "ÌÌss"; +private yygo471 = decodeArr "\u0094\u0095\u0096\u0097\u0098\u0099\u009a\u009b\u009c\u009d\u009e\u009f³´µ¶·¸¿ÀÁ" "ɄɄɄœœœœœœŒŒŒŔŔŔŕŕŕŖŗŗ"; +private yygo477 = decodeArr "¶·¸æíîïôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚɆɆɆśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo484 = decodeArr "ûüýþÿġĢ" "ťťťťťɉɉ"; +private yygo486 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞɊɊśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo487 = decodeArr "¶·¸ßàáâäåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööũũɋɋŨŨĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo488 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞɌɌśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo489 = decodeArr "ąĆćĈ" "ɏɏɐɐ"; +private yygo492 = decodeArr "\u0010\u0011\u0012\u0013ŅņŇňʼnŊ" "\u0004\u0004ɓɓɔɔɔɔɔɕ"; +private yygo493 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂ㥳" "öööǯǯǯǯǯǯøøøøøùùùùùɖ"; +private yygo494 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂ㥳" "öööǯǯǯǯǯǯøøøøøùùùùùɗ"; +private yygo497 = decodeArr "¶·¸õö÷øùúûüýþÿĀāĂ㥼ľĿŀŁł" "öööǯǯǯǯǯǯøøøøøùùùùùɘɘDZDZDZDz"; +private yygo508 = decodeArr "ģĤ" "əə"; +private yygo510 = decodeArr "ĮįİıIJijĴĵĶķĸĹĺĻļ" "ɚɚſſſŶŶŶŶŷŷŷŸŸŸ"; +private yygo511 = decodeArr "\u0004\u0005\u0006\u0007\b\t\n\u000bğĠ" "Ǽßßßßßßßɛɛ"; +private yygo514 = decodeArr "ŖŗŘ" "ɜɜɜ"; +private yygo518 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞɝɝśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo519 = decodeArr "¶·¸æíîïòóôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚɞɞɞɟɟśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo523 = decodeArr "ĮįİıIJijĴĵĶķĸĹĺĻļ" "ȀȀſſſŶŶŶŶŷŷŷŸŸŸ"; +private yygo527 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aɡɡ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo529 = decodeArr "ūŬŻżŽ" "ɣɣÀɢɢ"; +private yygo530 = decodeArr "řŚ" "ɥɥ"; +private yygo533 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aɧɧ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo538 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁǒǓǔ" "UUUVVVWW```````````aƣƣ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeeggggggggggggggggggggggɩɩɩ"; +private yygo541 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŭŮůŰűŲŶŷƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ƪƪƪɪɪɪĎĎaČČ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo549 = decodeArr "¶·¸éêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "öööɫɫİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo558 = decodeArr "rz{|}~\u007f\u0080\u0081\u0082\u0083\u0084\u0085\u0086©³´µ¶·¸ÀÁËÌÍÎÏÐÑÒÓãśŜŝŞşŠšŢţŤťŦŧŨũƄƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "ƼɬɬɬƽƽƽǀǀǀǀƿƿƿTUUUVVVWWQZZZZYYRR[SSS^```````````a____bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo561 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȷȷ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo563 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȺȺ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo575 = decodeArr " ¡¢¦§¨¿" "ɲɲɲɂɂɂǚ"; +private yygo578 = decodeArr "¦§¨¿" "ɴɴɴǚ"; +private yygo583 = decodeArr "¶·¸æíîïðñôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚǞǞǞɶɶśIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo584 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʶʶʶʶʶʶ"; +private yygo590 = decodeArr "ąĆćĈ" "ʹʹɐɐ"; +private yygo595 = decodeArr "©ŋŌōŎŏŐőŒœ" "ˀˁˁ˂˂˂˃˃˃˄"; +private yygo611 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aˋˋ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo612 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũŪžſƀƁƂƃƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````ȑȒȒȒˌˌˌaȐȐ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo624 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȷȷ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo625 = decodeArr "³´µ¶·¸ÀÁşŠšŢţŤťŦŧŨũƄƇƈƍƎƏƐƑƒƓƔƕƖƗƘƙƜƝƞƟƠơƢƣƤƥƦƧƨƩƪƫƬƭƮƯưƱƲƳƴƵƶƷƸƹƺƻƼƽƾƿǀǁ" "UUUVVVWW```````````aȺȺ\u0095\u0095\u0095\u0095bbbbbccddffeeeeeeeeeeeeeegggggggggggggggggggggg"; +private yygo629 = decodeArr " ¡¢£¤¥¦§¨¿" "ɃɃɃˍˍˍɂɂɂǚ"; +private yygo681 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷˏˏˏˏˏˏ"; +private yygo695 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷˑˑˑˑˑˑ"; +private yygo699 = decodeArr "ąĆćĈ" "˓˓ɐɐ"; +private yygo700 = decodeArr "©ŐőŒœ" "ˀ˔˔˔˄"; +private yygo701 = decodeArr "©ŐőŒœ" "ˀ˕˕˕˄"; +private yygo702 = decodeArr "©œ" "ˀ˖"; +private yygo703 = decodeArr "©œ" "ˀ˗"; +private yygo710 = decodeArr "\u0010\u0011\u0012\u0013ŅņŇňʼnŊ" "\u0004\u0004ɓɓ˚˚˚˚˚ɕ"; +private yygo711 = decodeArr "\u0010\u0011\u0012\u0013ŅņŇňʼnŊ" "\u0004\u0004ɓɓ˛˛˛˛˛ɕ"; +private yygo713 = decodeArr "¶·¸æíîïòóôõö÷øùúûüýþÿĀāĂăĄŃń" "öööŚɞɞɞ˜˜śIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo718 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷ˝˝˝˝˝˝"; +private yygo728 = decodeArr "¶·¸äåæéêëìôõö÷øùúûüýþÿĀāĂăĄŃń" "ööö˟˟ĭĮĮİİįIJIJIJIJIJIJøøøøøùùùùùıı"; +private yygo729 = decodeArr "©ŋŌōŎŏŐőŒœ" "ˀˠˠ˂˂˂˃˃˃˄"; +private yygo734 = decodeArr "/0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopq" "ʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷʷˡˡˡˡˡˡ"; private yygos = let sub1 = [ (0, yygo0), (1, yygo1), @@ -10529,196 +10666,201 @@ private yygos = let (59, yygo59), (60, yygo60), (63, yygo63), - (82, yygo82), - (86, yygo86), + (83, yygo83), (87, yygo87), - (91, yygo91), + (88, yygo88), (92, yygo92), - (97, yygo97), - (104, yygo104), + (93, yygo93), + (94, yygo94), + (99, yygo99), (106, yygo106), (108, yygo108), - (112, yygo112), - (115, yygo115), - (120, yygo120), - (123, yygo123), - (127, yygo127), + (110, yygo110), + (114, yygo114), + (117, yygo117), + (122, yygo122), + (125, yygo125), (129, yygo129), - (130, yygo130), + (131, yygo131), (132, yygo132), - (133, yygo133), + (134, yygo134), (135, yygo135), - (136, yygo136), (137, yygo137), - (140, yygo140), + (138, yygo138), + (139, yygo139), (142, yygo142), - (144, yygo144), (145, yygo145), - (149, yygo149), - (150, yygo150), - (151, yygo151), - (157, yygo157), - (159, yygo159), + (147, yygo147), + (148, yygo148), + (152, yygo152), + (153, yygo153), + (154, yygo154), (160, yygo160), - (161, yygo161), + (162, yygo162), + (163, yygo163), (164, yygo164), - (168, yygo168), - (169, yygo169), + (167, yygo167), (171, yygo171), + (172, yygo172), (174, yygo174), - (179, yygo179), - (181, yygo181)]; - sub2 = [ (182, yygo182), + (177, yygo177), + (182, yygo182)]; + sub2 = [ (184, yygo184), (185, yygo185), - (186, yygo186), - (188, yygo188), (189, yygo189), (190, yygo190), (192, yygo192), (193, yygo193), (194, yygo194), (196, yygo196), - (202, yygo202), - (203, yygo203), - (204, yygo204), + (197, yygo197), + (198, yygo198), + (200, yygo200), + (206, yygo206), (207, yygo207), (208, yygo208), - (214, yygo214), - (217, yygo217), - (222, yygo222), - (224, yygo224), - (227, yygo227), - (229, yygo229), - (230, yygo230), - (240, yygo240), - (241, yygo241), - (246, yygo246), - (248, yygo248), + (211, yygo211), + (212, yygo212), + (218, yygo218), + (221, yygo221), + (226, yygo226), + (228, yygo228), + (231, yygo231), + (233, yygo233), + (234, yygo234), + (244, yygo244), + (245, yygo245), (250, yygo250), - (251, yygo251), (252, yygo252), + (253, yygo253), (255, yygo255), (256, yygo256), - (259, yygo259), - (273, yygo273), - (275, yygo275), - (276, yygo276), - (277, yygo277), - (279, yygo279), + (257, yygo257), + (260, yygo260), + (261, yygo261), + (264, yygo264), + (278, yygo278), (280, yygo280), (281, yygo281), - (283, yygo283), + (282, yygo282), + (284, yygo284), + (285, yygo285), + (286, yygo286), (288, yygo288), - (294, yygo294), - (301, yygo301), - (303, yygo303), + (293, yygo293), + (299, yygo299), (306, yygo306), - (312, yygo312), - (313, yygo313), - (320, yygo320), + (308, yygo308), + (311, yygo311), + (317, yygo317), + (318, yygo318), (325, yygo325), - (329, yygo329), (330, yygo330), (334, yygo334), + (335, yygo335), (339, yygo339), - (343, yygo343), (344, yygo344), (348, yygo348), - (350, yygo350), - (359, yygo359), - (360, yygo360), - (361, yygo361), - (362, yygo362), - (363, yygo363), + (349, yygo349), + (353, yygo353), + (355, yygo355), (364, yygo364), - (365, yygo365)]; - sub3 = [ (366, yygo366), + (365, yygo365), + (366, yygo366), (367, yygo367), + (368, yygo368)]; + sub3 = [ (369, yygo369), + (370, yygo370), + (371, yygo371), (372, yygo372), - (376, yygo376), - (379, yygo379), - (380, yygo380), - (382, yygo382), - (383, yygo383), - (392, yygo392), - (394, yygo394), - (396, yygo396), - (401, yygo401), + (377, yygo377), + (381, yygo381), + (384, yygo384), + (385, yygo385), + (387, yygo387), + (388, yygo388), + (397, yygo397), + (399, yygo399), + (400, yygo400), (403, yygo403), - (404, yygo404), - (406, yygo406), - (407, yygo407), (408, yygo408), - (409, yygo409), - (426, yygo426), - (428, yygo428), - (429, yygo429), - (430, yygo430), - (431, yygo431), + (410, yygo410), + (411, yygo411), + (413, yygo413), + (414, yygo414), + (415, yygo415), + (416, yygo416), (433, yygo433), - (434, yygo434), (435, yygo435), + (436, yygo436), (437, yygo437), + (438, yygo438), + (440, yygo440), + (441, yygo441), (442, yygo442), - (445, yygo445), + (444, yygo444), (449, yygo449), - (451, yygo451), - (453, yygo453), - (455, yygo455), + (452, yygo452), + (456, yygo456), (458, yygo458), (460, yygo460), - (461, yygo461), - (464, yygo464), - (470, yygo470), - (476, yygo476), - (478, yygo478), - (479, yygo479), - (480, yygo480), - (481, yygo481), + (462, yygo462), + (465, yygo465), + (467, yygo467), + (468, yygo468), + (471, yygo471), + (477, yygo477), (484, yygo484), - (485, yygo485), (486, yygo486), + (487, yygo487), + (488, yygo488), (489, yygo489), - (500, yygo500), - (502, yygo502), - (503, yygo503), - (506, yygo506), + (492, yygo492), + (493, yygo493), + (494, yygo494), + (497, yygo497), + (508, yygo508), (510, yygo510), (511, yygo511), + (514, yygo514), (518, yygo518), - (520, yygo520), - (521, yygo521), - (524, yygo524), + (519, yygo519), + (523, yygo523), + (527, yygo527), (529, yygo529), - (532, yygo532), - (540, yygo540), - (549, yygo549), - (552, yygo552), - (554, yygo554), - (566, yygo566)]; - sub4 = [ (569, yygo569), - (574, yygo574), - (580, yygo580), - (585, yygo585), - (601, yygo601), - (602, yygo602), - (614, yygo614), - (615, yygo615), - (619, yygo619), - (670, yygo670), - (684, yygo684), - (688, yygo688), - (689, yygo689), - (690, yygo690), - (691, yygo691), - (692, yygo692), + (530, yygo530), + (533, yygo533), + (538, yygo538), + (541, yygo541), + (549, yygo549)]; + sub4 = [ (558, yygo558), + (561, yygo561), + (563, yygo563), + (575, yygo575), + (578, yygo578), + (583, yygo583), + (584, yygo584), + (590, yygo590), + (595, yygo595), + (611, yygo611), + (612, yygo612), + (624, yygo624), + (625, yygo625), + (629, yygo629), + (681, yygo681), + (695, yygo695), (699, yygo699), (700, yygo700), + (701, yygo701), (702, yygo702), - (707, yygo707), - (717, yygo717), + (703, yygo703), + (710, yygo710), + (711, yygo711), + (713, yygo713), (718, yygo718), - (723, yygo723)]; + (728, yygo728), + (729, yygo729), + (734, yygo734)]; in sub1 `seq` sub2 `seq` sub3 `seq` sub4 `seq` genericArrayFromIndexList (sub1 ++ sub2 ++ sub3 ++ sub4); {- diff --git a/frege/compiler/grammar/Frege.y b/frege/compiler/grammar/Frege.y index 14e7eb6f..78c1c5a0 100644 --- a/frege/compiler/grammar/Frege.y +++ b/frege/compiler/grammar/Frege.y @@ -71,6 +71,7 @@ import Compiler.types.Global as G; import Compiler.common.Mangle; import Compiler.common.Errors as E(); +import Compiler.common.Lens (set); import Compiler.common.Resolve as R(enclosed); import Lib.PP (group, break, msgdoc); @@ -106,8 +107,9 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%type modulename1 (String, Position) //%type nativename String //%type rawnativename String -//%type nativespec (String, Maybe [TauS]) -//%type gargs [TauS] +//%type nativespec (String, Maybe [TVar SName]) +//%type gargvars [TVar SName] +//%type gargs [TVar SName] //%type nativepur Bool //%type docs String //%type docsO (Maybe String) @@ -134,7 +136,7 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%type annoitem Token //%type fitem Token //%type jitem String -//%type methodspec (Token, String, Maybe [TauS]) +//%type methodspec (Token, String, Maybe [TVar SName]) //%type importspec ImportItem //%type importspecs [ImportItem] //%type memspec ImportItem @@ -145,40 +147,42 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%type importliste ImportList //%type definitions [Def] //%type definition [Def] -//%type import Def -//%type infix Def -//%type fixity Def -//%type typedef Def +//%type import ImpDcl +//%type infix FixDcl +//%type fixity FixDcl +//%type typedef TypDcl //%type scontext ContextS //%type scontexts [ContextS] //%type ccontext [ContextS] //%type sicontext ContextS //%type sicontexts [ContextS] //%type icontext [ContextS] -//%type insthead Def -//%type classdef Def -//%type instdef Def -//%type derivedef Def -//%type nativedef Def -//%type impurenativedef Def -//%type datadef Def -//%type datainit Def -//%type annotation [Def] -//%type fundef [Def] -//%type documentation Def +//%type insthead InsDcl +//%type classdef ClaDcl +//%type instdef InsDcl +//%type derivedef DrvDcl +//%type nativedef NatDcl +//%type impurenativedef NatDcl +//%type datadef DatDcl +//%type datainit DatDcl +//%type datajavadef JavDcl +//%type datajavainit JavDcl +//%type annotation [AnnDcl] +//%type fundef FunDcl +//%type documentation DocDcl //%type topdefinition [Def] //%type publicdefinition [Def] //%type plocaldef [Def] //%type dplocaldef [Def] //%type localdef [Def] //%type localdefs [Def] -//%type letdef [Def] -//%type letdefs [Def] -//%type wherelet [Def] +//%type letdef [LetMemberS] +//%type letdefs [LetMemberS] +//%type wherelet [LetMemberS] //%type visibledefinition [Def] -//%type moduledefinition Def +//%type moduledefinition ModDcl //%type wheredef [Def] -//%type tyvar TauS +//%type tyvar (TVar SName) //%type tvapp TauS //%type tau TauS //%type tapp TauS @@ -186,7 +190,7 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%type simpletypes [TauS] //%type tauSC [TauS] //%type tauSB [TauS] -//%type dvars [TauS] +//%type dvars [TVar SName] //%type sigex SigExs //%type sigexs [SigExs] //%type sigma SigmaS @@ -332,6 +336,7 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%explain nativename a valid java identifier //%explain rawnativename a valid java identifier //%explain nativespec a native generic type +//%explain gargvars a list of type variables separated by ',' //%explain gargs native generic type arguments //%explain nativepur a native data type //%explain documentation documentation @@ -351,6 +356,8 @@ private yyprod1 :: [(Int, YYsi ParseResult Token)] //%explain letdefs declarations in a let expression or where clause //%explain datadef a data definition //%explain datainit a data definition +//%explain datajavadef a data definition for a native type +//%explain datajavainit a data definition for a native type //%explain dalt a variant of an algebraic datatype //%explain simpledalt a variant of an algebraic datatype //%explain strictdalt a variant of an algebraic datatype @@ -500,7 +507,7 @@ definitions: ; definition: - documentation { single } + documentation { single . DefinitionS.Doc } | topdefinition | visibledefinition ; @@ -509,14 +516,14 @@ visibledefinition: PRIVATE publicdefinition { \_\ds -> map (updVis Private) ds } | PROTECTED publicdefinition { \_\ds -> map (updVis Protected) ds } | PUBLIC publicdefinition { \_\ds -> map (updVis Public) ds } - | ABSTRACT datadef { \_\(d::Def) -> [d.{ctrs <- map updCtr}] } + | ABSTRACT datadef { \_\(d::DatDcl) -> [DefinitionS.Dat $ d.{ctrs <- map updCtr}] } ; topdefinition: - import { single } - | infix { single } - | moduledefinition { single } + import { single . DefinitionS.Imp } + | infix { single . DefinitionS.Fix } + | moduledefinition { single . DefinitionS.Mod } | publicdefinition ; @@ -566,11 +573,12 @@ documentation: ; publicdefinition: - typedef { single } - | datadef { single } - | classdef { single } - | instdef { single } - | derivedef { single } + typedef { single . DefinitionS.Typ } + | datadef { single . DefinitionS.Dat } + | datajavadef { single . DefinitionS.Jav } + | classdef { single . DefinitionS.Cla } + | instdef { single . DefinitionS.Ins } + | derivedef { single . DefinitionS.Drv } | localdef ; @@ -582,9 +590,9 @@ localdefs: ; localdef: - annotation - | nativedef { single } - | fundef + annotation { map DefinitionS.Ann } + | nativedef { single . DefinitionS.Nat } + | fundef { single . DefinitionS.Fun } ; plocaldef: @@ -595,14 +603,14 @@ plocaldef: ; dplocaldef: - documentation { single } - | documentation dplocaldef { (:) } + documentation { single . DefinitionS.Doc } + | documentation dplocaldef { \doc\ds -> DefinitionS.Doc doc : ds } | plocaldef ; letdef: - annotation - | fundef + annotation { map LetMemberS.Ann } + | fundef { single . LetMemberS.Fun } ; @@ -751,7 +759,7 @@ operators: ; infix: - fixity operators { \(def::Def)\o -> def.{ops = o}} + fixity operators { \(def::FixDcl)\o -> def.{ops = o}} ; annotation: @@ -772,7 +780,7 @@ annoitems: nativedef: - PURE impurenativedef { \_\(d::Def) -> d.{isPure = true} } + PURE impurenativedef { \_\(d::NatDcl) -> d.{isPure = true} } | impurenativedef ; @@ -839,16 +847,16 @@ mbdot: rho: tapp EARROW rhofun { \tau\t\rho -> do context <- tauToCtx tau - YYM.pure (Rho.{context} rho) + YYM.pure $ set RhoT._context context rho } | rhofun ; rhofun: - tapp { RhoTau [] } + tapp { RhoT.Tau . RhoTau [] } | tapp ARROW rhofun { \a\_\b -> case a of - TSig s -> RhoFun [] s b - _ -> RhoFun [] (ForAll [] (RhoTau [] a)) b } + TSig s -> RhoT.Fun $ RhoFun [] s b + _ -> RhoT.Fun $ RhoFun [] (ForAll [] (RhoT.Tau $ RhoTau [] a)) b } ; /* @@ -861,8 +869,8 @@ tau: tapp | forall { TSig } | tapp ARROW tau { \a\f\b -> case a of - TSig s -> TSig (ForAll [] (RhoFun [] s (RhoTau [] b))) - _ -> TApp (TApp (TCon (yyline f) (fromBase f.{tokid=CONID, value="->"})) a) b + TSig s -> TSig (ForAll [] (RhoT.Fun $ RhoFun [] s (RhoT.Tau $ RhoTau [] b))) + _ -> TApp (TApp (TauT.Con TCon{pos=yyline f, name=fromBase f.{tokid=CONID, value="->"}}) a) b } ; @@ -881,8 +889,8 @@ tapp: ; simpletype: - tyvar - | tyname { \(tn::SName) -> TCon (yyline tn.id) tn} + tyvar {TauT.Var} + | tyname { \(tn::SName) -> TauT.Con TCon{pos=yyline tn.id, name=tn} } | '(' tau ')' { \_\t\_ -> t } | '(' tau ',' tauSC ')' {\_\t\(c::Token)\ts\_ -> @@ -890,22 +898,20 @@ simpletype: tus = t:ts; i = length tus; tname = fromBase c.{tokid=CONID, value=tuple i} - in (TCon (yyline c) tname).mkapp tus + in (TauT.Con TCon{pos=yyline c, name=tname}).mkapp tus } | '(' tau '|' tauSB ')' { \_\t\e\ts\_ -> mkEither (yyline e) t ts } - | '[' tau ']' {\a\t\_ -> TApp (TCon (yyline a) - (fromBase a.{tokid=CONID, value="[]"})) - t } + | '[' tau ']' {\a\t\_ -> TApp (TauT.Con TCon{pos=yyline a, name=fromBase a.{tokid=CONID, value="[]"} }) t } ; tyvar: - VARID { \n -> TVar (yyline n) KVar (Token.value n) } - | '(' VARID DCOLON kind ')' { \_\n\_\k\_ -> TVar (yyline n) k (Token.value n) } - | '(' VARID EXTENDS tauSC ')' { \_\v\x\ks\_ -> TVar (yyline v) (KGen ks) (v.value) } - | '(' EXTENDS tauSC ')' { \_\x\ks\_ -> TVar (yyline x) (KGen ks) ("<") } - | '(' SUPER tapp ')' { \_\x\k\_ -> TVar (yyline x) (KGen [k]) (">") } + VARID { \n -> TVar{pos=yyline n, kind=KVar, var=Token.value n} } + | '(' VARID DCOLON kind ')' { \_\n\_\k\_ -> TVar{pos=yyline n, kind=k, var=Token.value n} } + | '(' VARID EXTENDS tauSC ')' { \_\v\x\ks\_ -> TVar{pos=yyline v, kind=KGen ks, var=v.value} } + | '(' EXTENDS tauSC ')' { \_\x\ks\_ -> TVar{pos=yyline x, kind=KGen ks, var="<"} } + | '(' SUPER tapp ')' { \_\x\k\_ -> TVar{pos=yyline x, kind=KGen [k], var=">"} } ; @@ -934,7 +940,7 @@ simplekind: ; scontext: - qconid tyvar { \c\v -> Ctx {pos=Pos (SName.id c) v.pos.last, cname=c, tau=v} } + qconid tyvar { \c\v -> Ctx {pos=Pos (SName.id c) v.pos.last, cname=c, tau=TauT.Var v} } ; @@ -953,7 +959,7 @@ ccontext: classdef: CLASS ccontext EARROW CONID tyvar wheredef { \_\ctxs\_\c\v\defs -> do - sups <- classContext (Token.value c) ctxs (v::TauS).var + sups <- classContext ctxs v.var pure ClaDcl{ pos = yyline c, vis = Public, @@ -970,8 +976,16 @@ classdef: (yyerror (yyline kw) "classname missing after contexts") when (SName.{ty?} cname) (yyerror (yyline cname.id) "classname must not be qualified") + clvar <- case tau of + TauT.Var v -> pure v + _ -> do + -- actually, this case never happens because of the 'scontext' rule + yyerror (yyline cname.id) + $ "class declaration must be in the form of C t " + ++ "where C is a class name and t is a type variable" + pure $ TVar {pos=Position.null, kind=KVar, var="bad"} pure ClaDcl {pos, vis = Public, name=cname.id.value, - clvar = tau, supers = [], + clvar, supers = [], defs, doc = Nothing} _ -> Prelude.error "fatal: empty ccontext (cannot happen)" } @@ -998,7 +1012,7 @@ insthead: pos = yyline ea, vis = Public, clas = cls, - typ = ForAll [] (RhoTau ctxs tau), + typ = ForAll [] (RhoT.Tau $ RhoTau ctxs tau), defs = [], doc = Nothing} } @@ -1009,7 +1023,7 @@ insthead: (yyerror pos "classname missing after instance contexts") pure InsDcl { pos, vis = Public, clas = cname, - typ = ForAll [] (RhoTau [] tau), + typ = ForAll [] (RhoT.Tau $ RhoTau [] tau), defs = [], doc = Nothing, } @@ -1019,21 +1033,24 @@ insthead: instdef: INSTANCE insthead wheredef { - \ins\head\defs -> (head::Def).{defs, pos = yyline ins} + \ins\head\defs -> (head::InsDcl).{defs, pos = yyline ins} } ; derivedef: - DERIVE insthead { - \d\(i::Def) -> DrvDcl {pos = yyline d, vis = Public, clas=i.clas, typ=i.typ, doc=Nothing} + DERIVE insthead { + \d\(i::InsDcl) -> DrvDcl {pos = yyline d, vis = Public, clas=i.clas, typ=i.typ, doc=Nothing} } ; datadef: - datainit wheredef { \def\defs -> (def::Def).{defs = defs} } + datainit wheredef { \def\defs -> (def::DatDcl).{defs = defs} } ; +datajavadef: + datajavainit wheredef { \def\defs -> (def::JavDcl).{defs = defs} } + nativepur: PURE NATIVE { \_\_ -> true } | NATIVE { \_ -> false } @@ -1044,28 +1061,18 @@ nativespec: | nativename gargs { \x\gs -> (x, Just gs) } ; +gargvars: + tyvar { single } + | tyvar ',' gargvars { \h\_\t -> h:t } + ; + gargs: - '{' tauSC '}' { \_\ts\_ -> ts } + '{' gargvars '}' { \_\ts\_ -> ts } | '{' '}' { \_\_ -> [] } ; - datainit: - DATA CONID '=' nativepur nativespec { - \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, - jclas=jt, vars=[], defs=[], - gargs, - isPure = pur, - doc=Nothing} - } - | DATA CONID dvars '=' nativepur nativespec { - \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, - jclas=jt, vars=ds, defs=[], - gargs, - isPure = pur, - doc=Nothing} - } - | DATA CONID dvars '=' dalts { + DATA CONID dvars '=' dalts { \dat\d\ds\docu\alts -> DatDcl {pos=yyline d, vis=Public, name=Token.value d, newt = false, vars=ds, ctrs=alts, defs=[], doc=Nothing} @@ -1092,6 +1099,23 @@ datainit: } ; +datajavainit: + DATA CONID '=' nativepur nativespec { + \dat\d\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, + jclas=jt, vars=[], defs=[], + gargs, + isPure = pur, + doc=Nothing} + } + | DATA CONID dvars '=' nativepur nativespec { + \dat\d\ds\docu\pur\(jt,gargs) -> JavDcl {pos=yyline d, vis=Public, name=Token.value d, + jclas=jt, vars=ds, defs=[], + gargs, + isPure = pur, + doc=Nothing} + } + ; + dvars: tyvar { single } | tyvar dvars { (:) } @@ -1147,7 +1171,7 @@ contype: simpletype { \tau -> case tau of TSig s -> Field Position.null Nothing Nothing Public false s _ -> Field Position.null Nothing Nothing Public false - (ForAll [] (RhoTau [] tau)) + (ForAll [] (RhoT.Tau $ RhoTau [] tau)) } ; @@ -1221,13 +1245,7 @@ wherelet: fundef: funhead '=' expr { \(ex,pats)\eq\expr -> fundef ex pats expr } | funhead guards { \(ex,pats)\gds -> fungds ex pats gds } - | fundef wherelet { \fdefs\defs -> - case fdefs of - [fd] | FunDcl {expr=x} <- fd = YYM.pure [fd.{expr = Let defs x}] - _ = do - yyerror (head fdefs).pos ("illegal function definition, where { ... } after annotation?") - YYM.pure fdefs - } + | fundef wherelet { \(fd::FunDcl)\defs -> YYM.pure $ fd.{expr = Let defs fd.expr} } ; @@ -1262,7 +1280,9 @@ aeq: ARROW | '='; lcqual: gqual - | expr '=' expr { \e\t\x -> do { (ex,pat) <- funhead e; YYM.pure (Right (fundef ex pat x)) }} + | expr '=' expr { \e\t\x -> do + (ex,pat) <- funhead e + YYM.pure $ Right $ single $ LetMemberS.Fun $ fundef ex pat x } | LET '{' letdefs '}' { \_\_\ds\_ -> Right ds } ; diff --git a/frege/compiler/instances/Nicer.fr b/frege/compiler/instances/Nicer.fr index a7901b26..1dd6b06e 100644 --- a/frege/compiler/instances/Nicer.fr +++ b/frege/compiler/instances/Nicer.fr @@ -18,6 +18,7 @@ import frege.compiler.classes.QNameMatcher(QNameMatcher) import frege.compiler.classes.Nice(Nice) import frege.compiler.common.UnAlias import frege.compiler.common.Types as TU +import frege.compiler.common.Lens(set) import Compiler.enums.Flags import Lib.PP(text, , <+>, <>) @@ -118,7 +119,7 @@ private showex nicest x global = showprec 17 x where where -- kt = keys t vt = [ s | k <- kt, s <- global.findit k ] - sv ((vsym@SymV{}):_) + sv (SymbolT.V vsym:_) | Just x <- vsym.gExpr global = if not nicest then nice x global else nicer x global -- NOT "showprec 17 x" as this imposes @@ -209,23 +210,31 @@ instance (Nice t, QNameMatcher t) => Nice (SigmaT t) where fA = if isOn g.options.flags USEUNICODE then "∀ " else "forall " vars = joined " " . map (flip nicer g) . _.tvars $ sig -instance (Nice t, QNameMatcher t) => Nice (RhoT t) where - nice (RhoFun ctx sigma rho) g +instance (Nice t, QNameMatcher t) => Nice (RhoTau t) where + nice r g = nicectx r.context g ++ r.tau.nice g + nicer r g = nicerctx r.context g ++ r.tau.nicer g + +instance (Nice t, QNameMatcher t) => Nice (RhoFun t) where + nice RhoFun{context=ctx,sigma,rho} g | ForAll (_:_) _ <- sigma = nicectx ctx g ++ "(" ++ sigma.nice g ++ ") " ++ arrow ++ " " ++ rng | isFun sigma g = nicectx ctx g ++ "(" ++ sigma.nice g ++ ") " ++ arrow ++ " " ++ rng | otherwise = nicectx ctx g ++ sigma.nice g ++ " " ++ arrow ++ " " ++ rng where arrow = if isOn g.options.flags USEUNICODE then "→" else "->" - !rng = rho.{context=[]}.nice g - nice (RhoTau ctx tau) g = nicectx ctx g ++ tau.nice g - nicer (RhoFun ctx sigma rho) g + !rng = (set RhoT._context [] rho).nice g + nicer RhoFun{context=ctx,sigma,rho} g | ForAll (_:_) _ <- sigma = nicerctx ctx g ++ "(" ++ sigma.nicer g ++ ") " ++ arrow ++ " " ++ rng | isFun sigma g = nicerctx ctx g ++ "(" ++ sigma.nicer g ++ ") " ++ arrow ++ " " ++ rng | otherwise = nicerctx ctx g ++ sigma.nicer g ++ " " ++ arrow ++ " " ++ rng where arrow = if isOn g.options.flags USEUNICODE then "→" else "->" - !rng = rho.{context=[]}.nicer g - nicer (RhoTau ctx tau) g = nicerctx ctx g ++ tau.nicer g + !rng = (set RhoT._context [] rho).nicer g + +instance (Nice t, QNameMatcher t) => Nice (RhoT t) where + nice (RhoT.Tau r) = nice r + nice (RhoT.Fun r) = nice r + nicer (RhoT.Tau r) = nicer r + nicer (RhoT.Fun r) = nicer r nicectx :: (Nice t, QNameMatcher t) => [ContextT t] -> Global -> String @@ -235,7 +244,7 @@ nicectx xs g | otherwise = "(" ++ joined "," (map single xs) ++ ")" ++ arrow where arrow = if isOn g.options.flags USEUNICODE then " ⇒ " else " => " - single (Ctx pos name tau) = nice (TApp (TCon {pos,name}) tau) g + single (Ctx pos name tau) = nice (TApp (TauT.Con TCon{pos,name}) tau) g nicerctx :: (Nice t, QNameMatcher t) => [ContextT t] -> Global -> String @@ -245,26 +254,30 @@ nicerctx xs g | otherwise = "(" ++ joined "," (map single xs) ++ ")" ++ arrow where arrow = if isOn g.options.flags USEUNICODE then " ⇒ " else " => " - single (Ctx pos name tau) = nicer (TApp (TCon {pos,name}) tau) g + single (Ctx pos name tau) = nicer (TApp (TauT.Con TCon{pos,name}) tau) g + +instance (Nice t, QNameMatcher t) => Nice (TVar t) where + nicer t = nicer (TauT.Var t) + nice t = nice (TauT.Var t) instance (Nice t, QNameMatcher t) => Nice (TauT t) where nicer t g = showt 2 (unAlias g t) -- if isOn g.options.flags IDE then showt 2 (unAlias g t) else nice t g where arrow = if isOn g.options.flags USEUNICODE then "→" else "->" showt 2 fun - | [TCon {name}, a, b] <- Tau.flat fun, - name.nice g ~ ´(->|→)$´ + | [TauT.Con c, a, b] <- Tau.flat fun, + c.name.nice g ~ ´(->|→)$´ = showt 1 a ++ arrow ++ showt 2 b showt 2 (TSig s) = nicer s g showt 2 x = showt 1 x showt _ (t@TApp _ _) - | [TCon {name}, t] <- flat, name.nice g ~ ´\[\]$´ = "[" ++ showt 2 t ++ "]" - | (TCon {name}:ts) <- flat, name.nice g ~ ´\(,+\)$´ = "(" ++ joined "," (map (showt 2) ts) ++ ")" + | [TauT.Con c, t] <- flat, c.name.nice g ~ ´\[\]$´ = "[" ++ showt 2 t ++ "]" + | (TauT.Con c:ts) <- flat, c.name.nice g ~ ´\(,+\)$´ = "(" ++ joined "," (map (showt 2) ts) ++ ")" | isEither flat = "(" ++ showEither flat ++ ")" where flat = t.flat - isEither [TCon{name}, a, b] = name.nice g ~ ´\bEither$´ + isEither [TauT.Con c, a, b] = c.name.nice g ~ ´\bEither$´ isEither _ = false showEither [_, a, b] | TApp{} <- a, isEither aflat = showEither aflat ++ " | " ++ showt 2 b @@ -272,39 +285,39 @@ instance (Nice t, QNameMatcher t) => Nice (TauT t) where where aflat = Tau.flat a showEither _ = Prelude.error ("only good for Either a b") showt 1 fun - | [TCon {name}, a, b] <- Tau.flat fun, - name.nice g ~ ´(->|→)$´ + | [TauT.Con c, a, b] <- Tau.flat fun, + c.name.nice g ~ ´(->|→)$´ = "(" ++ showt 1 a ++ arrow ++ showt 2 b ++ ")" showt 1 (TApp a b) = showt 1 a ++ " " ++ showt 0 b showt 1 x = showt 0 x - showt 0 (tv@TVar {var}) + showt 0 (tv@(TauT.Var TVar{var})) | bs ← tv.bounds, not (null bs) = case tv.wildTau of Just "<" → "(≤" ++ manyK g nicer bs ++ ")" Just ">" → "(≥" ++ manyK g nicer bs ++ ")" _ → "(" ++ var ++ "≤" ++ manyK g nicer bs ++ ")" | otherwise = var showt 0 (Meta tv) = tv.nicer g - showt 0 (TCon {name}) = name.nicer g + showt 0 (TauT.Con c) = c.name.nicer g showt _ x = "(" ++ showt 2 x ++ ")" nice t g = showt 2 t where arrow = if isOn g.options.flags USEUNICODE then "→" else "->" showt 2 fun - | [TCon {name}, a, b] <- Tau.flat fun, - name.nice g ~ ´->|→$´ + | [TauT.Con c, a, b] <- Tau.flat fun, + c.name.nice g ~ ´->|→$´ = showt 1 a ++ arrow ++ showt 2 b showt 2 (TSig s) = nice s g showt 2 x = showt 1 x showt _ (t@TApp _ _) - | [TCon {name}, t] <- flat, name.nice g ~ ´\[\]$´ = "[" ++ showt 2 t ++ "]" - | (TCon {name}:ts) <- flat, name.nice g ~ ´\(,+\)$´ = "(" ++ joined "," (map (showt 2) ts) ++ ")" + | [TauT.Con c, t] <- flat, c.name.nice g ~ ´\[\]$´ = "[" ++ showt 2 t ++ "]" + | (TauT.Con c:ts) <- flat, c.name.nice g ~ ´\(,+\)$´ = "(" ++ joined "," (map (showt 2) ts) ++ ")" where flat = t.flat showt 1 fun - | [TCon {name}, a, b] <- Tau.flat fun, - name.nice g ~ ´(->|→)$´ = "(" ++ showt 1 a ++ arrow ++ showt 2 b ++ ")" + | [TauT.Con c, a, b] <- Tau.flat fun, + c.name.nice g ~ ´(->|→)$´ = "(" ++ showt 1 a ++ arrow ++ showt 2 b ++ ")" showt 1 (TApp a b) = showt 1 a ++ " " ++ showt 0 b showt 1 x = showt 0 x - showt 0 (tv@TVar {var}) + showt 0 (tv@(TauT.Var TVar{var})) | bs ← tv.bounds, not (null bs) = case tv.wildTau of Just "<" → "(≤" ++ manyK g nice bs ++ ")" Just ">" → "(≥" ++ manyK g nice bs ++ ")" @@ -312,7 +325,7 @@ instance (Nice t, QNameMatcher t) => Nice (TauT t) where | otherwise = var showt 0 (Meta tv) = tv.nice g - showt 0 (TCon {name}) = name.nice g + showt 0 (TauT.Con c) = c.name.nice g showt 0 x = "(" ++ showt 2 x ++ ")" showt _ x = Prelude.error ("can't show type with constructor " ++ show (constructor x)) diff --git a/frege/compiler/passes/Easy.fr b/frege/compiler/passes/Easy.fr index dbdede78..2fcd1c9c 100644 --- a/frege/compiler/passes/Easy.fr +++ b/frege/compiler/passes/Easy.fr @@ -67,9 +67,9 @@ pass = do -- check instance member's depth g <- getST - let imembers = [ imem | inst@SymI{} <- values g.thisTab, + let imembers = [ imem | SymbolT.I inst <- values g.thisTab, g.our inst.name, - imem <- values inst.env ] + imem <- values inst.meth ] foreach imembers checkDepth -- make all expressions easy g <- getST @@ -86,41 +86,38 @@ easySym (vsym@SymV {pos}) x <- dx if isOn g.options.flags INLINE && not (defaultMethod vsym.name g) then do ux <- inlined x >>= easyExpression - changeSym vsym.{expr = Just (return ux)} + changeSym $ SymbolT.V vsym.{expr = Just (return ux)} else do nx <- easyExpression x - changeSym vsym.{expr = Just (return nx)} + changeSym $ SymbolT.V vsym.{expr = Just (return nx)} | otherwise = stio () where defaultMethod name g = case name of MName tname _ -> case g.findit tname of - Just SymC{} -> true - _ -> false + Just (SymbolT.C _) -> true + _ -> false _ -> false -easySym sym = do - g <- getST - E.fatal sym.pos (text ("easySym no SymV : " ++ sym.nice g)) - -checkDepth (vsym@SymV {pos, name = MName inst base}) = do +checkDepth :: SymMeth Global -> StG () +checkDepth (SymMeth.V (vsym@SymV {pos, name = MName inst base})) = do g <- getST cmeth <- classMethodOfInstMethod pos inst base when (cmeth.depth > vsym.depth) do - U.symWarning E.hint vsym (msgdoc ( + U.symWarning E.hint (SymbolT.V vsym) (msgdoc ( nicer vsym g ++ " has depth " ++ show vsym.depth ++ " while " ++ nicer cmeth g ++ " has depth " ++ show cmeth.depth)) when (cmeth.depth < vsym.depth) do - changeSym vsym.{depth = cmeth.depth} + changeSym $ SymbolT.V vsym.{depth = cmeth.depth} return () -checkDepth (vsym@SymL {pos, alias, name = MName inst base}) = do +checkDepth (SymMeth.L (vsym@SymL {pos, alias, name = MName inst base})) = do g <- getST cmeth <- classMethodOfInstMethod pos inst base rmeth <- U.findVD alias - let d = if rmeth.{depth?} then rmeth.depth else U.arity rmeth + let d = case rmeth of { SymVal.V SymV{depth} -> depth; _ -> U.arity rmeth; } when (cmeth.depth != d) do E.error pos (msgdoc ( nicer rmeth g ++ " is not a suitable implementation for " @@ -149,9 +146,9 @@ depthSym (vsym@SymV {pos}) ++ ") of its type " ++ nicer typ g)) E.hint vsym.pos (msgdoc ("This is probably a compiler error.")) if (depth >= length sigmas) - then changeSym vsym.{expr = Just (return nx), typ, depth} -- fine, unless error + then changeSym $ SymbolT.V vsym.{expr = Just (return nx), typ, depth} -- fine, unless error else if depth == 0 && vsym.name.isLocal - then changeSym vsym.{expr = Just (pure nx), depth} -- don't change local syms that are not lambdas + then changeSym $ SymbolT.V vsym.{expr = Just (pure nx), depth} -- don't change local syms that are not lambdas else do g <- getST -- depth < sigmas, eta expand it newx <- etaExpand nx @@ -163,12 +160,12 @@ depthSym (vsym@SymV {pos}) ++ maybe "nix" (flip nice g) nx.typ)) E.logmsg TRACE9 vsym.pos (text ("new expr: " ++ nice newx g ++ " :: " ++ maybe "nix" (flip nice g) nx.typ)) - changeSym vsym.{expr = Just (return newx), typ, depth = newd} + changeSym $ SymbolT.V vsym.{expr = Just (return newx), typ, depth = newd} when (newd != (length sigmas)) do E.fatal vsym.pos (text (nice vsym g ++ ": after eta expansion depth=" ++ show newd ++ ", length sigmas=" ++ show (length sigmas) ++", turn on -x9")) - | otherwise = changeSym vsym.{depth = length sigmas} + | otherwise = changeSym $ SymbolT.V vsym.{depth = length sigmas} where typ = vsym.typ.{rho <- unTau} -- a -> (b->c) --> a -> b -> c (_, sigmas) = U.returnType typ.rho @@ -182,15 +179,6 @@ depthSym (vsym@SymV {pos}) | otherwise = stio (Left x) -depthSym sym = do - g <- getST - E.fatal sym.pos (text ("depthSym no SymV : " ++ sym.nice g)) - - - - - - --- copy expr and re-establish type recycle newpos expr rho = do g <- getST @@ -262,21 +250,21 @@ mkLet ex f = do var = Vbl{pos, name=sym.name, typ=ex.typ} aex = f var sym = patsym.{typ = fromMaybe pSigma ex.typ, expr = Just (return ex)} - enter sym + enter $ SymbolT.V sym return $! Let{env=[sym.name], ex=aex, typ=aex.typ} --- any expression x can be made simple through (\_ -> easy x) () +mkS :: ExprT -> ExprD Global mkS x = do e <- mkEasy x let lam = Lam {pat = PCon {pos, qname=unitName, pats=[]}, ex = e, typ = fmap utyp e.typ} utyp (ForAll bound rho) = - ForAll bound ( - RhoFun [] (TC.sigFor "()") rho - ) - pos = getpos e + ForAll bound $ + RhoT.Fun $ RhoFun [] (TC.sigFor "()") rho + pos = getpos e unitName = MName (TC.tc "()").name "()" uni = Con {pos, name=unitName, typ = Just (TC.sigFor "()")} g <- getST @@ -343,7 +331,6 @@ inlined = U.mapEx true inline not name.isLocal = do g <- getST sym <- U.findV name - -- E.logmsg TRACE9 (getpos v) (text ("can we inline " ++ nicer sym g ++ "?")) case sym.expr of Just dx -- we can't inline any class methods @@ -353,7 +340,7 @@ inlined = U.mapEx true inline -- e.g. display "foo" = "foo" -- and show "foo" = "\"foo\"" | MName tname _ <- name, - Just SymC{} <- g.findit tname = return (Left app) + Just (SymbolT.C _) <- g.findit tname = return (Left app) | sym.exported, d <- length rest, d >= sym.depth || d >= sym.depth-1 && sym.name `elem` superOpt = do @@ -369,7 +356,7 @@ inlined = U.mapEx true inline sym <- U.findV name case sym.expr of Just dx | MName tname _ <- name, - Just SymC{} <- g.findit tname = return (Left vbl) + Just (SymbolT.C _) <- g.findit tname = return (Left vbl) | sym.exported, sym.depth == 0 = do E.logmsg TRACE9 pos (text ("replace " ++ nice vbl g ++ " :: " ++ nicer sig g)) diff --git a/frege/compiler/passes/Enter.fr b/frege/compiler/passes/Enter.fr index ae03a6ab..da007863 100644 --- a/frege/compiler/passes/Enter.fr +++ b/frege/compiler/passes/Enter.fr @@ -5,6 +5,7 @@ import frege.Prelude hiding (<+>) import frege.data.TreeMap as TM(TreeMap, keys, values, insert) import frege.data.List as DL(uniqBy, sort, sortBy) +import frege.compiler.common.Lens (over) import frege.compiler.enums.Flags as Compilerflags(TRACE3, TRACE4, isOn, isOff) import frege.compiler.enums.TokenID(defaultInfix) @@ -50,18 +51,17 @@ symbols tree = fold (+) 0 (map oneSym (values tree)) oneSym :: Symbol -> Int -oneSym sym - | sym.{env?} = 1 + symbols sym.env - | otherwise = 1 +oneSym sym = 1 + maybe 0 symbols sym.env' -isInstOrDerive (InsDcl {pos}) = true -isInstOrDerive (DrvDcl {pos}) = true -isInstOrDerive _ = false +isInstOrDerive :: DefinitionS -> Bool +isInstOrDerive (DefinitionS.Ins _) = true +isInstOrDerive (DefinitionS.Drv _) = true +isInstOrDerive _ = false -private transTVar :: TauS -> Tau -private transTVar tv = tv.{kind ← transKind} +private transTVar :: TVar SName -> TVar QName +private transTVar = _.{kind <- transKind} private transKind :: KindS -> Kind @@ -76,15 +76,17 @@ link :: Symbol -> StG () link sym = do g <- getST E.logmsg TRACE3 sym.pos (text ("`" ++ sym.name.base ++ "` link to " ++ sym.nice g)) - ST.enter (SymL {sid=0, pos=sym.pos, vis=sym.vis, -- doc=Nothing, + ST.enter $ SymbolT.L + (SymL {sid=0, pos=sym.pos, vis=sym.vis, -- doc=Nothing, name=VName g.thisPack sym.name.base, alias=sym.name}) --- reorder definitions so that annotations come last +annosLast :: [DefinitionS] -> [DefinitionS] annosLast defs = nannos ++ annos where (annos, nannos) = DL.partition isAnno defs - isAnno (AnnDcl {pos}) = true - isAnno _ = false + isAnno (DefinitionS.Ann _) = true + isAnno _ = false {-- @@ -92,18 +94,36 @@ annosLast defs = nannos ++ annos where Takes care that annotations are processed after their implementations so that 'changeSym' will work. -} +enter :: (String -> QName) -> [DefinitionS] -> StG () enter fname defs = foreach (annosLast defs) (enter1 fname) {-- create provisional symbol for 1 definition in the symbol table -} enter1 :: (String -> QName) -> DefinitionS -> StG () -enter1 fname (d@FunDcl {positions}) = case funbinding d of +enter1 fname d = + case d of + DefinitionS.Fun x -> enter1FunDcl fname x + DefinitionS.Nat x -> enter1NatDcl fname x + DefinitionS.Ann x -> enter1AnnDcl fname x + DefinitionS.Cla x -> enter1ClaDcl fname x + DefinitionS.Ins x -> enter1InsDcl fname x + DefinitionS.Drv x -> E.fatal x.pos (text "FATAL: cannot enter a derive definition") + DefinitionS.Dat x -> enter1DatDcl fname x + DefinitionS.Jav x -> enter1JavDcl fname x + DefinitionS.Typ x -> enter1TypDcl fname x + DefinitionS.Imp _ -> stio () + DefinitionS.Fix _ -> stio () + DefinitionS.Doc _ -> stio () + DefinitionS.Mod _ -> stio () + +enter1FunDcl :: (String -> QName) -> FunDcl -> StG () +enter1FunDcl fname (d@FunDcl {positions}) = case funbinding d of Just name -> do let qname = fname name.value foreach positions (register qname) - ST.enter (vSym (positionOf name) qname).{vis=d.vis, doc=d.doc} - - sonst + ST.enter $ SymbolT.V (vSym (positionOf name) qname).{vis=d.vis, doc=d.doc} + + sonst | not (patbinding d), Vbl{name=Simple excl} <- d.lhs, excl.value == "!" || excl.value=="?", @@ -111,7 +131,7 @@ enter1 fname (d@FunDcl {positions}) = case funbinding d of Just name <- funbinding d.{lhs=pat, pats=[]} -> do let !qname = fname name.value register qname name - ST.enter (vSym (positionOf name) qname).{vis=d.vis, doc=d.doc, + ST.enter $ SymbolT.V (vSym (positionOf name) qname).{vis=d.vis, doc=d.doc, strsig = if excl.value == "!" then S[] else U} | otherwise = do g <- getST @@ -123,15 +143,18 @@ enter1 fname (d@FunDcl {positions}) = case funbinding d of changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk tok) (Right qname)}} - -enter1 fname (d@NatDcl {pos}) = do + +enter1NatDcl :: (String -> QName) -> NatDcl -> StG () +enter1NatDcl fname (d@NatDcl {pos}) = do let !qname = fname d.name changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk pos.first) (Right qname)}} - ST.enter (vSym pos qname).{vis=d.vis, doc=d.doc, - nativ=Just d.meth, pur=d.isPure} -enter1 fname (d@AnnDcl {pos}) = do + ST.enter $ SymbolT.V + (vSym pos qname).{vis=d.vis, doc=d.doc, nativ=Just d.meth, pur=d.isPure} + +enter1AnnDcl :: (String -> QName) -> AnnDcl -> StG () +enter1AnnDcl fname (d@AnnDcl {pos}) = do g <- getST let qname = fname d.name merge Nothing _ b _ = b @@ -141,46 +164,57 @@ enter1 fname (d@AnnDcl {pos}) = do merge a _ _ _ = a case g.findit qname of - Just (sym@SymV {nativ = Nothing, anno = false}) -> do - when (sym.vis != d.vis) do + Just (SymbolT.V (symv@SymV{nativ = Nothing, anno = false})) -> do + when (symv.vis != d.vis) do E.error pos (msgdoc ("Visibility of annotation and implementation must match," - ++ " implementation was announced as " ++ show sym.vis - ++ " at line " ++ show sym.pos)) - ST.changeSym sym.{pos <- d.pos.merge, - doc = merge sym.doc sym.pos d.doc d.pos, + ++ " implementation was announced as " ++ show symv.vis + ++ " at line " ++ show symv.pos)) + ST.changeSym $ SymbolT.V + symv.{pos <- d.pos.merge, + doc = merge symv.doc symv.pos d.doc d.pos, anno = true} changeST Global.{ sub <- SubSt.{ - idKind <- insert (KeyTk pos.first) (Right sym.name)}} - Just (sym@SymV {anno = true}) -> + idKind <- insert (KeyTk pos.first) (Right symv.name)}} + Just (sym@(SymbolT.V SymV{anno = true})) -> E.error pos (msgdoc ("cannot annotate " ++ sym.nice g ++ " again")) Just sym -> E.error pos (msgdoc ("cannot annotate " ++ sym.nice g)) Nothing -> do -- either class method or implementation missing. - ST.enter (vSym d.pos qname).{vis=d.vis, doc=d.doc, anno = true} + ST.enter $ SymbolT.V (vSym d.pos qname).{vis=d.vis, doc=d.doc, anno = true} changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk pos.first) (Right qname)}} - -enter1 fname (d@ClaDcl {pos}) = do +enter1ClaDcl :: (String -> QName) -> ClaDcl -> StG () +enter1ClaDcl fname (d@ClaDcl {pos}) = do g <- getST let tname = TName g.thisPack d.name changeST Global.{sub <- SubSt.{idKind <- insert (KeyTk pos.first) (Right tname)}} - ST.enter (SymC {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name=tname, - tau=transTVar d.clvar, supers=[], insts=[], env=empty}) + ST.enter $ SymbolT.C + (SymC {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name=tname, + clvar=transTVar d.clvar, supers=[], insts=[], meth=empty}) - let vdefs = map DefinitionS.{vis <- max d.vis} d.defs - xdefs = filter ((>d.vis) • DefinitionS.vis) d.defs + let vdefs = map (\def -> def.chgVis $ max d.vis) d.members + xdefs = filter ((>d.vis) . _.vis) d.members -- complain about class members that are more visible than the class - foreach xdefs (\(def::DefinitionS) -> E.error def.pos (msgdoc ( - d.name ++ "." ++ def.name ++ " is " ++ show def.vis - ++ " while the enclosing class is only " - ++ show d.vis))) - - enter (MName tname) vdefs + foreach xdefs $ \def -> + let emitError name pos = + E.error pos $ msgdoc $ + d.name ++ "." ++ name ++ " is " ++ show def.vis + ++ " while the enclosing class is only " + ++ show d.vis + in + case def of + -- a bare FunDcl (a function definition without annotation) is + -- assumed absent + ClassMemberS.Ann x -> emitError x.name x.pos + ClassMemberS.Nat x -> emitError x.name x.pos + ClassMemberS.Fun _ -> pure () + + enter (MName tname) $ map (_.toDefinitionS) vdefs {- all entries from the env of the symbol that is named by 'tname' except those whose name is found in the global package and the @@ -191,41 +225,48 @@ enter1 fname (d@ClaDcl {pos}) = do define a method with the same name.) -} g <- getST - let vs = (filter (maybe true (not • Symbol.{alias?}) - • g.find • VName g.thisPack - • QName.base • Symbol.name) - • values • maybe empty Symbol.env) (g.findit tname) + let vs = (filter (maybe true (not . Lens.has SymbolT._L) + . g.find . VName g.thisPack + . QName.base . _.name) + . values . fromMaybe empty) (_.env' =<< g.findit tname) E.logmsg TRACE3 pos (text ("enter1: ClaDcl: vs=" ++ show (map (flip nice g) vs))) foreach (vs) link -enter1 !fname (!d@InsDcl {pos = !pos}) = do +enter1InsDcl :: (String -> QName) -> InsDcl -> StG () +enter1InsDcl !fname (!d@InsDcl {pos = !pos}) = do g <- getST let tname = TName g.thisPack (insName d) - ST.enter (SymI {pos=d.pos, vis=d.vis, doc=d.doc, name=tname, - sid=0, clas=fname "", typ=pSigma, env=empty}) + ST.enter $ SymbolT.I + (SymI {pos=d.pos, vis=d.vis, doc=d.doc, name=tname, + sid=0, clas=fname "", typ=pSigma, meth=empty}) enter (MName tname) d.defs !typ <- U.transSigma d.typ !clas <- defaultXName (Pos d.clas.id d.clas.id) (TName pPreludeBase "Eq") d.clas case instTSym typ g of - Just (SymT {name=typnm}) -> do + Just SymT{name=typnm} -> do foreach d.defs (mklinkd typnm (MName tname)) case g.findit clas of - Just (SymC {name,env}) -> do + Just (SymbolT.C _) -> do return () -- let cmeths = [ sym.name.base | sym@SymV{anno=true} <- values env ] -- foreach (map (QName.base • Symbol.name) (values env)) (mklink typnm (MName name)) _ -> E.error pos (msgdoc ("`" ++ clas.nice g ++ "` does not name a class.")) - Just sym -> E.error pos (msgdoc ("can't make instance for " ++ sym.nice g - ++ ", it's not a type at all.")) Nothing -> E.error pos (msgdoc ("can't make instance for " ++ typ.nicer g ++ ", there is no type constructor.")) where mklinkd !tname !mname !d - | Just t <- funbinding d = mklink tname mname t.value - | d.{name?} = mklink tname mname d.name + | DefinitionS.Fun f <- d + , Just t <- funbinding f = mklink tname mname t.value + -- enumerated all possibilities; some cases may be redundant + | DefinitionS.Typ t <- d = mklink tname mname t.name + | DefinitionS.Cla t <- d = mklink tname mname t.name + | DefinitionS.Ann t <- d = mklink tname mname t.name + | DefinitionS.Nat t <- d = mklink tname mname t.name + | DefinitionS.Dat t <- d = mklink tname mname t.name + | DefinitionS.Jav t <- d = mklink tname mname t.name | otherwise = error ("function binding expected: " ++ tname.base) mklink !tname !mname !nm = do g <- getST @@ -237,17 +278,16 @@ enter1 !fname (!d@InsDcl {pos = !pos}) = do Nothing -> linkq rem sym Nothing -> E.fatal d.pos (text ("FATAL, can't find " ++ mem.nice g ++ " again")) -enter1 fname (d@DrvDcl {pos}) = E.fatal pos (text "FATAL: cannot enter a derive definition") - -enter1 fname (d@DatDcl {pos}) = do +enter1DatDcl :: (String -> QName) -> DatDcl -> StG () +enter1DatDcl fname (d@DatDcl {pos}) = do g <- getST -- dkinds ← mapM U.transKind dsig.kinds let dname = TName g.thisPack d.name kind = foldr KApp KType dsig.kinds - dtcon = TCon {pos=d.pos, name=dname} + dtcon = TauT.Con TCon{pos=d.pos, name=dname} vars = map transTVar d.vars - dtau = if null d.vars then dtcon else dtcon.mkapp vars - drho = RhoTau [] dtau + dtau = if null d.vars then dtcon else dtcon.mkapp $ map TauT.Var vars + drho = RhoT.Tau RhoTau{context=[], tau=dtau} dsig = ForAll vars drho dsym = SymT {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name=dname, typ=dsig, product = length d.ctrs == 1, @@ -262,7 +302,7 @@ enter1 fname (d@DatDcl {pos}) = do --when (not d.newt && length d.ctrs == 1 && 1 == (length • DCon.flds • head) d.ctrs) do -- E.hint d.pos (text d.name PP.<+> text "could be a newtype") - ST.enter dsym + ST.enter $ SymbolT.T dsym changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk pos.first) (Right dname)}} @@ -284,16 +324,18 @@ enter1 fname (d@DatDcl {pos}) = do register (p, n) = changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk (Position.first p)) (Right (mname n))}} foreach fnms (checkunique dcon.pos (mname dcon.name) fnms) - ST.enter (SymD {name = mname dcon.name, typ=pSigma, flds = fs, + ST.enter $ SymbolT.D + (SymD {name = mname dcon.name, typ=pSigma, flds = fs, cid=cid, sid=0, strsig = ssig, op = defaultInfix, pos=dcon.pos, vis=dcon.vis, doc=dcon.doc}) changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk dcon.pos.first) (Right cqname)}} foreach fnps register - when (dcon.vis == Public) - (ST.enter (SymL {name = VName g.thisPack dcon.name, alias = cqname, - sid=0, pos=dcon.pos, vis=dcon.vis, {-doc=dcon.doc-}})) + when (dcon.vis == Public) $ + ST.enter $ SymbolT.L + (SymL {name = VName g.thisPack dcon.name, alias = cqname, + sid=0, pos=dcon.pos, vis=dcon.vis, {-doc=dcon.doc-}}) checkunique :: Position -> QName -> [String] -> String -> StG () checkunique pos con fs f = do when (1 < (length • filter (f==)) fs) do @@ -302,18 +344,19 @@ enter1 fname (d@DatDcl {pos}) = do " must occur only once.")) stio () - -enter1 fname (d@JavDcl {pos}) = do +enter1JavDcl :: (String -> QName) -> JavDcl -> StG () +enter1JavDcl fname (d@JavDcl {pos}) = do g <- getST let !dname = TName g.thisPack d.name - dtcon = TCon {pos=d.pos, name=dname} + dtcon = TauT.Con TCon{pos=d.pos, name=dname} vars = map transTVar d.vars - dtau = dtcon.mkapp vars + dtau = dtcon.mkapp $ map TauT.Var vars ktype = KType :: Kind -- if primitive then KType else KGen kind = foldr KApp ktype dsig.kinds - dsig = ForAll vars (RhoTau [] dtau) + dsig = ForAll vars (RhoT.Tau RhoTau{context=[], tau=dtau}) jname = d.jclas - ST.enter (SymT {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name=dname, + ST.enter $ SymbolT.T + (SymT {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name=dname, product = false, enum = false, newt = false, pur = d.isPure, typ=dsig, gargs=[], kind, nativ = Just jname, env=empty}) @@ -322,39 +365,40 @@ enter1 fname (d@JavDcl {pos}) = do idKind <- insert (KeyTk pos.first) (Right dname)}} enter (MName dname) d.defs -enter1 fname (d@TypDcl {pos}) = do +enter1TypDcl :: (String -> QName) -> TypDcl -> StG () +enter1TypDcl fname (d@TypDcl {pos}) = do g <- getST let !dname = TName g.thisPack d.name kind = KVar changeST Global.{ sub <- SubSt.{ idKind <- insert (KeyTk pos.first) (Right dname)}} - ST.enter (SymA {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, + ST.enter $ SymbolT.A + (SymA {sid=0, pos=d.pos, vis=d.vis, doc=d.doc, name = dname, typ = pSigma, kind, vars = map transTVar d.vars}) -enter1 fname (ImpDcl {pos}) = stio () -enter1 fname (FixDcl {pos}) = stio () -enter1 fname (DocDcl {pos}) = stio () -enter1 fname (ModDcl {pos}) = stio () +class IsInstanceDcl a where + typ :: a -> SigmaS + clas :: a -> SName +instance IsInstanceDcl InsDcl +instance IsInstanceDcl DrvDcl -insName :: DefinitionS -> String -insName idcl | idcl.{clas?}, idcl.{typ?} = clas ++ "_" ++ tcon idcl.typ where +insName :: IsInstanceDcl a => a -> String +insName idcl = clas ++ "_" ++ tcon idcl.typ where clas = idcl.clas.id.value tcon (ForAll _ rho) = rhoTcon rho - rhoTcon (RhoFun _ _ _) = "->" - rhoTcon (RhoTau _ tau) = tauTcon tau - -- tauTcon (TCon {name=m~#^PreludeBase\.(\S+)$#}) = unJust (m.group 1) - tauTcon (TCon {name}) = case name of + rhoTcon (RhoT.Fun _) = "->" + rhoTcon (RhoT.Tau r) = tauTcon r.tau + tauTcon (TauT.Con TCon{name}) = case name of Simple t = t.value With1{} | name.ty.value == "PreludeBase" = name.id.value | otherwise = name.ty.value ++ "_" ++ name.id.value With2{} = error ("insName: should not happen " ++ show name) tauTcon (TApp a _) = tauTcon a - tauTcon (TVar {var}) = var -- undefined + tauTcon (TauT.Var t) = t.var -- undefined tauTcon (Meta _) = "meta" -- undefined tauTcon TSig{} = "forall" -insName _ = error "not an instance" \ No newline at end of file diff --git a/frege/compiler/passes/Fields.fr b/frege/compiler/passes/Fields.fr index 960a1ff0..00cdfb62 100644 --- a/frege/compiler/passes/Fields.fr +++ b/frege/compiler/passes/Fields.fr @@ -34,22 +34,27 @@ import frege.compiler.Utilities as U(vSym) -} pass = do g <- getST - definitions <- mapSt chgddef g.sub.sourcedefs - changeST Global.{sub <- SubSt.{sourcedefs = definitions}} - return ("fields", (count definitions - count g.sub.sourcedefs ) `quot` 4) - -count :: [DefinitionS] -> Int -count = sum . map subdefs - where - subdefs d | d.{defs?} = length d.defs - | otherwise = 0 + (count, newDefsRev) <- foldSt + (\(count, newDefs) oldDef -> + case oldDef of + DefinitionS.Dat d -> do + newDef <- chgddef d + pure (count + 1, DefinitionS.Dat newDef:newDefs) + other -> pure (count, other:newDefs) + ) + (0, []) + g.sub.sourcedefs + changeST Global.{sub <- SubSt.{sourcedefs = reverse newDefsRev}} + return ("fields", count) +chgddef :: DatDcl -> StG DatDcl chgddef (d@DatDcl {pos}) = do g <- getST let dname = TName g.thisPack d.name dsym <- U.findT dname - let (newdefs,_) = work g dsym + let (newdefs',_) = work g dsym + newdefs = map DefinitionS.Fun newdefs' enter (MName dname) newdefs -- inlining chg$field and upd$field tends to break binary compatibility, -- because the caller's java code will use the constructor directly. @@ -58,18 +63,17 @@ chgddef (d@DatDcl {pos}) = do -- changeST _.{sub <- _.{toExport <- (exports++)}} stio d.{defs <- (++ newdefs)} where - work :: Global -> Symbol -> ([DefinitionS], [SName]) + work :: Global -> SymT Global -> ([FunDcl], [SName]) work g (dsym@SymT {env}) = - let cons = [ sym | sym@SymD {sid} <- values env ] - fields = (uniqBy (using fst) • sort) [ (f,p) | con <- cons, Field {pos = p, name = Just f} <- Symbol.flds con ] + let cons = [ sym | SymbolT.D sym <- values env ] + fields = (uniqBy (using fst) . sort) [ (f,p) | con <- cons, Field {pos = p, name = Just f} <- con.flds ] in ([ d | (f,p) <- fields, d <- gen g p dsym.name cons f], if length cons == 1 then [ With1 (p.change CONID dsym.name.base).first (p.change VARID (s ++ f)).first | (f, p) <- fields, s <- ["chg$", "upd$"]] else []) - work _ _ = error "work: need a SymT" - gen :: Global -> Position -> QName -> [Symbol] -> String -> [DefinitionS] + gen :: Global -> Position -> QName -> [SymD Global] -> String -> [FunDcl] gen g fpos tname cons f = let pos = fpos.{first <- Token.{offset <- succ}} model = FunDcl {vis = Public, positions = [fpos.first], @@ -87,22 +91,22 @@ chgddef (d@DatDcl {pos}) = do -- -------------- utility functions --------------- -- get the doc for field f getdoc = case [ d | con <- cons, - Field {name = Just g, doc = Just d} <- Symbol.flds con, + Field {name = Just g, doc = Just d} <- con.flds, f == g ] of [] -> Just ("access field @" ++ f ++ "@") xs -> Just (joined "\n" xs) -- numbers = iterate (1+) 1 - confs :: Symbol -> [Maybe String] - confs sym = map ConField.name (Symbol.flds sym) -- just the names + confs :: SymD Global -> [Maybe String] + confs sym = map ConField.name sym.flds -- just the names -- find sub-pattern name of field f in constructor sym - occurs :: Symbol -> String -> [ExprS] + occurs :: SymD Global -> String -> [ExprS] occurs sym f = (map fst • filter ((==Just f) • snd) • zip subvars) (confs sym) -- arity of a constructor - arity :: Symbol -> Int - arity sym = length (Symbol.flds sym) + arity :: SymD Global -> Int + arity sym = length sym.flds -- displayed name of a constructor - cname :: Symbol -> SName - cname sym = case Symbol.name sym of + cname :: SymD Global -> SName + cname sym = case sym.name of MName tn base -> With1 pos.first.{tokid=CONID, value=tn.base} pos.first.{tokid=CONID, value=base} _ -> error "constructor must be a member" @@ -134,12 +138,12 @@ chgddef (d@DatDcl {pos}) = do getAlts = [ CAlt {pat=conpat con "a", ex=v} | con <- cons, v <- occurs con f] updExpr = Case CNoWarn this updAlts - conUpd :: Symbol -> ExprS -> ExprS + conUpd :: SymD Global -> ExprS -> ExprS conUpd con v = mkApp (conval con) (rep v.name.id.value that (take (arity con) subvars)) updAlts = [ CAlt {pat=conpat con "a", ex = conUpd con v} | con <- cons, v <- occurs con f] chgExpr = Case CNoWarn this chgAlts - conChg :: Symbol -> ExprS -> ExprS + conChg :: SymD Global -> ExprS -> ExprS conChg con v = mkApp (conval con) (rep v.name.id.value (nApp that v) (take (arity con) subvars)) chgAlts = [ CAlt {pat=conpat con "a", ex = conChg con v} | con <- cons, v <- occurs con f] @@ -150,5 +154,3 @@ chgddef (d@DatDcl {pos}) = do | con <- cons, v <- occurs con f] last = CAlt {pat=var "_", ex = vFalse} in [symf, symu, symc, symh] -chgddef d = stio d -- leave others unchanged - diff --git a/frege/compiler/passes/Final.fr b/frege/compiler/passes/Final.fr index 41a90481..90ff57f6 100644 --- a/frege/compiler/passes/Final.fr +++ b/frege/compiler/passes/Final.fr @@ -1,13 +1,14 @@ --- The final compiler pass module frege.compiler.passes.Final where +import frege.compiler.common.Lens (over) + import Data.TreeMap as TM(TreeMap, insert, each) import Compiler.types.Global import Compiler.enums.Flags import Compiler.common.ImpExp import Compiler.types.Symbols import Compiler.types.External -import Compiler.Classtools as CT buildMode :: Global -> Bool @@ -41,12 +42,13 @@ cleanSymtab = do where maptab g = fmap symbol g.thisTab where - symbol sym = case sym of - SymV{name} | Just e <- g.gen.expSym.lookup name - = sym.{expr = Just (exprFromA sarray eAarray eAarray.[e])} - SymV{} = sym.{expr = Nothing} - _ | sym.{env?} = sym.{env <- fmap symbol} - | otherwise = sym + symbol = mapEnvSymV $ \symv -> + symv.{expr = fmap (\e -> exprFromA sarray eAarray eAarray.[e]) $ g.gen.expSym.lookup symv.name} + mapEnvSymV :: (Symbols.SymV Global -> Symbols.SymV Global) -> Symbol -> Symbol + mapEnvSymV mapsymv sym = case sym of + SymbolT.V symv -> SymbolT.V $ mapsymv symv + SymbolT.T symt -> SymbolT.T $ symt.{env <- fmap (mapEnvSymV mapsymv)} + _ -> over SymbolT._meth (fmap (over SymMeth._V mapsymv)) sym swap :: (a,b) -> (b,a) swap (a,b) = (b,a) -- !kAarray = (arrayFromIndexList . map swap . each) empty -- g.gen.kTree diff --git a/frege/compiler/passes/Fix.fr b/frege/compiler/passes/Fix.fr index 5c9f43bc..1d3bd765 100644 --- a/frege/compiler/passes/Fix.fr +++ b/frege/compiler/passes/Fix.fr @@ -51,10 +51,14 @@ pass = do -} fixdefs :: [DefinitionS] -> StG [DefinitionS] fixdefs defs = do - ds <- unDoc defs >>= mapM unlet >>= pure . concat + ds <- unDoc defs >>= mapM (forFunDcl unlet) >>= pure . concat fs <- funJoin ds - checkUniq [ name | dcl@FunDcl {lhs} <- fs, name <- funbinding dcl ] + checkUniq [ name | DefinitionS.Fun dcl <- fs, name <- funbinding dcl ] return fs + where + forFunDcl :: (FunDcl -> StG [FunDcl]) -> DefinitionS -> StG [DefinitionS] + forFunDcl f (DefinitionS.Fun x) = map DefinitionS.Fun <$> f x + forFunDcl _ d = pure [d] checkUniq [] = return () @@ -76,7 +80,7 @@ checkUniq (name:as) = do > a = case let of (a,b) -> a > b = case let of (a,b) -> b -} -unlet :: DefinitionS -> StG [DefinitionS] +unlet :: FunDcl -> StG [FunDcl] unlet f | FunDcl{vis, lhs, pats, expr, doc} <- f, patbinding f = do @@ -127,30 +131,56 @@ unlet f unDoc :: [DefinitionS] -> StG [DefinitionS] unDoc [] = stio [] unDoc (defs@(d:ds)) - | DocDcl {} <- d = do r <- apply doc rest; unDoc r - | d.{defs?} = do ndefs <- fixdefs d.defs - liftM2 (:) (stio d.{defs=ndefs}) (unDoc ds) - | otherwise = liftM2 (:) (stio d) (unDoc ds) + | DefinitionS.Doc d' <- d + = do r <- apply doc d'.pos rest + unDoc r + | DefinitionS.Cla d' <- d + = do defs <- fixdefs d'.defs + (DefinitionS.Cla (d'.{defs}) :) <$> unDoc ds + | DefinitionS.Ins d' <- d + = do defs <- fixdefs d'.defs + (DefinitionS.Ins (d'.{defs}) :) <$> unDoc ds + | DefinitionS.Dat d' <- d + = do defs <- fixdefs d'.defs + (DefinitionS.Dat (d'.{defs}) :) <$> unDoc ds + | DefinitionS.Jav d' <- d + = do defs <- fixdefs d'.defs + (DefinitionS.Jav (d'.{defs}) :) <$> unDoc ds + | otherwise = (d:) <$> unDoc ds where - pos = d.pos - docs = takeWhile isDoc defs + docs = [ x | DefinitionS.Doc x <- takeWhile isDoc defs ] rest = dropWhile isDoc defs - isDoc (DocDcl {}) = true - isDoc _ = false - doc = joined "\n\n" (map DefinitionS.text docs) - apply :: String -> [DefinitionS] -> StG [DefinitionS] - apply str [] = do E.warn pos (msgdoc ("documentation at end of file")); stio [] - apply str (d:ds) = case d of - ImpDcl {pos=p} -> do - E.warn p (msgdoc ("there is no point in documenting an import, documentation from line " + isDoc (DefinitionS.Doc _) = true + isDoc _ = false + doc = joined "\n\n" (map _.text docs) + apply :: String -> Position -> [DefinitionS] -> StG [DefinitionS] + apply str pos [] = do E.warn pos (msgdoc ("documentation at end of file")); stio [] + apply str pos (d:ds) = case d of + DefinitionS.Imp def -> do + E.warn def.pos (msgdoc ("there is no point in documenting an import, documentation from line " ++ show pos ++ " ignored.")) stio (d:ds) - FixDcl {pos=p} -> do - E.warn p (msgdoc ("there is no point in documenting a fixity declaration, documentation from line " + DefinitionS.Fix def -> do + E.warn def.pos (msgdoc ("there is no point in documenting a fixity declaration, documentation from line " ++ show pos ++ " ignored.")) stio (d:ds) - def | Just s <- def.doc = stio (def.{doc = Just (str ++ "\n\n" ++ s)} : ds) - | otherwise = stio (def.{doc = Just str} : ds) + DefinitionS.Mod def -> do + E.warn def.pos (msgdoc ("documenting a native module declaration is not supported. documentation from line " + ++ show pos ++ " ignored.")) + stio (d:ds) + DefinitionS.Doc def -> do + E.warn def.pos (msgdoc ("should not happen, this is a bug of the compiler. documentation from line " + ++ show pos ++ " ignored.")) + stio (d:ds) + DefinitionS.Typ def -> pure $ (DefinitionS.Typ $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Cla def -> pure $ (DefinitionS.Cla $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Ins def -> pure $ (DefinitionS.Ins $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Drv def -> pure $ (DefinitionS.Drv $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Ann def -> pure $ (DefinitionS.Ann $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Nat def -> pure $ (DefinitionS.Nat $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Fun def -> pure $ (DefinitionS.Fun $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Dat def -> pure $ (DefinitionS.Dat $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds + DefinitionS.Jav def -> pure $ (DefinitionS.Jav $ def.{doc = Just $ str ++ maybe "" ("\n\n" ++) def.doc}) : ds {-- * look for adjacent function definitions with same name and join them @@ -158,30 +188,30 @@ unDoc (defs@(d:ds)) funJoin :: [DefinitionS] -> StG [DefinitionS] funJoin [] = return [] funJoin (defs@(d:ds)) - | FunDcl {lhs} <- d, Just name <- funbinding d - = do + | (DefinitionS.Fun f) <- d, Just name <- funbinding f + = do joined <- joinFuns (Pos name name) (funs name) rest <- funJoin (next name) - return (joined:rest) + return (DefinitionS.Fun joined:rest) | otherwise = do rest <- funJoin ds return (d:rest) where - funs name = takeWhile (sameFun name) defs + funs name = [f | DefinitionS.Fun f <- takeWhile (sameFun name) defs] next name = dropWhile (sameFun name) defs - sameFun name fundcl | Just n <- funbinding fundcl = n.value == name.value + sameFun name (DefinitionS.Fun fundcl) | Just n <- funbinding fundcl = n.value == name.value sameFun name _ = false - joinFuns :: Position -> [DefinitionS] -> StG DefinitionS + joinFuns :: Position -> [FunDcl] -> StG FunDcl joinFuns pos [f] = return f.{positions=[pos.first]} joinFuns pos (fs@(f:_)) | null f.pats = do E.error pos (msgdoc "function binding without patterns must have only a single equation") return f - | (g:_) <- filter (\x -> DefinitionS.vis x != f.vis) fs = do - E.error (getpos g.lhs) (msgdoc ("the visibility of " ++ g.name ++ + | (g:_) <- filter (\x -> FunDcl.vis x != f.vis) fs = do + E.error (getpos g.lhs) (msgdoc ("the visibility of the functions" ++ " must match that of the equation in line " ++ show pos)) stio f - | (g:_) <- filter (\x -> length (DefinitionS.pats x) != length f.pats) fs = do + | (g:_) <- filter (\x -> length (FunDcl.pats x) != length f.pats) fs = do E.error (getpos g.lhs) (msgdoc ("number of patterns (" ++ show (length g.pats) ++ ") must be the same as in previous equations (" ++ show (length f.pats))) @@ -196,8 +226,8 @@ funJoin (defs@(d:ds)) -- newpats = [ PVar (pos.change VARID ("_"++i)) 0 ("_" ++ i) | i <- take arity allAsciiBinders] newexpr = Case CNormal (mkTuple Con pos newvars) alts alts = [ CAlt {pat=mkpTuple (getpos g.lhs) g.pats, ex = g.expr} | - (g::DefinitionS) <- fs ] - olddoc = [ s | Just s <- map DefinitionS.doc fs ] + (g::FunDcl) <- fs ] + olddoc = [ s | Just s <- map FunDcl.doc fs ] newdoc = if null olddoc then Nothing else Just (joined "\n\n" olddoc) joinFuns _ [] = error "fatal compiler error: joinFuns []" diff --git a/frege/compiler/passes/GenCode.fr b/frege/compiler/passes/GenCode.fr index fd768a34..60f1643a 100644 --- a/frege/compiler/passes/GenCode.fr +++ b/frege/compiler/passes/GenCode.fr @@ -153,27 +153,27 @@ pass = do g ← getSTT -- classes - let classes = [ s | s@SymC {} <- values g.thisTab ] + let classes = [ s | SymbolT.C s <- values g.thisTab ] liftStG (concat <$> mapM classCode classes) >>= liftIO . ppDecls g -- instances - let instances = [ s | s@SymI {} <- values g.thisTab ] + let instances = [ s | SymbolT.I s <- values g.thisTab ] liftStG (concat <$> mapM instanceCode instances) >>= liftIO . ppDecls g -- data definitions - let datas = [ s | s@SymT {} <- values g.thisTab ] + let datas = [ s | SymbolT.T s <- values g.thisTab ] liftStG (concat <$> mapM dataCode datas) >>= liftIO . ppDecls g -- do variables in dependency order, this is so that CAFs refer only to CAFs -- whose java initialization occurs earlier - let vars = [ s | s@SymV {} <- values g.thisTab ] + let vars = [ s | SymbolT.V s <- values g.thisTab ] liftStG ( mapSt U.fundep vars >>= mapSt U.findV . concat . tsort - >>= mapSt (varCode TreeMap.empty)) + >>= mapSt (varCode TreeMap.empty . SymMeth.V)) >>= liftIO . ppDecls g . concat -- generate the class for constants @@ -246,7 +246,7 @@ ppDecls g decls = do > if ret then System.exit(0) else System.exit(1); or System.exit(ret&255); or empty > } -} -mainCode ∷ Global → Symbol → [String] +mainCode :: Global -> SymV Global -> [String] mainCode g sym = [ " public static void main(final java.lang.String[] argv) {", " try {", @@ -269,8 +269,8 @@ mainCode g sym = [ " }" ] where - shutdown = "frege.run.Concurrent.shutDownIfExists"; - name = (symJavaName g sym).base + shutdown = "frege.run.Concurrent.shutDownIfExists" + name = (symJavaName g $ SymbolT.V sym).base jtype = tauJT g (fst (U.returnType sym.typ.rho)) isInt | Func{gargs=[a,b]} ← jtype = show b == "Integer" @@ -287,7 +287,7 @@ mainCode g sym = [ list = if strict then stol else lazy stol --- tell if there is a main function in this module --- haveMain :: Global -> Bool +haveMain :: Global -> Maybe (SymV Global) haveMain g = case Global.findit g (VName g.thisPack "main") of - Just sym | sym.name.pack == g.thisPack = Just sym - other = Nothing \ No newline at end of file + Just (SymbolT.V sym) | sym.name.pack == g.thisPack -> Just sym + _ -> Nothing diff --git a/frege/compiler/passes/GlobalLam.fr b/frege/compiler/passes/GlobalLam.fr index 19c609e3..5044b35a 100644 --- a/frege/compiler/passes/GlobalLam.fr +++ b/frege/compiler/passes/GlobalLam.fr @@ -37,14 +37,11 @@ singleLetSym sym = do E.fatal sym.pos ("unrollSym no SymV : " ++ sym.nice g) -} -closedLambdaSym (vsym@SymV {pos}) +closedLambdaSym vsym | Just x <- vsym.expr = do nx <- x >>= U.mapExBody true closedLambda - changeSym vsym.{expr = Just (return nx)} + changeSym $ SymbolT.V vsym.{expr = Just (return nx)} | otherwise = stio () -closedLambdaSym sym = do - g <- getST - E.fatal sym.pos (text ("closedLambdaSym no SymV : " ++ sym.nice g)) @@ -141,7 +138,7 @@ closedLambda (letex@Let{env,ex}) = do -- now we can lift harmless inner la nex <- replName sym.sid name ex return (env, nex) sonst -> do - changeSym sym.{expr = Just (return ndef)} + changeSym $ SymbolT.V sym.{expr = Just (return ndef)} return (qn:env, ex) else return (qn:env, ex) sonst -> return (qn:env, ex) diff --git a/frege/compiler/passes/Imp.fr b/frege/compiler/passes/Imp.fr index 52200bb8..9ed6f287 100644 --- a/frege/compiler/passes/Imp.fr +++ b/frege/compiler/passes/Imp.fr @@ -47,6 +47,8 @@ import Data.TreeMap as TM(TreeMap, keys, insert, insertWith, each, values, looku import Data.List as DL(sortBy, zipWith4) import Data.Bits(BitSet.BitSet) +import frege.compiler.common.Lens () + import Compiler.enums.Flags import Compiler.enums.TokenID(CONID, VARID, defaultInfix, ROP4) import Compiler.enums.Visibility @@ -124,7 +126,7 @@ importAlways = [ ImpDcl {pos=Position.null, pack=Pack.raw p, as=Just n, imports --- Add an --- > import frege.Prelude --- unless there is an explicit import already or this is a prelude package. -importsFor :: Global -> [DefinitionS] +importsFor :: Global -> [ImpDcl] importsFor g = if noPreludeNeeded then imports else fakePreludeImport : imports @@ -138,7 +140,7 @@ importsFor g = if noPreludeNeeded imports = if isOff g.options.flags INPRELUDE then importAlways ++ importDefs else importDefs - importDefs = [ imp | imp@ImpDcl{} <- g.sub.sourcedefs ] + importDefs = [ imp | DefinitionS.Imp imp <- g.sub.sourcedefs ] -- import frege.Prelude fakePreludeImport = ImpDcl {pos=Position.null, pack=Pack.raw pPrelude, @@ -150,7 +152,7 @@ dependsOn g = [ Pack.new pack | ImpDcl{pack} <- importsFor g ] --- Find the java classes mentioned in the definitions dependsOnNative ∷ Global → [Pack] -dependsOnNative g = [ Pack.new jclas | JavDcl{name, isPure, jclas} ← g.definitions, +dependsOnNative g = [ Pack.new jclas | DefinitionS.Jav JavDcl{jclas} <- g.definitions, jclas `notElem` G.primitiveTypes, jclas `notElem` keys G.shortClassName, not (jclas.startsWith "java."), -- avoid JDK classes @@ -177,16 +179,15 @@ doImports = do mark the namespace as used, so as to avoid "unused import" messages. -} -useIfPublic :: DefinitionS -> StIO () +useIfPublic :: ImpDcl -> StIO () useIfPublic (imp@ImpDcl {pos,imports}) = do g <- getSTT let pack = Pack.new imp.pack as = maybe pack.nsName NSX imp.as when (imports.publik || any _.publik imports.items) do changeSTT _.{sub <- _.{nsUsed <- insert as ()}} -useIfPublic _ = return () -importHere :: DefinitionS -> StIO () +importHere :: ImpDcl -> StIO () importHere (imp@ImpDcl {pos,imports}) = do g <- getSTT let pack = Pack.new imp.pack @@ -225,7 +226,6 @@ importHere (imp@ImpDcl {pos,imports}) = do Just env -> importEnvSilent pos env as pack imports Nothing -> E.fatal pos (text ("module " ++ g.unpack pack ++ " should be here?")) stio () -importHere d = liftStG $ E.fatal d.pos (text ("must be an import definition, not " ++ show (constructor d))) --- Avoid warnings when we resolve items in the imported package @@ -246,19 +246,18 @@ importEnv pos env ns pack (imp@Imports {except=true, items}) = do let xs = [ withNS ns.unNS (ImportItem.name e) | e <- items ] exss <- mapSt (resolve (VName g.thisPack) pos) xs let exs = fold (++) [] exss - nitems = [ protoItem.{ name = Simple pos.first.{tokid=VARID, value=(Symbol.name sym).base}, + nitems = [ protoItem.{ name = Simple pos.first.{tokid=VARID, value=sym.name.base}, members = nomem csym, - alias = (Symbol.name sym).base} | + alias = sym.name.base} | sym <- sortBy (comparing constructor) (values env), -- place SymL before SymC - csym <- (g.findit sym.name), - not (Symbol.{cid?} csym) -- no constructors - || (Symbol.name sym).base != (Symbol.name csym).base, -- except renamed ones - Symbol.name csym `notElem` exs, - Symbol.vis sym == Public + csym <- g.findit sym.name, + not (Lens.has SymbolT._D csym) -- no constructors + || sym.name.base != csym.name.base, -- except renamed ones + csym.name `notElem` exs, + sym.vis == Public ] - nomem (SymC {}) = Just [] - -- nomem (SymT {}) = Just [] - nomem _ = Nothing + nomem (SymbolT.C _) = Just [] + nomem _ = Nothing importEnv pos env ns pack imp.{except=false, items=nitems} --- A public import list is equivalent to one without public but public specified for all items. @@ -268,7 +267,8 @@ importEnv pos env ns pack (imp@Imports {publik=true, items}) importEnv pos env ns pack (Imports {items}) = foreach items (linkItem ns.unNS pack) --- a symbolic link is dereferenced and the link goes to the target -linkHere ns pack (item@Item {alias=itema}) (link@SymL {name, alias}) = do +linkHere :: String -> Pack -> ImportItem -> Symbol -> StG () +linkHere ns pack (item@Item {alias=itema}) (SymbolT.L (link@SymL {name, alias})) = do let pos = Pos item.name.id item.name.id g <- getST case g.findit alias of @@ -286,7 +286,7 @@ linkHere ns pack (item@Item {publik,name,members,alias=newn}) sym = do let conid = (newn.charAt 0).isUpperCase conidOk | TName _ _ <- sym.name = true - | SymD {} <- sym = true + | SymbolT.D _ <- sym = true | otherwise = false vis = if publik then Public else Private g <- getST @@ -304,7 +304,7 @@ linkHere ns pack (item@Item {publik,name,members,alias=newn}) sym = do _ | newn == sym.name.base || conid == conidOk = linkqvp (VName g.thisPack newn) sym vis pos -- allow variables that link to constructors - | SymD{} <- sym, !conid = linkqvp (VName g.thisPack newn) sym vis pos + | SymbolT.D _ <- sym, !conid = linkqvp (VName g.thisPack newn) sym vis pos | otherwise = do E.error pos (msgdoc ("Alias for " ++ nice sym g ++ " must be a " ++ (if conidOk then "constructor" else "variable") @@ -324,23 +324,23 @@ linkHere ns pack (item@Item {publik,name,members,alias=newn}) sym = do errors case sym of - SymT {env} + SymbolT.T SymT{env} | Nothing <- members = do -- link constructors also let cons = [ item.{name <- (pos.first.{tokid=CONID, value=mem.name.base} `qBy`), members = Nothing, alias = mem.name.base, publik = false} - | mem@SymD {} <- values env, mem.vis == Public ] + | SymbolT.D mem <- values env, mem.vis == Public ] foreach cons (linkItem ns pack) | Just ms <- members = do let nms = map ImportItem.{name <- (`qBy` item.name) • SName.id} ms foreach nms (linkItem ns pack) - SymC {env} + SymbolT.C symc | Nothing <- members = do -- link class methods - let meth = [ item.{name <- (pos.first.{tokid=VARID, value=sym.name.base} `qBy`), - members = Nothing, alias = sym.name.base} - | sym@SymV {vis} <- values env, + let meth = [ item.{name <- (pos.first.{tokid=VARID, value=name.base} `qBy`), + members = Nothing, alias = name.base} + | SymMeth.V SymV{vis, name} <- values symc.meth, vis == Public || vis == Abstract, - not (defined sym.name.base) ] -- import only yet undefined class members + not (defined name.base) ] -- import only yet undefined class members -- here = g.thisTab defined s = isJust (g.find (VName g.thisPack s)) foreach meth (linkItem ns pack) @@ -360,7 +360,7 @@ linkItem ns pack (item@Item {publik,name,members,alias}) = do [] -> stio () -- got error message from resolve or excluded [sym] -> linkHere ns pack item sym syms -- look for a type name - | (tsym:_) <- [ x | x <- syms, TName{} <- Just x.name] + | (tsym:_) <- [ x | x <- syms, TName{} <- Just x.name] = linkHere ns pack item tsym | otherwise = do -- by taking the first result, we resolve NS.x linkHere ns pack item (head syms) @@ -477,6 +477,12 @@ importClassData pos why pack = do tarray = arrayCache rebuildTau fp.taus.length rebuildTau n t = tauFromA karray (karray.[n]) t nTau i = elemAt tarray i + -- TVars are encoded as Tau + nTVar i = case nTau i of + TauT.Var v -> v + -- @nTau i@ should return TVar unless annotations are corrupted, so + -- this error never occurs in a normal case + _ -> error "nTVar: got non-TVar" -- Kinds -- karray = arrayCache rebuildKind fp.kinds.length @@ -503,16 +509,16 @@ importClassData pos why pack = do let strMB "" = Nothing strMB s = Just s - let rbSymA n = SymA {sid=0, pos=mkpos sym.offset sym.name.base, vis, + let rbSymA n = SymbolT.A SymA{sid=0, pos=mkpos sym.offset sym.name.base, vis, doc = strMB sym.doc, name = rebuildQN sym.name, typ = nSigma sym.typ, kind = nKind sym.kind, - vars = [ nTau varn | varn <- listFromArray sym.vars]} + vars = [ nTVar varn | varn <- listFromArray sym.vars]} where sym = elemAt fp.symas n vis = if sym.publik then Public else Protected rbSymV :: CT.SymVArr -> Int -> Symbol - rbSymV arr n = SymV {sid=0, pos=mkpos sym.offset sym.name.base, vis=v, doc=strMB sym.doc, + rbSymV arr n = SymbolT.V SymV{sid=0, pos=mkpos sym.offset sym.name.base, vis=v, doc=strMB sym.doc, name = rebuildQN sym.name, typ = nSigma sym.sig, pur = sym.pur, nativ = if sym.nativ == "" then Nothing else Just sym.nativ, expr = rbExpr sym.expr, @@ -521,12 +527,12 @@ importClassData pos why pack = do depth = sym.depth, rkind = BitSet{set=fromInt sym.rkind}, throwing = [ nTau tau | tau <- listFromArray sym.throwing], over = map rebuildQN (toList sym.over), - gargs = map nTau (listFromArray sym.gargs), + gargs = map nTVar (listFromArray sym.gargs), op = if sym.op == 0 then defaultInfix else from sym.op} where sym = elemAt arr n v = if sym.abst then Abstract else if sym.publik then Public else Protected rbSymD :: CT.SymDArr -> Int -> Symbol - rbSymD arr n = SymD {sid=0, pos=mkpos sym.offset sym.name.base, vis, doc=strMB sym.doc, + rbSymD arr n = SymbolT.D SymD{sid=0, pos=mkpos sym.offset sym.name.base, vis, doc=strMB sym.doc, name = rebuildQN sym.name, cid = sym.cid, typ = nSigma sym.typ, flds = map mkfield fields, @@ -546,17 +552,17 @@ importClassData pos why pack = do vis = if sym.priv then Private else if sym.publik then Public else Protected rbSymL :: CT.SymLArr -> Int -> Symbol - rbSymL arr n = SymL {sid=0, pos=mkpos sym.offset sym.name.base, vis, -- doc=strMB sym.doc, + rbSymL arr n = SymbolT.L SymL{sid=0, pos=mkpos sym.offset sym.name.base, vis, -- doc=strMB sym.doc, name = rebuildQN sym.name, alias = rebuildQN sym.alias} where sym = elemAt arr n vis = if sym.publik then Public else Protected rbSymC :: CT.SymC -> Symbol - rbSymC sym = SymC {sid=0, pos=mkpos sym.offset sym.name.base, vis, doc=strMB sym.doc, + rbSymC sym = SymbolT.C SymC{sid=0, pos=mkpos sym.offset sym.name.base, vis, doc=strMB sym.doc, name = rebuildQN sym.name, - tau = nTau sym.tau, + clvar = nTVar sym.tau, supers = sups, insts = zip ins1 ins2, - env = empty} + meth = empty} where ins1 = mapqs sym.ins1 ins2 = mapqs sym.ins2 @@ -568,18 +574,18 @@ importClassData pos why pack = do foreach (enumFromTo 0 (sym.funs.length-1)) (enter • rbSymV sym.funs) foreach (enumFromTo 0 (sym.lnks.length-1)) (enter • rbSymL sym.lnks) rbSymI :: CT.SymI -> Symbol - rbSymI sym = SymI {sid=0, pos=mkpos sym.offset sym.name.base, + rbSymI sym = SymbolT.I SymI{sid=0, pos=mkpos sym.offset sym.name.base, vis=Public, doc=strMB sym.doc, name = rebuildQN sym.name, clas = rebuildQN sym.clas, typ = nSigma sym.typ, - env = empty} + meth = empty} rebuildInst n = do let sym = elemAt fp.symis n enter (rbSymI sym) foreach (enumFromTo 0 (sym.funs.length-1)) (enter • rbSymV sym.funs) foreach (enumFromTo 0 (sym.lnks.length-1)) (enter • rbSymL sym.lnks) - rbSymT :: CT.SymT -> Symbol + rbSymT :: CT.SymT -> SymT Global rbSymT sym = SymT {sid=0, pos=mkpos sym.offset sym.name.base, vis = if sym.publik then Public else Protected, doc=strMB sym.doc, name = rebuildQN sym.name, @@ -587,12 +593,12 @@ importClassData pos why pack = do nativ = if sym.nativ == "" then Nothing else Just sym.nativ, pur = sym.pur, newt = sym.newt, kind = nKind sym.kind, - gargs = map nTau (listFromArray sym.gargs), + gargs = map nTVar (listFromArray sym.gargs), env = empty} rebuildTyp n = do let sym = elemAt fp.symts n let rsym = rbSymT sym - enter rsym + enter $ SymbolT.T rsym foreach (enumFromTo 0 (sym.cons.length-1)) (enter • rbSymD sym.cons) foreach (enumFromTo 0 (sym.funs.length-1)) (enter • rbSymV sym.funs) foreach (enumFromTo 0 (sym.lnks.length-1)) (enter • rbSymL sym.lnks) @@ -631,53 +637,61 @@ preludeBasics = do let unitT = TName pPreludeBase "()" unitC = MName unitT "()" unitCA = VName pPreludeBase "()" - unitTy = ForAll [] (RhoTau [] (TCon Position.null unitT)) + unitTy = ForAll [] $ RhoT.Tau $ RhoTau [] $ TauT.Con TCon{pos=Position.null, name=unitT} -- sigmaRhoTau xs t = ForAll xs (RhoTau [] t) - enter (SymT {name = unitT, typ=unitTy, env = empty, nativ = Nothing, + enter $ SymbolT.T + (SymT {name = unitT, typ=unitTy, env = empty, nativ = Nothing, product = true, enum = true, pur = false, newt = false, kind = KType, gargs = [], sid=0, pos=Position.null, vis=Public, doc=Just "Unit type"}) - enter (SymD {name = unitC, typ=unitTy, flds = [], cid = 0, + enter $ SymbolT.D + (SymD {name = unitC, typ=unitTy, flds = [], cid = 0, sid=0, pos=Position.null, vis=Public, doc=Just "Unit value", op = defaultInfix, strsig = U}) - enter (SymL {name = unitCA, alias = unitC, + enter $ SymbolT.L + (SymL {name = unitCA, alias = unitC, sid=0, pos=Position.null, vis=Public}) -- [], a:as let listT = TName pPreludeBase "[]" listNil = MName listT "[]" listCons = MName listT ":" - va = TVar Position.null KType "a" - vb = TVar Position.null KType "b" - listRho = RhoTau [] (TApp (TCon Position.null listT) va) + va = TVar{pos=Position.null, kind=KType, var="a"} + vb = TVar{pos=Position.null, kind=KType, var="b"} + listRho = RhoT.Tau $ RhoTau [] (TApp (TauT.Con TCon{pos=Position.null, name=listT}) (TauT.Var va)) listTy = ForAll [va] listRho - consTy = ForAll [va] (RhoFun [] - (ForAll [] (RhoTau [] va)) - (RhoFun [] - (ForAll [] listRho) - listRho)) + consTy = ForAll [va] $ RhoT.Fun + $ RhoFun [] + (ForAll [] $ RhoT.Tau $ RhoTau [] $ TauT.Var va) + (RhoT.Fun $ RhoFun [] (ForAll [] listRho) listRho) -- tuples - enter (SymT {name = listT, typ = listTy, env = empty, nativ = Nothing, + enter $ SymbolT.T + (SymT {name = listT, typ = listTy, env = empty, nativ = Nothing, product = false, enum = false, pur = false, newt = false, kind = Kind.unary, gargs = [], sid=0, pos=Position.null, vis=Public, doc=Just "list type"}) - enter (SymD {name = listNil, typ = listTy, flds = [], cid=0, + enter $ SymbolT.D + (SymD {name = listNil, typ = listTy, flds = [], cid=0, sid=0, pos=Position.null, vis=Public, doc=Just "empty list", op = defaultInfix, strsig = U}) - enter (SymD {name = listCons, typ = consTy, cid=1, - flds = [ aField false (ForAll [] (RhoTau [] va)), + enter $ SymbolT.D + (SymD {name = listCons, typ = consTy, cid=1, + flds = [ aField false (ForAll [] (RhoT.Tau $ RhoTau [] (TauT.Var va))), aField false (ForAll [] listRho)], sid=0, pos=Position.null, vis=Public, doc=Just "list construction", op = ROP4, strsig = U}) - enter (SymL {name = VName pPreludeBase "[]", alias = listNil, + enter $ SymbolT.L + (SymL {name = VName pPreludeBase "[]", alias = listNil, sid=0, pos=Position.null, vis=Public}) - enter (SymL {name = VName pPreludeBase ":", alias = listCons, + enter $ SymbolT.L + (SymL {name = VName pPreludeBase ":", alias = listCons, sid=0, pos=Position.null, vis=Public}) foreach (enumFromTo 2 26) (tupletype false) -- -> - let funTy = ForAll [va, vb] (RhoTau [] (Tau.tfun va vb)) + let funTy = ForAll [va, vb] (RhoT.Tau $ RhoTau [] (Tau.tfun (TauT.Var va) (TauT.Var vb))) funT = TName pPreludeBase "->" - enter (SymT {name = funT, typ = funTy, env = empty, nativ = Nothing, + enter $ SymbolT.T + (SymT {name = funT, typ = funTy, env = empty, nativ = Nothing, product = false, enum = false, kind = Kind.fun, gargs = [], pur = false, newt = false, sid=0, pos=Position.null, @@ -692,25 +706,28 @@ preludeBasics = do tuple n = "(" ++ packed (take (n-1) commas) ++ ")" tupletype strict n = do let name = tuple n -- "(,)" - tvs = take n tvars -- TVar 1 "a", TVar 1 "b", ... + tvs = map TauT.Var $ take n tvars -- TVar 1 "a", TVar 1 "b", ... -- vs = take n vars -- "a", "b", ... vks = take n varks -- (a::*, b::*, c::*, ....) - sigmas = map (ForAll [] • RhoTau []) tvs -- ForAll (RhoTau (TVar 1 "a")), ... + sigmas = map (ForAll [] . RhoT.Tau . RhoTau []) tvs -- ForAll (RhoTau (TVar 1 "a")), ... flds = map (aField strict) sigmas -- (Nothing, a), (Nothing, b) tupleT = TName pPreludeBase name -- Prelude.(,) tupleC = MName tupleT name -- Prelude.(,).(,) - tupleRho = RhoTau [] (Tau.mkapp (TCon Position.null tupleT) tvs) -- (a,b,...) + tupleRho = RhoT.Tau $ RhoTau [] (Tau.mkapp (TauT.Con TCon{pos=Position.null, name=tupleT}) tvs) -- (a,b,...) tupleSig = ForAll vks tupleRho -- forall a b....(a,b, ...) - conRho = foldr (RhoFun []) tupleRho sigmas -- a -> b -> ... -> (a,b, ...) - enter (SymT {name = tupleT, typ = tupleSig, env = empty, nativ = Nothing, + conRho = foldr (\sigma rho -> RhoT.Fun RhoFun{context=[], sigma, rho}) tupleRho sigmas -- a -> b -> ... -> (a,b, ...) + enter $ SymbolT.T + (SymT {name = tupleT, typ = tupleSig, env = empty, nativ = Nothing, product = true, enum = false, kind = Kind.kind n, sid=0, pos=Position.null, vis=Public, doc=Just (show n ++ "-tuple"), pur = false, newt = false, gargs = []}) - enter (SymD {name = tupleC, typ = ForAll vks conRho, flds = flds, cid=0, + enter $ SymbolT.D + (SymD {name = tupleC, typ = ForAll vks conRho, flds = flds, cid=0, sid=0, pos=Position.null, vis=Public, doc=Just (show n ++ "-tuple constructor"), op = defaultInfix, strsig = U}) - enter (SymL {name = VName pPreludeBase name, alias = tupleC, + enter $ SymbolT.L + (SymL {name = VName pPreludeBase name, alias = tupleC, sid=0, pos=Position.null, vis=Public}) -mvar :: Tau -mvar = TVar Position.null KType "" +mvar :: TVar a +mvar = TVar{pos=Position.null, kind=KType, var=""} diff --git a/frege/compiler/passes/Instances.fr b/frege/compiler/passes/Instances.fr index 82c3c0cb..3f887160 100644 --- a/frege/compiler/passes/Instances.fr +++ b/frege/compiler/passes/Instances.fr @@ -25,7 +25,7 @@ import Compiler.types.AbstractJava(rawName) import Compiler.common.Errors as E() import Compiler.common.Resolve as R(defaultXName) --- import Compiler.common.SymbolTable as ST(linkq) +import Compiler.common.Lens (set) import Compiler.classes.Nice import frege.compiler.Utilities as U(vSym) @@ -39,18 +39,22 @@ import frege.compiler.gen.java.Common(sigmaJT) -} pass () = do g <- getST - let insdrv = filter isInstOrDerive g.sub.sourcedefs + -- filter sourcedefs to @Either InsDcl DrvDcl@ in a way the ordering is preserved + let insdrv = flip mapMaybe g.sub.sourcedefs $ \d -> + case d of + DefinitionS.Ins ins -> Just $ Left ins + DefinitionS.Drv drv -> Just $ Right drv + otherwise -> Nothing normal = filter (not • isInstOrDerive) g.sub.sourcedefs - derived <- mapSt deriveInst insdrv + derived <- mapSt (fmap DefinitionS.Ins . either pure deriveInst) insdrv enter (VName g.thisPack) derived -- change state so that derived instances will be transdef'ed later changeST Global.{sub <- SubSt.{sourcedefs = normal ++ derived}} stio ("instances", length derived) ---- make an instance definition from a derive definition, identity for instance definitions -deriveInst :: DefinitionS -> StG DefinitionS -deriveInst (d@InsDcl {pos}) = return d -deriveInst (d@DrvDcl {pos}) = do +--- make an instance definition from a derive definition +deriveInst :: DrvDcl -> StG InsDcl +deriveInst (d@DrvDcl{pos}) = do g <- getST clas <- defaultXName pos (TName pPreludeBase "Eq") d.clas typ <- U.transSigma d.typ @@ -63,7 +67,7 @@ deriveInst (d@DrvDcl {pos}) = do dcls <- deriveDcls pos clas sym ctrs d.typ.rho -- dtyp <- withDerivedContext pos d.typ d.clas return idcl.{defs=dcls, typ=withDerivedContext pos d.typ d.clas clas} - Just sym -> do + Just _ -> do E.error pos (msgdoc ("Can't derive " ++ clas.nice g ++ " (" ++ typ.nice g ++ "), type has no constructors")) stio idcl @@ -77,33 +81,29 @@ deriveInst (d@DrvDcl {pos}) = do withDerivedContext pos (ForAll [] rho) klasse qname | TName ppp base <- qname, base `notElem` derivable = ForAll [] rho - | null rho.context = ForAll [] rho.{context} + | null rho.context = ForAll [] $ set RhoT._context context rho where - context = [ Ctx pos klasse (TVar pos KVar v) | v <- U.freeTVnames [] rho ] + context = [ Ctx pos klasse (TauT.Var TVar{pos, kind=KVar, var}) | var <- U.freeTVnames [] rho ] withDerivedContext pos sigma _ _ = sigma -deriveInst d = do - E.fatal d.pos (text ("deriveInst got definition with constructor " - ++ show (constructor d))) - --- List of derivable classes --- Note that special classes like 'Exceptional' and 'JavaType' are not listed here. --- This controls also whether type variables in the instance type must have the same class membership. derivable = ["Hashable", "Eq", "Ord", "Enum", "Bounded", "Show", "Exceptional"] --- arity of a constructor -arity ∷ Symbol → Int -arity sym = length (Symbol.flds sym) +arity :: SymD Global -> Int +arity sym = length sym.flds -deriveClass :: Position → QName → Symbol → [Symbol] → RhoT SName -> Global → String → [DefinitionS] +deriveClass :: Position -> QName -> SymT Global -> [SymD Global] -> RhoT SName -> Global -> String -> [DefinitionS] deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive where con = head ctrs isEnum ∷ Bool isEnum = all (0==) (map arity ctrs) -- displayed name of a constructor - cname ∷ Symbol → SName - cname sym = case Symbol.name sym of + cname :: SymD Global -> SName + cname sym = case sym.name of MName tn base -> With1 pos.first.{tokid=CONID, value=tn.base} pos.first.{tokid=CONID, value=base} _ -> error "constructor must be a member" @@ -112,7 +112,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive subpats c = subvars c -- [ var (c ++ show a) | a <- enumFromTo 1 1000 ] subvars c = [ var (c ++ show a) | a <- enumFromTo 1 1000 ] -- construct pattern Con s1 s2 s3 ... sn - conpat :: Symbol -> String -> ExprS + conpat :: SymD Global -> String -> ExprS conpat con s = Term app -- PCon {qname=cname con, pos=pos.change QCONID con.name.base, pats} where app = fold App Con{name=cname con} pats @@ -191,7 +191,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive -- construct "show v" showit v = vShow `nApp` v -- type constructor for 'Class' - pClass = TCon{pos, name = With1 baseToken pos.first.{tokid=CONID, value="Class"}} + pClass = TauT.Con TCon{pos, name = With1 baseToken pos.first.{tokid=CONID, value="Class"}} hash = Case CNormal varg1 halts halts = map hashalt ctrs hashalt con = calt p hashex @@ -204,11 +204,12 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive hfun a b = mkop (mkop (int 31) opMul a) opAdd b hashex = fold hfun (int 1) (c:hs) + deriveClass :: String -> [DefinitionS] -- derive Hashable - deriveClass "Hashable" = [publicfun "hashCode" [parg1] hash] + deriveClass "Hashable" = [DefinitionS.Fun $ publicfun "hashCode" [parg1] hash] -- derive Eq - deriveClass "Eq" = [publicfun "==" [parg1,parg2] ifx, publicfun "hashCode" [parg1] hash] where + deriveClass "Eq" = map DefinitionS.Fun [publicfun "==" [parg1,parg2] ifx, publicfun "hashCode" [parg1] hash] where ifx = if length ctrs == 1 then eex else Ifte cond eex vFalse eex = if isEnum then vTrue else Case CNormal (vtup varg1 varg2) alts alts = map mkequalalt ctrs ++ deflt @@ -232,10 +233,10 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive andit (x:xs) = nApp (nApp (gvar "PreludeBase" "&&") x) (andit xs) -- derive Ord deriveClass "Ord" - | [prod] <- ctrs = [publicfun "<=>" + | [prod] <- ctrs = [DefinitionS.Fun $ publicfun "<=>" [conpat prod "a", conpat prod "b"] (ordex (arity prod) 0)] - | otherwise = [publicfun "<=>" [parg1, parg2] outercase] + | otherwise = [DefinitionS.Fun $ publicfun "<=>" [parg1, parg2] outercase] where --* case a1 <=> b1 of { Eq -> case a2 <=> b2 of { ... ordex a n @@ -270,17 +271,17 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive sex = Case CNormal (var "r") [(mktupshowalt con)] show = publicfun "show" [var "r"] sex -- showsub = publicfun "showsub" [] (var "show") - in [show] + in [DefinitionS.Fun show] | otherwise = let sex = Case CNormal (var "r") (mkshowalts ctrs) subex = Case CNormal (var "r") (mkshowsubalts ctrs) show = publicfun "show" [var "r"] sex showsub = publicfun "showsub" [var "r"] subex - in [show, showsub] + in map DefinitionS.Fun [show, showsub] where mkshowalts constr = map mkshowalt constr mkshowsubalts constr = map mkshowsubalt constr - mkshowalt :: Symbol -> CAltS + mkshowalt :: SymD Global -> CAltS mkshowalt con = calt (conpat con "a") sx where scon = string (con.name.base) @@ -306,7 +307,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive joinit s [v] = showsv s v ")" joinit s (a:b:c) = joinit (showsv s a ", ") (b:c) - deriveClass "Enum" = [ord, from, succ, pred, + deriveClass "Enum" = map DefinitionS.Fun [ord, from, succ, pred, eFromThenTo, eFromThen] -- , eq] where -- eq = publicfun "==" [pvar "a", pvar "b"] eqex @@ -321,7 +322,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive -- eqex = (opEq `nApp` -- ((var "<=>" `nApp` var "a") `nApp` var "b")) `nApp` -- pEq - ctup = sortBy (comparing Symbol.cid) ctrs + ctup = sortBy (comparing SymD.cid) ctrs ctdn = reverse ctup max = Con {name=cname (head ctdn)} min = Con {name=cname (head ctup)} @@ -334,7 +335,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive msg = (string (forty.name.nice g) `mkapp` string ".from ") `mkapp` showit (var "r") -- "X" ++ ".from " ++ show r - fromalt ctr = calt (int (Symbol.cid ctr)) (Con {name=cname ctr}) + fromalt ctr = calt (int (SymD.cid ctr)) (Con {name=cname ctr}) mkalts s [x] = [calt (conpat x "_") (nApp vError (string (s ++ show (cname x))))] mkalts s (x:y:zs) = calt (conpat x "_") (Con {name=cname y}) : mkalts s (y:zs) mkalts s [] = [] @@ -345,9 +346,9 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive | otherwise = singleton min eFTex = fold nApp (var "enumFromThenTo") [varg1, varg2, minmax] - deriveClass "Bounded" = [minval, maxval] + deriveClass "Bounded" = map DefinitionS.Fun [minval, maxval] where - ctup = sortBy (comparing Symbol.cid) ctrs + ctup = sortBy (comparing SymD.cid) ctrs ctdn = reverse ctup min = Con {name=cname (head ctup)} max = Con {name=cname (head ctdn)} @@ -355,14 +356,15 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive minval = publicfun "minBound" [] min deriveClass "Exceptional" = [ + DefinitionS.Nat $ NatDcl{pos, vis=Public, name="javaClass", - txs = [(ForAll [] (RhoTau [] tapp), [])], - meth = fromMaybe (rawName jt) forty.nativ ++ ".class", + txs = [(ForAll [] (RhoT.Tau (RhoTau [] tapp)), [])], + meth = fromMaybe (rawName jt) forty.nativ ++ ".class", isPure = true, gargs = Nothing, doc = Nothing}] where tapp = TApp pClass this - this | RhoTau{tau} <- instrho = tau + this | RhoT.Tau r <- instrho = r.tau | otherwise = error ("Cannot derive for non type: " ++ nicer forty g) jt = sigmaJT g forty.typ deriveClass "JavaType" = deriveClass "Exceptional" @@ -370,7 +372,7 @@ deriveClass pos clas forty ctrs instrho g toderive = deriveClass toderive deriveClass s = error ("can't deriveClass " ++ s) -deriveDcls :: Position -> QName -> Symbol -> [Symbol] -> RhoT SName -> StG [DefinitionS] +deriveDcls :: Position -> QName -> SymT Global -> [SymD Global] -> RhoT SName -> StG [DefinitionS] deriveDcls pos clas forty ctrs instrho = do g <- getST -- E.logmsg TRACE4 pos (text ("derive " ++ QName.nice clas g ++ " for " ++ Symbol.nice forty g)) diff --git a/frege/compiler/passes/LetUnroll.fr b/frege/compiler/passes/LetUnroll.fr index 44cef1a1..e0fd1181 100644 --- a/frege/compiler/passes/LetUnroll.fr +++ b/frege/compiler/passes/LetUnroll.fr @@ -47,24 +47,20 @@ pass = do stio ("symbols", 3 * length collectedvars) -unrollSym (vsym@SymV {pos}) +unrollSym :: SymV Global -> StG () +unrollSym vsym | Just x <- vsym.expr = do nx <- x >>= unrollExpr - changeSym vsym.{expr = Just (return nx)} + changeSym $ SymbolT.V vsym.{expr = Just (return nx)} | otherwise = stio () -- do nothing -unrollSym sym = do - g <- getST - E.fatal sym.pos (text ("unrollSym no SymV : " ++ sym.nice g)) -unLetSym (vsym@SymV {pos}) +unLetSym :: SymV Global -> StG () +unLetSym vsym | Just x <- vsym.expr = do nx <- x >>= unLetExpr - changeSym vsym.{expr = Just (return nx)} + changeSym $ SymbolT.V vsym.{expr = Just (return nx)} | otherwise = stio () -- do nothing -unLetSym sym = do - g <- getST - E.fatal sym.pos (text ("unLetSym no SymV : " ++ sym.nice g)) unrollExpr = U.mapEx true unrollLet @@ -79,7 +75,7 @@ unrollLet (x@Let {env,ex}) = do -- first do the subexpressions let mapsub (sy@SymV {expr=Just x}) = do x <- x >>= unrollExpr - changeSym sy.{expr=Just (return x)} + changeSym $ SymbolT.V sy.{expr=Just (return x)} mapsub sy = error "mapsub: no var" ex <- unrollExpr ex syms <- mapSt U.findV env @@ -138,9 +134,9 @@ unusedLet (x@Let {env,ex}) = do then do syms <- mapSt U.findV env g <- getST - foreach syms (\(sym::Symbol) -> + foreach syms (\sym -> unless (sym.name.base ~ ´^_´) do - E.hint (getrange sym) (msgdoc ( + E.hint (getrange $ SymbolT.V sym) (msgdoc ( nicer sym g ++ " is not used anywhere.")) ) stio (Left ex) @@ -153,65 +149,54 @@ unLet (x@Let {env,ex}) | length env > 1 = do vals <- mapSt U.findV env g <- getST - if (any Symbol.anno vals) + if (any _.anno vals) then unLetMutual g vals x else return (Left x) where - unLetMutual :: Global -> [Symbol] -> Expr -> StG (Either Expr Expr) + unLetMutual :: Global -> [SymV Global] -> Expr -> StG (Either Expr Expr) unLetMutual g vals (x@Let {env,ex}) = do freevbls <- toPass case freevbls of [] -> do gsyms <- mapSt globalize vals - foreach gsyms enter + foreach gsyms (enter . SymbolT.V) let vgs = zip vals gsyms syms <- mapSt (mkGlobal vgs) vgs newlet <- foldSt replsym ex vgs E.logmsg TRACE7 pos (text ("changed " ++ nice newlet g)) - foreach syms changeSym - foreach (map Symbol.name syms) unLetName + foreach syms (changeSym . SymbolT.V) + foreach (map _.name syms) unLetName stio (Left newlet) - xs -> do - -- let part1 = msgdoc ("implementation restriction: mutual recursive local functions" - -- ++ " that use variables bound in enclosing lexical scopes" - -- ++ " are currently not supported.") - -- part2 = text "functions: " <+> sep "," (map (text • flip nicer g • Symbol.name) vals) - -- part3 = text "variables: " <+> sep "," (map (text • flip nicer g • Symbol.name) freevbls) - -- part4 = text "There are two possible workarounds:" - -- part5 = text "- If possible, make" <+> lit (length vals - 1) <+> text "functions local to the remaining one." - -- part6 = text "- Pass the variables as arguments." - -- E.error (getpos x) (part1 nest 4 (part2 part3 part4 part5 part6)) - stio (Left x) + _ -> stio (Left x) where pos = getpos x exprs :: [Expr] - exprs = map (unJust • flip Symbol.gExpr g) vals + exprs = map (unJust . flip SymV.gExpr g) vals - freeSym :: Expr -> StG [Symbol] -- free variables in expression + freeSym :: Expr -> StG [SymV Global] -- free variables in expression freeSym x = do used <- U.localSyms x inner <- innerSids x let uids = filter (not • (inner `contains`)) (keys used) - mapSt U.findV [ Local uid "_" | uid <- uids ] - + mapSt U.findV [ Local uid "_" | uid <- uids ] - toPass :: StG [Symbol] -- symbols we must pass to each global val + toPass :: StG [SymV Global] -- symbols we must pass to each global val toPass = do exsyms <- mapSt freeSym exprs - stio ((uniq • sort) [ s | ss <- exsyms, s <- ss, s `notElem` vals ]) + stio $ (uniq . sort) [ s | ss <- exsyms, s <- ss, s `notElem` vals ] - globalize :: Symbol -> StG Symbol + globalize :: SymV Global -> StG (SymV Global) globalize sym = do g <- getST let name = U.unusedName (VName (Global.thisPack g) (sym.name.base)) g stio sym.{name, sid=0, expr = Nothing, vis = Private} - replsym :: Expr -> (Symbol, Symbol) -> StG Expr + replsym :: Expr -> (SymV Global, SymV Global) -> StG Expr replsym x (sym,gsym) = replName sym.sid gsym.name x - mkGlobal :: [(Symbol, Symbol)] -> (Symbol,Symbol) -> StG Symbol + mkGlobal :: [(SymV Global, SymV Global)] -> (SymV Global, SymV Global) -> StG (SymV Global) mkGlobal vgs (sym,gsym) = do let ex = unJust (sym.gExpr g) ex <- foldSt replsym ex vgs @@ -252,14 +237,14 @@ unLet (xlet@Let {env=letenv,ex=letex,typ=lettyp}) let lamx = Lam {pat,ex,typ} let vks = U.freeTVars [] sym.typ.rho let typ = ForAll vks sym.typ.rho - enter sym.{sid = 0, name, expr = Just (return lamx), vis = Private, typ} + enter $ SymbolT.V sym.{sid = 0, name, expr = Just (return lamx), vis = Private, typ} changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk sym.pos.first) (Right name)}} E.logmsg TRACE7 sym.pos (text ("let " ++ nice x g ++ " = " ++ nice lamx g ++ " in ... replaced with " ++ nice letex2 g)) E.logmsg TRACE7 sym.pos (text ("new function is " ++ name.nice g)) unLet letex2 -- other opportunities possible here else do - changeSym sym.{expr = Just (return Lam{pat,ex,typ})} + changeSym $ SymbolT.V sym.{expr = Just (return Lam{pat,ex,typ})} letex <- U.mapEx true unLet letex stio (Right (Let {env=letenv,ex=letex,typ=lettyp})) -- a local non function stays local only if it uses other local symbols @@ -269,7 +254,7 @@ unLet (xlet@Let {env=letenv,ex=letex,typ=lettyp}) ulet <- U.mapEx true unLet letex cx <- U.mapEx true unLet cx let e = isSimple g cx - changeSym sym.{expr = Just (return cx)} + changeSym $ SymbolT.V sym.{expr = Just (return cx)} self <- references [sym.sid] cx down <- references [sym.sid] ulet -- E.logmsg TRACE7 sym.pos (text ("UNLET: " ++ nice x g @@ -301,7 +286,7 @@ unLet (xlet@Let {env=letenv,ex=letex,typ=lettyp}) letex2 <- replName sym.sid name ulet -- in the inner of the lambda or the let ex let vks = U.freeTVars [] sym.typ.rho let typ = ForAll vks sym.typ.rho - enter sym.{sid = 0, name, expr = Just (return ex), vis = Private, typ} + enter $ SymbolT.V sym.{sid = 0, name, expr = Just (return ex), vis = Private, typ} changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk sym.pos.first) (Right name)}} E.logmsg TRACE7 sym.pos (text ("let " ++ nice x g ++ " = " ++ nice cx g ++ " in ... replaced with " ++ nice letex2 g)) diff --git a/frege/compiler/passes/Strict.fr b/frege/compiler/passes/Strict.fr index 08279ebd..afb5dcbe 100644 --- a/frege/compiler/passes/Strict.fr +++ b/frege/compiler/passes/Strict.fr @@ -6,6 +6,7 @@ import frege.data.TreeMap as TM(TreeMap, TreeSet, lookup, insert, keys, value import frege.data.List as DL(uniq, sort, partitioned, elemBy) import frege.data.Bits(BitSet, BitSet.member, BitSet.union bitunion, BitSet.intersection, BitSet.difference) import frege.data.Graph(stronglyConnectedComponents tsort) +import frege.compiler.common.Lens (set) import frege.compiler.enums.Flags import frege.compiler.enums.TokenID(VARID) import frege.compiler.enums.RFlag @@ -54,7 +55,7 @@ pass = do -- bring default class methods in good shape g <- getST - let classmethods = [ sym | SymC{env} <- values g.thisTab, sym@SymV{expr = Just _} <- values env ] + let classmethods = [ sym | SymbolT.C SymC{meth} <- values g.thisTab, SymMeth.V (sym@SymV{expr = Just _}) <- values meth ] foreach classmethods easyClassMethodSym stio ("functions", length names) @@ -85,13 +86,13 @@ pass = do > anon a b = let c = b+1 in a c > method a' b' = anon a' b' -} -easyClassMethodSym :: Symbol -> StG () +easyClassMethodSym :: SymV Global -> StG () easyClassMethodSym (sym@SymV{expr = Just dx, typ}) = do x <- dx easy <- goodClassMethod x unless ( easy ) do g <- getST - U.symWarning E.warn sym (text (nice sym g + U.symWarning E.warn (SymbolT.V sym) (text (nice sym g ++ (if easy then "" else " is not easy enough ") ++ (if RSafeTC `member` sym.rkind then "" else " recurses deeply ") ++ (if RTailRec `member` sym.rkind then " is tail recursive " else ""))) @@ -102,9 +103,9 @@ easyClassMethodSym (sym@SymV{expr = Just dx, typ}) = do let anon = sym.{sid=0, name, vis = Protected, expr = Just (return nx)} vbl = Vbl{name, pos=anon.pos.change VARID name.base, typ=Just (ForAll [] sym.typ.rho)} rk = (sym.rkind.unionE RSafeTC).differenceE RTailRec - enter anon + enter $ SymbolT.V anon x <- etaExpand vbl - changeSym sym.{expr = Just (return x), rkind = rk} + changeSym $ SymbolT.V sym.{expr = Just (return x), rkind = rk} where -- goodClassMethod :: Expr -> StG Bool goodClassMethod x = do @@ -116,8 +117,6 @@ easyClassMethodSym (sym@SymV{expr = Just dx, typ}) = do Vbl{name=Local{}} -> return true Vbl{name} -> do vsym <- U.findV name - -- when (vsym.vis == Private) do - -- E.hint (getpos x) (text("uses private " ++ nice name g)) return (vsym.vis != Private) Con{name} -> return true -- constructors always exported Case{} -> do @@ -164,10 +163,11 @@ easyClassMethodSym sym = return () * Forward references can appear in global symbols which reference any global * value from this package. -} +returnKind :: [Int] -> SymV Global -> StG () returnKind syms (sym@SymV {nativ = Just _}) = do g <- getST -- jt <- U.isJavaType ((fst • U.returnType) sym.typ.rho) - changeSym sym.{rkind = RState.fromList [RSafeTC, RValue]} + changeSym $ SymbolT.V sym.{rkind = RState.fromList [RSafeTC, RValue]} returnKind syms (sym@SymV {expr = Just dx, depth = 0}) = do x <- dx @@ -206,7 +206,7 @@ returnKind syms (sym@SymV {expr = Just dx, depth = 0}) = do -- and force it right away in the eval() fun | stricter, local, self > 0 = false -- local self refs must be lazy | otherwise = stricter - changeSym sym.{rkind, strsig = stri} + changeSym $ SymbolT.V sym.{rkind, strsig = stri} returnKind syms (sym@SymV {expr = Just dx}) = do x <- dx @@ -226,23 +226,23 @@ returnKind syms (sym@SymV {expr = Just dx}) = do -- class functions must be RSafeTC case sym.name of MName inst base | Just symic <- g.findit inst = case symic of - SymC{} -> do + SymbolT.C _ -> do let nkind = classMemberState - changeSym sym.{rkind=nkind} - SymI{} -> do + changeSym $ SymbolT.V sym.{rkind=nkind} + SymbolT.I _ -> do cm <- classMethodOfInstMethod sym.pos inst base if cm.rkind.null then do returnKind [] cm returnKind syms sym else do -- let nkind = (xkind.differenceE RAlways).union cm.rkind - changeSym sym.{rkind = xkind} - other -> changeSym sym.{rkind = xkind} - other -> changeSym sym.{rkind = xkind} + changeSym $ SymbolT.V sym.{rkind = xkind} + _ -> changeSym $ SymbolT.V sym.{rkind = xkind} + _ -> changeSym $ SymbolT.V sym.{rkind = xkind} --- assume abstract class functions are tail call safe and return a value returnKind syms (sym@SymV {expr = Nothing, name = MName _ _}) - = changeSym sym.{rkind=classMemberState} + = changeSym $ SymbolT.V sym.{rkind=classMemberState} returnKind _ _ = stio () -- abstract methods @@ -272,6 +272,7 @@ defaultRKind = RState.fromList [RSafeTC, RValue] * it's lazy. * - Unsaturated applications are boxed (function types) -} +returnExprKind :: [Int] -> SymV Global -> ExprT -> StG RState returnExprKind syms sym (x@Lit {pos}) = stio defaultRKind returnExprKind syms sym (x@Con {pos}) = stio defaultRKind returnExprKind syms sym (x@Ann {ex}) = returnExprKind syms sym ex @@ -300,10 +301,10 @@ returnExprKind syms sym (ex@App a b typ) = do Vbl {name} -> do symf <- U.findV name g <- getST - let ari = if isJust symf.expr then symf.depth else U.arity symf + let ari = if isJust symf.expr then symf.depth else U.arity $ SymVal.V symf rwa = defaultRKind.intersection symf.rkind rw | MName tname _ <- symf.name, - Just SymC{} <- g.findit tname + Just (SymbolT.C _) <- g.findit tname = rwa.unionE RValue -- call class methods lazy | otherwise = rwa if isJust symf.nativ then stio (rw) @@ -315,7 +316,7 @@ returnExprKind syms sym (ex@App a b typ) = do _ -> stio (rw) -- global fun Just _ -> do g <- getST - if symf.sid == Symbol.sid sym -- self recursive + if symf.sid == sym.sid -- self recursive then stio (defaultRKind.unionE RTailRec) else if (symf.sid `elem` syms) then if isOn g.options.flags PROPERTC @@ -389,12 +390,12 @@ minRkind a b = (safetc.union tailbit).union wrbits where -} returnNames sids nms = do syms <- mapSt U.findV nms - let !deps = sids ++ map Symbol.sid syms + let !deps = sids ++ map _.sid syms foreach syms setsafetc foreach syms (returnKind deps) where - setsafetc :: Symbol -> StG () - setsafetc sym = changeSym sym.{rkind = BitSet.singleton RSafeTC} + setsafetc :: SymV Global -> StG () + setsafetc sym = changeSym $ SymbolT.V sym.{rkind = BitSet.singleton RSafeTC} {-- @@ -447,23 +448,23 @@ strictName sids nm = do v <- U.findV nm when (v.state != StrictChecked) do E.logmsg TRACES v.pos (text ("strictness analysis for " ++ v.nice g)) - let ari = U.arity v -- ... based on type + let ari = U.arity $ SymVal.V v -- ... based on type notLazy sym = RValue `member` sym.rkind case v of SymV {state = StrictChecked} = stio [] -- do nothing - SymV {name = MName{tynm}} | Just SymC{} ← g.findit tynm → do + SymV {name = MName{tynm}} | Just (SymbolT.C _) <- g.findit tynm -> do let strsig = S (take ari allLazy) E.logmsg TRACES v.pos (text ("strictness for abstract " ++ v.name.nice g ++ " is " ++ show strsig)) - changeSym v.{strsig, state = StrictChecked} + changeSym $ SymbolT.V v.{strsig, state = StrictChecked} stio [] SymV {nativ = Just _} -> do let strsig = S (take ari allStrict) E.logmsg TRACES v.pos (text ("strictness for " ++ v.name.nice g ++ " is " ++ show strsig)) - changeSym v.{strsig, state = StrictChecked} + changeSym $ SymbolT.V v.{strsig, state = StrictChecked} stio [] SymV {} | Just (x@Lam{ex}) <- v.gExpr g -> do @@ -472,8 +473,8 @@ strictName sids nm = do E.logmsg TRACES v.pos (text ("strictness for " ++ v.name.nice g ++ " is " ++ show (S s) ++ " ignoring " - ++ joined ", " (map (flip nice g • Symbol.name) syms))) - changeSym v.{expr = Just (return x), strsig = S s, state = StrictChecked} + ++ joined ", " (map (flip nice g . _.name) syms))) + changeSym $ SymbolT.V v.{expr = Just (return x), strsig = S s, state = StrictChecked} stio syms SymV {expr = Just x} | ari >= 0 = do y <- x >>= eta ari @@ -483,7 +484,7 @@ strictName sids nm = do rs = if null s then v.strsig else S s E.logmsg TRACES v.pos (text ("strictness for " ++ v.name.nice g ++ " is " ++ show rs)) - changeSym v.{expr = Just (return x), strsig = rs, state = StrictChecked} + changeSym $ SymbolT.V v.{expr = Just (return x), strsig = rs, state = StrictChecked} stio syms where eta 0 x = stio x @@ -491,11 +492,11 @@ strictName sids nm = do let pos = getpos x nums <- sequence (take n (repeat uniqid)) syms <- mapSt U.mkLocal [ PVar{pos=pos,uid,var="$"} | uid <- nums ] - let vars = map Symbol.name syms + let vars = map _.name syms mkapp ex n = nApp ex (Vbl {pos, name=n, typ = Nothing}) -- mklam :: Expr -> Int -> Expr mklam ex sym = Lam {pat,ex,typ=Nothing} - where pat = PVar {pos, uid=Symbol.sid sym, var="$"} + where pat = PVar {pos, uid=sym.sid, var="$"} -- env = insert Nil pat.var (U.patLocal pos pat.var).{sid=n} -- \a\b -> x a b body = fold mkapp x vars @@ -513,9 +514,8 @@ strictName sids nm = do let strsig = if ari == 0 then v.strsig else S (take ari allLazy) E.logmsg TRACES v.pos (text ("strictness for " ++ v.name.nice g ++ " is " ++ show strsig)) - changeSym v.{strsig, state = StrictChecked} + changeSym $ SymbolT.V v.{strsig, state = StrictChecked} stio [] - other -> E.fatal other.pos (text ("strictness: strange symbol " ++ other.nice g)) {-- @@ -540,20 +540,20 @@ strictName sids nm = do * the lambda strictness for the arguments * 6. if g is checked recursively, all arguments are strict -} -strictReturn :: Bool -> [Int] -> Expr -> StG (Expr, [Symbol]) +strictReturn :: Bool -> [Int] -> Expr -> StG (Expr, [SymVal Global]) strictReturn notLazy sids x = strictness sids x where - strictness :: [Int] -> Expr -> StG (Expr, [Symbol]) + strictness :: [Int] -> Expr -> StG (Expr, [SymVal Global]) strictness sids x = do g <- getST E.logmsg TRACES (getpos x) (text ("strictness for: " ++ nice x g)) let mine = if x.{env?} then map QName.uid x.env else if x.{pat?} then map Pattern.uid (patVars x.pat) else [] - my = filter ((`elem` mine) • Symbol.sid) - them = filter ((`notElem` mine) • Symbol.sid) + my = filter ((`elem` mine) . _.sid) + them = filter ((`notElem` mine) . _.sid) case x of Vbl {name=Local{}} -> do - v <- U.findV x.name + v <- fmap SymVal.V $ U.findV x.name E.logmsg TRACES (getpos x) (text ("strictness " ++ nice x g ++ " :: " ++ names g [v])) stio (x, if notLazy then [v] else []) Vbl {name} -> do @@ -575,7 +575,7 @@ strictReturn notLazy sids x = strictness sids x where (filter ((`notElem` sids) • QName.uid) env) (ex, syms) <- strictness sids ex let strictSyms = my syms - sSsids = map Symbol.sid strictSyms + sSsids = map (_.sid) strictSyms upper = [ sres | (loc, sres) <- zip env results, QName.uid loc `elem` sSsids ] result = fold uni (them syms) upper @@ -620,10 +620,10 @@ strictReturn notLazy sids x = strictness sids x where E.fatal (getpos x) (text ("no strictness rule, turn on -xs -xr " ++ show (getpos x))) stio (x, []) where - names g = show • map (flip QName.nice g • Symbol.name) - inter as = filter (\b -> elemBy (using Symbol.sid) b as) - uni :: [Symbol] -> [Symbol] -> [Symbol] - uni as bs = as ++ [ b | b <- bs, not (elemBy (using Symbol.sid) b as)] + names g = show . map (flip QName.nice g . _.name) + inter as = filter (\b -> elemBy (using _.sid) b as) + uni :: [SymVal Global] -> [SymVal Global] -> [SymVal Global] + uni as bs = as ++ [ b | b <- bs, not (elemBy (using _.sid) b as)] maxss (S s1) (S s2) = S (zipWith maxss s1 s2) maxss U s = s maxss s _ = s @@ -638,10 +638,11 @@ strictReturn notLazy sids x = strictness sids x where -- mark a symbol as strict + mark :: SymVal Global -> StG () mark sym = do g <- getST - E.logmsg TRACES (Symbol.pos sym) (text (nice sym.name g ++ " marked as strict")) - when (sym.strsig == U) do changeSym sym.{strsig = S[]} + E.logmsg TRACES sym.pos (text (nice sym.name g ++ " marked as strict")) + when (sym.strsig == U) do changeSym $ SymVal.toSymbol $ set SymVal._strsig (S[]) sym -- strictness for case alternative, same as in lambda strictAlt (alt@CAlt {pat,ex}) = do (lam, syms) <- strictness sids (Lam {pat,ex,typ=Nothing}) @@ -676,8 +677,8 @@ strictReturn notLazy sids x = strictness sids x where appstr (app@((f,mbt):as)) = do g <- getST v <- case f of - Con {name} -> U.findD name - Vbl {name} -> U.findV name + Con {name} -> fmap SymVal.D $ U.findD name + Vbl {name} -> fmap SymVal.V $ U.findV name _ -> E.fatal (getpos f) (text ("Can't handle " ++ nice f g ++ " applications")) let fsym | Local {} <- v.name = [v] | otherwise = [] @@ -686,18 +687,18 @@ strictReturn notLazy sids x = strictness sids x where let napp = zip (map fst fapp) (map snd app) stio (napp, fsym) case v of - SymV {state = Typechecked, expr = Nothing} = mkAll - SymV {state = Typechecked, expr = Just _} - | Just (Lam{}) <- v.gExpr g = if v.sid `elem` sids + SymVal.V (SymV{state = Typechecked, expr = Nothing}) = mkAll + SymVal.V (symv@SymV{state = Typechecked, expr = Just _}) + | Just (Lam{}) <- symv.gExpr g = if symv.sid `elem` sids then do -- assume all are strict asx <- mapSt (strictness sids) (map fst as) stio ((f,mbt):zip (map fst asx) (map snd as), fold uni fsym (map snd asx)) else do - strictName sids v.name + strictName sids symv.name appstr app -- repeat - SymV {state = Typechecked, expr = Just dx} - | v.sid `notElem` sids = do + SymVal.V (symv@SymV{state = Typechecked, expr = Just dx}) + | symv.sid `notElem` sids = do -- inline pointless x <- dx let fx = flatx x @@ -705,22 +706,21 @@ strictReturn notLazy sids x = strictness sids x where let as = drop (length fx) fxas stio ((f,mbt):as, fsym ++ syms) | otherwise = mkAll - SymD {strsig = U} -> mkAll - SymD {strsig = S ss} -> do + SymVal.D SymD{strsig = U} -> mkAll + SymVal.D SymD{strsig = S ss} -> do let xss = take (length as) (ss ++ repeat U) -- make sure enough exsyms <- mapSt subapp (zip (map fst as) xss) stio ((f,mbt):zip (map fst exsyms) (map snd as), fold uni fsym (map snd exsyms)) - SymV {state = StrictChecked, strsig = U} -> mkAll - SymV {state = StrictChecked, strsig = S ss} -> do + SymVal.V SymV{state = StrictChecked, strsig = U} -> mkAll + SymVal.V (symv@SymV{state = StrictChecked, strsig = S ss}) -> do let xss = take (length as) (ss ++ repeat U) -- make sure enough - E.logmsg TRACES (getpos f) (text ("appstr: xss=" ++ show xss ++ " for " ++ v.name.nice g)) + E.logmsg TRACES (getpos f) (text ("appstr: xss=" ++ show xss ++ " for " ++ symv.name.nice g)) exsyms <- mapSt subapp (zip (map fst as) xss) stio ((f,mbt):zip (map fst exsyms) (map snd as), fold uni fsym (map snd exsyms)) - SymV {sid} -> do - E.fatal (v.pos) (text ("appstr: unexpected symbol " ++ nice v g - ++ ", state=" ++ show v.state - ++ ", expr=" ++ show (isJust v.expr))) - _ -> error "appstr: no appropriate sym" + SymVal.V symv -> do + E.fatal symv.pos (text ("appstr: unexpected symbol " ++ nice v g + ++ ", state=" ++ show symv.state + ++ ", expr=" ++ show (isJust symv.expr))) appstr _ = error "appstr: []" diff --git a/frege/compiler/passes/Transdef.fr b/frege/compiler/passes/Transdef.fr index 47455855..8478f670 100644 --- a/frege/compiler/passes/Transdef.fr +++ b/frege/compiler/passes/Transdef.fr @@ -44,6 +44,8 @@ import frege.Prelude hiding(<+>, break) import Data.TreeMap as TM(insert, lookup, values, keys, TreeMap, each, contains) import Data.List as DL(find, unique, sortBy, groupBy) +import frege.compiler.common.Lens (preview, set) + import Compiler.enums.Flags as Compilerflags(TRACE5, isOn, flagClr, flagSet, NODOCWARNINGS) import Compiler.enums.TokenID import Compiler.enums.Visibility @@ -75,7 +77,7 @@ import Compiler.common.Trans(patternRefutable) import Compiler.classes.Nice -import frege.compiler.Utilities as U(transSigma, transTau, +import frege.compiler.Utilities as U(transSigma, transTVar, transTau, validSigma, forceTau, freeTVnames) import frege.compiler.passes.Fix as Fix() @@ -91,7 +93,7 @@ pass = do g <- getSTT -- before we start, we must have operator information - forM_ g.sub.sourcedefs (liftStG . fixity) + mapM_ (liftStG . fixity) [x | DefinitionS.Fix x <- g.sub.sourcedefs] -- do the main part forsome g.sub.sourcedefs (liftStG . transdef [] (VName g.thisPack)) @@ -108,15 +110,16 @@ pass = do --- change 'Symbol.op' field according to @infix@ definitions. +fixity :: FixDcl -> StG () fixity (d@FixDcl{pos, opid, ops}) = foreach ops changeop where changeop op = do g ← getST let qo = VName g.thisPack op vals = values g.thisTab - typemembers = [ MName name op | t@SymT{name} <- vals, g.our name ] - classmembers = [ MName name op | t@SymC{name} <- vals, g.our name ] - instmembers = [ MName name op | t@SymI{name} <- vals, g.our name ] + typemembers = [ MName name op | SymbolT.T SymT{name} <- vals, g.our name ] + classmembers = [ MName name op | SymbolT.C SymC{name} <- vals, g.our name ] + instmembers = [ MName name op | SymbolT.I SymI{name} <- vals, g.our name ] members = typemembers ++ classmembers ++ instmembers syms = mapMaybe g.findit (qo:members) foreach syms change @@ -125,17 +128,15 @@ fixity (d@FixDcl{pos, opid, ops}) = foreach ops changeop change sym = do g <- getST - if sym.{op?} - then do - unless (g.our sym.name || sym.op == defaultInfix || sym.op == opid) do + case preview SymbolT._op sym of + Just op -> do + unless (g.our sym.name || op == defaultInfix || op == opid) do E.hint pos (text ("Should you change associativity/precedence for " ++ nicer sym.name g)) - changeSym sym.{op=opid} - else do + changeSym $ set SymbolT._op opid sym + Nothing -> E.error pos (text (nicer sym g ++ " cannot have a precedence")) - -fixity _ = return () --- translate inline candidates from exporting package clause to QNames and set exported flag in corresponding symbols inlineCandidates = do @@ -145,24 +146,24 @@ inlineCandidates = do when (g.errors == 0) do syms <- mapM U.findV rslvd -- for the time being, inlining higher rank functions is not supported - foreach syms (\sym -> changeSym sym.{exported=notHigherConstraint sym}) + foreach syms (\sym -> changeSym $ SymbolT.V sym.{exported=notHigherConstraint sym}) let zs = zip syms g.sub.toExport - foreach [ (s,p) | (s,p) <- zs, not (g.ourSym s) || isNothing (Symbol.expr s) ] notOurCode + foreach [ (s,p) | (s,p) <- zs, not (g.ourSym $ SymbolT.V s) || isNothing s.expr ] notOurCode return () where -- silently remove higher rank functions with contexts from export notHigherConstraint sym = notHC sym.typ.rho where - notHC RhoTau{} = true - notHC RhoFun{sigma=ForAll bound srho, rho} + notHC (RhoT.Tau _) = true + notHC (RhoT.Fun RhoFun{sigma=ForAll bound srho, rho}) | t <- U.freeCtxTVars [] empty srho.context, any (`elem` map _.var bound) (keys t) = false | otherwise = notHC srho && notHC rho notOurCode (sym, p) = do g <- getST E.warn (Pos (SName.id p) (SName.id p)) - (text ("Cannot export code of " ++ nicer sym g - ++ (if g.ourSym sym + (text ("Cannot export code of " ++ nicer sym g + ++ (if g.ourSym (SymbolT.V sym) then " because it has none." -- no code else " because defined elsewhere.") -- not our )) @@ -193,23 +194,29 @@ varcon _ = Nothing transdef ∷ [QName] → (String→QName) → DefinitionS → StG () -transdef env fname def = case def of - ImpDcl{} → pure () -- nothing to do here - FixDcl{} → pure () -- nothing to do here - DocDcl{} → pure () -- nothing to do here - TypDcl{} → pure () -- already done in TypeAlias pass - ClaDcl{} → transClaDcl env fname def - InsDcl{} → transInsDcl env fname def - DrvDcl{} → pure () -- already done in Instances pass - AnnDcl{} → transAnnDcl env fname def - NatDcl{} → transNatDcl env fname def - FunDcl{} → transFunDcl env fname def - DatDcl{} → transDatDcl env fname def - JavDcl{} → transJavDcl env fname def - ModDcl{} → transModDcl env fname def - -transFunDcl env fname (d@FunDcl {positions}) = do - let dname = defname d +transdef env fname def' = case def' of + DefinitionS.Imp _ -> pure () -- nothing to do here + DefinitionS.Fix _ -> pure () -- nothing to do here + DefinitionS.Doc _ -> pure () -- nothing to do here + DefinitionS.Typ _ -> pure () -- already done in TypeAlias pass + DefinitionS.Cla def -> transClaDcl env fname def + DefinitionS.Ins def -> transInsDcl env fname def + DefinitionS.Drv _ -> pure () -- already done in Instances pass + DefinitionS.Ann def -> transAnnDcl env fname def + DefinitionS.Nat def -> transNatDcl env fname def + DefinitionS.Fun def -> transFunDcl env fname def + DefinitionS.Dat def -> transDatDcl env fname def + DefinitionS.Jav def -> transJavDcl env fname def + DefinitionS.Mod def -> transModDcl env fname def + +transLetMemberS :: [QName] -> (String -> QName) -> LetMemberS -> StG () +transLetMemberS env fname def' = case def' of + LetMemberS.Ann def -> transAnnDcl env fname def + LetMemberS.Fun def -> transFunDcl env fname def + +transFunDcl :: [QName] -> (String -> QName) -> FunDcl -> StG () +transFunDcl env fname (d@FunDcl {positions}) = do + let dname = defname $ LetMemberS.Fun d aname = if null env then fname dname else findLocal env dname case funbinding d of Just _ -> common aname d @@ -218,9 +225,9 @@ transFunDcl env fname (d@FunDcl {positions}) = do where pos = if null positions then getpos d.lhs else positionOf (head positions) classMember (MName tynm _) g = case g.findit tynm of - Just SymC{} = true - Just SymI{} = true - other = false + Just (SymbolT.C _) = true + Just (SymbolT.I _) = true + other = false classMember other g = false common aname d = do g <- getST @@ -229,10 +236,10 @@ transFunDcl env fname (d@FunDcl {positions}) = do where rest g = case g.findit aname of Just sym - | SymV {pos} <- sym = do + | SymbolT.V symv <- sym = do let funex = foldr (\p\e → Lam p e false) d.expr d.pats -- lamNil p e = Lam p e Nothing - let nowarn = case sym.doc of + let nowarn = case symv.doc of Nothing → false Just s → s ~ '^\s*nowarn:' when (nowarn) do @@ -243,32 +250,31 @@ transFunDcl env fname (d@FunDcl {positions}) = do case varcon x of -- make non local, unannotated definitions like @a = b@ into aliases Just name - | !sym.anno, - !sym.name.isLocal, - !(classMember aname g), - Just osym <- g.findit name, + | not symv.anno, + not symv.name.isLocal, + not (classMember aname g), + Just osym <- SymVal.fromSymbol =<< g.findit name, -- make sure there is no precedence conflict - sym.op == osym.op || sym.op == defaultInfix || osym.op == defaultInfix, + symv.op == osym.op || symv.op == defaultInfix || osym.op == defaultInfix, -- no loops, please! - name != sym.name = do - let alias = SymL{sid=sym.sid, - pos=sym.pos, - vis=sym.vis, - name=sym.name, + name != symv.name = do + let alias = SymL{sid=symv.sid, + pos=symv.pos, + vis=symv.vis, + name=symv.name, alias=name} -- - when (osym.op != sym.op && sym.op != defaultInfix) do + when (osym.op != symv.op && symv.op != defaultInfix) do when (osym.op != defaultInfix) do - E.warn pos (msgdoc ("This changes associativity/precedence for " + E.warn symv.pos (msgdoc ("This changes associativity/precedence for " ++ nicer osym.name g ++ " to the one given for " - ++ nicer sym.name g)) - changeSym osym.{op=sym.op} - changeSym alias - othr -> changeSym sym.{expr = Just (return x)} + ++ nicer symv.name g)) + changeSym $ SymVal.toSymbol $ set SymVal._op symv.op osym + changeSym $ SymbolT.L alias + othr -> changeSym $ SymbolT.V symv.{expr = Just (return x)} | otherwise = E.fatal pos (text ("expected function, found " ++ sym.nice g)) nothing -> do E.fatal pos (text ("Cannot happen, function " ++ aname.nice g ++ " missing")) -transFunDcl _ _ d = E.fatal d.pos (text "not a fun dcl") {- AnnDcl {pos::Line, vis::Visibility, name::String, typ::SigmaT t, doc::Maybe String} @@ -276,56 +282,57 @@ transFunDcl _ _ d = E.fatal d.pos (text "not a fun dcl") typ::Sigma, expr::Maybe Expr, nativ::Maybe String, pur::Bool, anno::Bool} /// variable -} +transAnnDcl :: [QName] -> (String -> QName) -> AnnDcl -> StG () transAnnDcl env fname (d@AnnDcl {pos}) = do g <- getST let aname = if null env then fname d.name else findLocal env d.name case g.findit aname of Nothing -> do E.fatal pos (text ("Cannot happen, function " ++ aname.nice g ++ " missing")) Just sym - | SymV {pos} <- sym = do + | SymbolT.V symv <- sym = do t <- transSigma d.typ - changeSym sym.{typ = t, anno=true} - E.logmsg TRACE5 pos (text ("function " ++ aname.nice g ++ " = " ++ t.nice g)) - | SymL{pos=dpos, name, alias} <- sym, g.our name = + changeSym $ SymbolT.V symv.{typ = t, anno=true} + E.logmsg TRACE5 symv.pos (text ("function " ++ aname.nice g ++ " = " ++ t.nice g)) + | SymbolT.L SymL{pos=dpos, name, alias} <- sym, g.our name = E.error pos (msgdoc ("function " ++ name.nice g ++ " has been defined as alias for " ++ alias.nicer g ++ ". Place this annotation before line " ++ show dpos.line ++ " to prevent this error.")) | otherwise = E.fatal pos (text ("expected function, found " ++ sym.nice g)) -transAnnDcl _ _ d = E.fatal d.pos (text "not a ann dcl") +transNatDcl :: [QName] -> (String -> QName) -> NatDcl -> StG () transNatDcl env fname (d@NatDcl {pos}) = do g <- getST let aname = fname d.name case g.findit aname of Nothing -> do E.fatal pos (text ("Cannot happen, function " ++ aname.nice g ++ " missing")) Just sym - | SymV {pos} <- sym = case d.txs of + | SymbolT.V symv <- sym = case d.txs of [(sig, thrs)] = do t <- transSigma sig thrs <- mapM transTau thrs >>= mapM U.forceTau - gargs ← mkGargs false sym d t - changeSym sym.{typ = t, throwing = thrs, gargs} + gargs <- mkGargs false symv d t + changeSym $ SymbolT.V symv.{typ = t, throwing = thrs, gargs} overloaded = do - over <- mapM (uncurry (overload d sym)) overloaded - changeSym sym.{typ = ovlsigma, over} + over <- mapM (uncurry (overload d symv)) overloaded + changeSym $ SymbolT.V symv.{typ = ovlsigma, over} | otherwise = E.fatal pos (text ("expected function, found " ++ sym.nice g)) where - overload ∷ DefinitionS → Symbol → SigmaS → [TauS] → StG QName + overload :: NatDcl -> SymV Global -> SigmaS -> [TauS] -> StG QName overload def sym sig exs = do g <- getST let name = U.unusedASCIIName sym.name g t <- transSigma sig thrs <- mapM transTau exs >>= mapM U.forceTau gargs ← mkGargs true sym def t - enter sym.{sid=0, name, typ = t, throwing = thrs, vis = Protected, gargs} + enter $ SymbolT.V sym.{sid=0, name, typ = t, throwing = thrs, vis = Protected, gargs} return name -- extract and translate generic type arguments - mkGargs ∷ Bool → Symbol → DefinitionS → Sigma → StG [Tau] + mkGargs :: Bool -> SymV Global -> NatDcl -> Sigma -> StG [TVar QName] mkGargs ovld sym d sig = do g ← getST dgargs ← case d.gargs of - Just gs -> (mapM (\t → transTau t >>= forceTau)) gs + Just gs -> mapM transTVar gs Nothing -> pure [] let nik = if sig.isFun then niKind d.meth else NIOp -- fake (rt, sigs) = U.returnType sig.rho @@ -346,8 +353,8 @@ transNatDcl env fname (d@NatDcl {pos}) = do -- get the phantom type, if any phantom = case unST rt of - Just (TVar{var}, _) → Just var - _ → Nothing + Just (TauT.Var TVar{var}, _) -> Just var + _ -> Nothing -- type variables we want to avoid avoid = maybeToList phantom ++ objectvars -- type variables that are valid @@ -358,7 +365,7 @@ transNatDcl env fname (d@NatDcl {pos}) = do inferred = if nik == NIMethod || nik == NIStatic then sigvars else [] initial = maybe inferred (const dgargs) d.gargs gargs - | ovld = filter (null . freeTVnames bound . RhoTau []) initial + | ovld = filter (null . freeTVnames bound . RhoT.Tau . RhoTau [] . TauT.Var) initial | otherwise = initial -- gargs ← mapM transTau sgargs >>= mapM forceTau when (length gargs > 1 && isNothing d.gargs) do @@ -385,8 +392,8 @@ transNatDcl env fname (d@NatDcl {pos}) = do <> text "} :: ...." )) -- check that generic type arguments do not contain free type variables - forM_ gargs $ \tau → do - let free = freeTVnames bound (RhoTau [] tau) + forM_ gargs $ \tvar -> do + let free = freeTVnames bound $ RhoT.Tau $ RhoTau [] $ TauT.Var tvar phantomError = filter (`elem` maybeToList phantom) free instanceError = filter (`elem` objectvars) free unboundError = filter (`notElem` sig.vars) free @@ -396,9 +403,9 @@ transNatDcl env fname (d@NatDcl {pos}) = do variables [x] = "type variable " ++ nicevars [x] variables xs = "type variables " ++ nicevars xs unless (null free) do - E.error (getpos tau) ( + E.error (getpos tvar) ( text "Generic type argument " - <+> text (nicer tau g) + <+> text (nicer tvar g) <+> text " is invalid because " <+/> if not (null phantomError) then text "it contains" <+> text (variables phantomError) @@ -421,42 +428,46 @@ transNatDcl env fname (d@NatDcl {pos}) = do <> text "} for" <+> text (nicer sym.name g)) return gargs -transNatDcl _ _ d = E.fatal d.pos (text "not a nat dcl") - +transInsDcl :: [QName] -> (String -> QName) -> InsDcl -> StG () transInsDcl env fname (d@InsDcl {pos}) = do g <- getST let iname = TName g.thisPack (Enter.insName d) case g.findit iname of Just sym - | SymI {pos} <- sym = do + | SymbolT.I (symi@SymI{pos}) <- sym = do clas <- defaultXName pos (TName pPreludeBase "Eq") d.clas typ <- U.transSigma d.typ E.logmsg TRACE5 pos (text ("instance " ++ QName.nice clas g ++ " (" ++ Sigma.nice typ g ++ ")")) - changeSym sym.{clas,typ} + changeSym $ SymbolT.I symi.{clas,typ} foreach d.defs (transdef [] (MName iname)) nothing -> do E.fatal pos (text ("Cannot happen, instance " ++ iname.nice g ++ " missing")) -transInsDcl _ _ d = E.fatal d.pos (text "not a ins dcl") -private refreshType ∷ DefinitionS → Symbol → StG Symbol -private refreshType d sym = do +private refreshTypeDatDcl :: DatDcl -> SymT Global -> StG (SymT Global) +private refreshTypeDatDcl DatDcl{name, pos, vars} = refreshType name pos vars +private refreshTypeJavDcl :: JavDcl -> SymT Global -> StG (SymT Global) +private refreshTypeJavDcl JavDcl{name, pos, vars} = refreshType name pos vars + +private refreshType :: String -> Position -> [TVar SName] -> SymT Global -> StG (SymT Global) +private refreshType name pos vars sym = do g ← getST - vars ← mapM (\t → transTau t >>= forceTau) d.vars - let !dname = TName g.thisPack d.name - dtcon = TCon {pos=d.pos, name=dname} - dtau = dtcon.mkapp vars :: Tau - !dsig = ForAll vars (RhoTau [] dtau) + vars <- mapM transTVar vars + let !dname = TName g.thisPack name + dtcon = TauT.Con TCon{pos, name=dname} + dtau = dtcon.mkapp $ map TauT.Var vars + !dsig = ForAll vars $ RhoT.Tau $ RhoTau [] dtau !kind = foldr KApp KType dsig.kinds :: Kind - newsym = sym.{typ=dsig, kind=kind} - changeSym newsym + newsym = sym.{typ=dsig, kind} + changeSym $ SymbolT.T newsym pure newsym +transDatDcl :: [QName] -> (String -> QName) -> DatDcl -> StG () transDatDcl env fname (d@DatDcl {pos}) = do g <- getST let tname = TName g.thisPack d.name case g.findit tname of - Just sym | SymT {pos} <- sym = do - sym ← refreshType d sym + Just sym | SymbolT.T symt <- sym = do + sym <- refreshTypeDatDcl d symt foreach d.ctrs (transCon sym.typ (MName tname)) foreach d.defs (transdef [] (MName tname)) polymorphicFields tname @@ -464,33 +475,33 @@ transDatDcl env fname (d@DatDcl {pos}) = do other -> do E.fatal pos (text ("Cannot happen, data " ++ tname.nice g ++ " missing")) where newtCheck (symt@SymT{newt=true}) -- this is declared as newtype - | [con] ← [ c | c@SymD{} <- values symt.env ], -- so it has 1 constructor + | [con] ← [ c | SymbolT.D c <- values symt.env ], -- so it has 1 constructor [fld] ← [ f | f@Field {typ} <- con.flds ], -- with 1 field - ForAll _ RhoTau{tau} ← fld.typ, -- which has some type tau + ForAll _ (RhoT.Tau RhoTau{tau}) <- fld.typ, -- which has some type tau TApp{} ← tau, -- that is an application - TVar{}:_ ← tau.flat -- of a type variable to smth. + TauT.Var _:_ <- tau.flat -- of a type variable to smth. = do g ← getST E.hint symt.pos (text "Implementation restriction: type " <+/> text (nicer symt.name g) <+/> text " cannot be a newtype and will be treated as data." ) - changeSym symt.{newt=false} -- make it data - changeSym con.{flds <- map _.{strict=true}} -- with strict field + changeSym $ SymbolT.T symt.{newt=false} -- make it data + changeSym $ SymbolT.D con.{flds <- map _.{strict=true}} -- with strict field pure () - newtCheck other = pure () + newtCheck _ = pure () polymorphicFields tname = do symt <- U.findT tname - let cons = [ c | c@SymD{} <- values symt.env ] + let cons = [ c | SymbolT.D c <- values symt.env ] fields = [ f | con <- cons, -- from constructors - f@Field {name = Just n} <- Symbol.flds con, -- take named fields + f@Field {name = Just n} <- con.flds, -- take named fields not (null f.typ.bound) -- with polymorphic type ] ufields = map (("upd$" ++) • unJust • ConField.name) fields cfields = map (("chg$" ++) • unJust • ConField.name) fields - umethods = [ m | m@SymV{} <- values symt.env, -- methods that update a poly field + umethods = [ m | SymbolT.V m <- values symt.env, -- methods that update a poly field m.name.base `elem` ufields ] - cmethods = [ m | m@SymV{} <- values symt.env, -- methods that change a poly field + cmethods = [ m | SymbolT.V m <- values symt.env, -- methods that change a poly field m.name.base `elem` cfields ] foreach umethods (updPolyAnn symt fields) foreach cmethods (chgPolyAnn symt fields) @@ -501,23 +512,23 @@ transDatDcl env fname (d@DatDcl {pos}) = do -- NOTE Issue 203: the type of the record could only be changed if -- f was the only field that mentions outer bound type a -- Hence, poly-update will not be possible here. - updPolyAnn :: Symbol -> [ConField QName] -> Symbol -> StG () + updPolyAnn :: SymT Global -> [ConField QName] -> SymV Global -> StG () updPolyAnn dtyp flds meth = do g <- getST case find ((meth.name.base ==)•("upd$"++)•unJust•ConField.name) flds of Just cf -> do - E.logmsg TRACE5 (Symbol.pos meth) (text "polymorphic update " + E.logmsg TRACE5 meth.pos (text "polymorphic update " <+> text (nice meth g) <+> text " :: " <+> text (nice cf.typ g)) let mtyp = ForAll (dtyp.typ.bound) rho1 where - rho1 = RhoFun [] dtyp.typ.{bound=[]} rho2 - rho2 = RhoFun [] cft ret + rho1 = RhoT.Fun $ RhoFun [] dtyp.typ.{bound=[]} rho2 + rho2 = RhoT.Fun $ RhoFun [] cft ret ret = dtyp.typ.rho cft = cf.typ kim ← fst <$> kiSigma [] [] mtyp - changeSym meth.{typ = kim, anno = true} + changeSym $ SymbolT.V meth.{typ = kim, anno = true} E.logmsg TRACE5 meth.pos (text (nice meth g ++ " :: " ++ nicer mtyp g)) return () Nothing -> E.fatal dtyp.pos (text (nice meth.name g ++ ": field not found.")) @@ -540,10 +551,10 @@ transDatDcl env fname (d@DatDcl {pos}) = do -- chg$listop :: Poly a -> (forall b.Functor b => (b a -> b a) -> b a -> b a) -> Poly a -- Note that the original function is instantiated at the constraint that gets passed -- to the changing function. - chgPolyAnn :: Symbol -> [ConField QName] -> Symbol -> StG () + chgPolyAnn :: SymT Global -> [ConField QName] -> SymV Global -> StG () chgPolyAnn dtyp flds meth = do g <- getST - E.logmsg TRACE5 (Symbol.pos meth) (text ("polymorphic change " ++ nice meth g)) + E.logmsg TRACE5 meth.pos (text ("polymorphic change " ++ nice meth g)) case find ((meth.name.base ==)•("chg$"++)•unJust•ConField.name) flds of Just cf -> do -- we have: @@ -561,22 +572,22 @@ transDatDcl env fname (d@DatDcl {pos}) = do record = dtyp.typ.rho -- T a b funbound = cf.typ.bound -- ∀ f. functx = cf.typ.rho.context -- Ctx f ⇒ - funrho = cf.typ.rho.{context=[]} -- f a → f b + funrho = set RhoT._context [] cf.typ.rho -- f a → f b charg = ForAll funbound -- ∀ f . Ctx f ⇒ (f a → f b) → f a → f b - RhoFun{ + $ RhoT.Fun RhoFun{ context = functx, sigma = ForAll [] funrho, rho = funrho} result = ForAll outerbound -- ∀a b.T a b → charg → T a b - RhoFun{ + $ RhoT.Fun RhoFun{ context = [], sigma = ForAll [] record, - rho = RhoFun{ + rho = RhoT.Fun RhoFun{ context = [], sigma = charg, rho = record}} kir ← fst <$> kiSigma [] [] result - changeSym meth.{typ = kir, anno = true} + changeSym $ SymbolT.V meth.{typ = kir, anno = true} E.logmsg TRACE5 meth.pos (text (nice meth g ++ " :: " ++ nicer kir g)) pure () Nothing -> E.fatal dtyp.pos (text (nice meth.name g ++ ": field not found.")) @@ -585,8 +596,8 @@ transDatDcl env fname (d@DatDcl {pos}) = do g <- getST let cname = mname d.name case g.findit cname of - Just (con@SymD {pos}) = do - let transSigma1 (ForAll [] (RhoTau [] t)) = transTau t + Just (SymbolT.D con) = do + let transSigma1 (ForAll [] (RhoT.Tau (RhoTau [] t))) = transTau t transSigma1 s = do -- field types can be sigmas ForAll bound frho <- U.validSigma1 (map _.var bndrs) s bounds ← U.transBounds bound @@ -595,35 +606,34 @@ transDatDcl env fname (d@DatDcl {pos}) = do stio (ForAll bounds frho) sigmas <- mapSt (transSigma1 • ConField.typ) d.flds let nfs sigs = zipWith ConField.{typ=} con.flds sigs - typ = ForAll bndrs (foldr (RhoFun []) rho sigmas) + typ = ForAll bndrs (foldr (\sigma rho -> RhoT.Fun RhoFun{context=[], sigma, rho}) rho sigmas) E.logmsg TRACE5 con.pos (text (con.nice g ++ " :: " ++ typ.nice g)) sig <- U.validSigma typ >>= kiSigma [] [] >>= pure . fst let additional = filter (`notElem` map _.var bndrs) (map _.var sig.bound) unless (null additional) do - E.error pos (text ("type variable(s) " + E.error con.pos (text ("type variable(s) " ++ joined ", " additional ++ " may not appear in fields of " ++ d.name)) - -- when (con.strsig.isStrict) (foreach nfs (strictFieldsCheck cname)) - changeSym con.{typ=sig}.{flds=nfs . snd . U.returnType $ sig.rho} + changeSym $ SymbolT.D con.{typ=sig}.{flds=nfs . snd . U.returnType $ sig.rho} _ -> E.fatal pos (text ("constructor `" ++ cname.nice g ++ "` vanished.")) -transDatDcl _ _ d = E.fatal d.pos (text "not a data dcl") +transJavDcl :: [QName] -> (String -> QName) -> JavDcl -> StG () transJavDcl env fname (d@JavDcl {pos}) = do g <- getST let tname = TName g.thisPack d.name case g.findit tname of Just sym - | SymT {nativ = Just nativ} <- sym = do + | SymbolT.T (symt@SymT{nativ = Just nativ}) <- sym = do -- Redo types - sym ← refreshType d sym + sym <- refreshTypeJavDcl d symt -- extract and translate generic type arguments - let doit (Just gs) = mapM transTau gs >>= mapM forceTau + let doit (Just gs) = mapM transTVar gs doit Nothing = pure sym.typ.tvars - gargs ← doit d.gargs -- fromMaybe (pure (sym.typ.tvars sym.pos)) (map transTau <$> d.gargs) + gargs <- doit d.gargs let bound = sym.typ.vars -- check that generic type arguments do not contain free type variables forM_ gargs $ \tau → do - let free = freeTVnames bound (RhoTau [] tau) + let free = freeTVnames bound $ RhoT.Tau $ RhoTau [] $ TauT.Var tau unless (null free) do E.error (getpos tau) ( text "Generic type argument may only use type variables" @@ -643,15 +653,15 @@ transJavDcl env fname (d@JavDcl {pos}) = do let typ = sym.typ.{bound ← map ktype} !kind = foldr KApp KType (map _.kind typ.bound) let purity = d.isPure || (nativ `elem` pureTypes) - changeSym sym.{pur = purity, gargs, typ, kind} + changeSym $ SymbolT.T sym.{pur = purity, gargs, typ, kind} foreach d.defs (transdef [] (MName tname)) U.nativeType nativ tname when (nativ ~ ´\[\]$´) do E.warn pos (text (nativ ++ ": this way of declaring array types is strongly discouraged.")) | otherwise = E.fatal pos (text ("Cannot happen, native type " ++ tname.nice g ++ " is not native?")) nothing -> do E.fatal pos (text ("Cannot happen, data " ++ tname.nice g ++ " missing")) -transJavDcl _ _ d = E.fatal d.pos (text "not a java dcl") +transClaDcl :: [QName] -> (String -> QName) -> ClaDcl -> StG () transClaDcl env fname (d@ClaDcl {pos}) = do g <- getST let tname = TName g.thisPack d.name @@ -660,15 +670,15 @@ transClaDcl env fname (d@ClaDcl {pos}) = do ++ tname.nice g ++ " missing.")) -- stio Nothing Just sym - | SymC {pos} <- sym = do transclass d sym -- ; stio (Just d) + | SymbolT.C symc <- sym = transclass d symc | otherwise = do E.fatal pos (text ("expected class, found " ++ sym.nice g)) -transClaDcl _ _ d = E.fatal d.pos (text "not a class dcl") -- record the super type and super interfaces of the module in Options. +transModDcl :: [QName] -> (String -> QName) -> ModDcl -> StG () transModDcl env fname ModDcl{pos, extending, implementing, code} = do g ← getST - case length (filter _.{code?} g.sub.sourcedefs) of + case length [m | DefinitionS.Mod m <- g.sub.sourcedefs] of 1 = do ext ← case extending of Just t → Just <$> (transTau t >>= starSigma) @@ -679,12 +689,10 @@ transModDcl env fname ModDcl{pos, extending, implementing, code} = do starSigma sig = fst <$> kiSigmaX sig KType _ = E.error pos (msgdoc ("There may be at most one native module definition.")) -transModDcl _ _ d = E.fatal d.pos (text "not a mod dcl") - --- Type for overloaded functions ovlsigma :: Sigma ovlsigma = ForAll{ bound=[tvar], - rho = RhoTau [] TVar{pos=Position.null, kind=KType, var="ω"}} + rho = RhoT.Tau RhoTau{context=[], tau=TauT.Var TVar{pos=Position.null, kind=KType, var="ω"}}} where tvar = TVar{pos=Position.null, kind=KType, var="ω"} --- java types where we know for sure that they are pure @@ -720,8 +728,8 @@ transPatUnique fname pat = do u <- uniqid let pos = positionOf t var = t.value - sym = U.patLocal pos u var - enter sym + sym = U.patLocal pos u var + enter $ SymbolT.V sym when (var != "_") do changeST Global.{sub <- SubSt.{ idKind <- insert (KeyTk t) (Right sym.name)}} @@ -793,7 +801,7 @@ transPatUnique fname pat = do case pat of PVar{pos, uid, var} -> do sym <- U.findV Local{uid, base=var} - changeSym sym.{state=StrictChecked, + changeSym $ SymbolT.V sym.{state=StrictChecked, strsig = if s == "?" then U else S[]} return PUser{pat, lazy=s=="?"} _ -> return PUser{pat, lazy=s=="?"} @@ -819,7 +827,7 @@ transPatUnique fname pat = do | Just p <- ft.lookup x = return p fpat other = transPat fname (Vbl Simple{id = name.id.{tokid=VARID, value="_"}}) case g.findit qname of - Just (SymD {flds}) -> do + Just (SymbolT.D SymD{flds}) -> do let fs = [ f | Field {name = Just f} <- flds ] badfs = filter (`notElem` fs) pfs pats <- mapSt fpat (map ConField.name flds) @@ -840,7 +848,7 @@ transPatUnique fname pat = do checkCon pos qcon ps = do g <- getST case g.findit qcon of - Just (SymD {flds}) + Just (SymbolT.D SymD{flds}) | length flds == length ps = stio () | otherwise = E.error pos (msgdoc ("constructor " ++ qcon.nice g ++ " demands " ++ show (length flds) @@ -856,15 +864,23 @@ fName env fname nm = case findLocal env nm of Local 0 _ -> fname nm local -> local -defname (d@FunDcl{}) +defname :: LetMemberS -> String +defname (LetMemberS.Fun d) | Just t <- funbinding d = t.value | not (patbinding d), Vbl{name=Simple excl} <- d.lhs, excl.value == "!" || excl.value=="?", [pat] <- d.pats, Just t <- funbinding d.{lhs=pat, pats=[]} = t.value -defname AnnDcl{name} = name -defname x = error ("defname: no FunDcl: " ++ show (constructor x)) + | otherwise = error "defname: neither funbinding nor patbinding" +defname (LetMemberS.Ann AnnDcl{name}) = name + +annosLast :: [LetMemberS] -> [LetMemberS] +annosLast defs = funs ++ annos + where + (annos, funs) = DL.partition isAnno defs + isAnno (LetMemberS.Ann _) = true + isAnno _ = false transExpr :: [QName] -> (String -> QName) -> ExprS -> StG D.Expr @@ -922,24 +938,24 @@ transExpr env fname ex = do b <- transExpr env fname b return (D.Ifte c a b Nothing) Let {defs,ex} -> do - defs <- Fix.fixdefs defs - nenv <- foldM enterlocal [] (Enter.annosLast defs) - foreach defs (transdef (nenv++env) fname) + defs <- fmap (mapMaybe LetMemberS.fromDefinitionS) $ Fix.fixdefs $ map LetMemberS.toDefinitionS defs + nenv <- foldM enterlocal [] (annosLast defs) + foreach defs (transLetMemberS (nenv++env) fname) ex <- transExpr (nenv++env) fname ex syms <- mapSt U.findV nenv - foreach (syms) checkDefined + foreach syms checkDefined stio (D.Let {env=nenv, ex, typ=Nothing}) where checkDefined (SymV {expr = Just _}) = stio () checkDefined sym = E.error sym.pos (msgdoc (nice sym g ++ " is annotated but not defined.")) - enterlocal :: [QName] -> DefinitionS -> StG [QName] + enterlocal :: [QName] -> LetMemberS -> StG [QName] enterlocal env def = case findLocal env (defname def) of Local 0 _ = do -- not yet entered uid <- uniqid - Enter.enter1 (Local uid) def + Enter.enter1 (Local uid) def.toDefinitionS return (Local uid (defname def):env) Local u _ = do - Enter.enter1 (Local u) def + Enter.enter1 (Local u) def.toDefinitionS return env _ = error "onlyLocal possible" Lam {pat=spat,ex,fromDO} -> do @@ -986,7 +1002,7 @@ transExpr env fname ex = do let vUndef = D.Vbl (pos.change VARID "undefined") (VName pPreludeBase "undefined") Nothing g <- getST case g.findit name of - Just (symd@SymD {}) -> do + Just (SymbolT.D symd) -> do let xnms = map fst fields flds = [ f | Field {name = Just f} <- symd.flds ] badf = filter (`notElem` flds) xnms @@ -1030,7 +1046,7 @@ transExpr env fname ex = do checkCon pos qcon = do g <- getST case g.findit qcon of - Just (SymD {}) -> return () + Just (SymbolT.D _) -> return () nothing -> when (g.errors == 0) do E.error pos (msgdoc (pos.last.value ++ " is not a data constructor")) @@ -1084,8 +1100,8 @@ ordInfix fname (orig@Infx{name, left, right}) left <- ordInfix fname Infx{name, left, right=right.left} return Infx{name=right.name, left, right=right.right} bindright = return Infx{name, left, right} -- a $ x+1 == a $ (x+1) - case (g.findit op1, g.findit op2) of - (Just sym1, Just sym2) = + case (SymVal.fromSymbol =<< g.findit op1, SymVal.fromSymbol =<< g.findit op2) of + (Just sym1, Just sym2) -> if prec sym1.op > prec sym2.op then bindleft else if prec sym1.op < prec sym2.op then bindright else -- equal precedence @@ -1150,11 +1166,11 @@ assoc t | otherwise = error ("no precedence for operator: " ++ show t) -transclass :: DefinitionS -> Symbol -> StG () +transclass :: ClaDcl -> SymC Global -> StG () transclass def sym = do supers <- liftM (map unJust • filter isJust) - (mapSt (resolveXName def.pos sym) def.supers) - changeSym sym.{supers = unique supers} + (mapSt (resolveXName def.pos $ SymbolT.C sym) def.supers) + changeSym $ SymbolT.C sym.{supers = unique supers} g <- getST - foreach def.defs (transdef [] (MName sym.name)) + foreach def.members (transdef [] (MName sym.name) . _.toDefinitionS) diff --git a/frege/compiler/passes/TypeAlias.fr b/frege/compiler/passes/TypeAlias.fr index dd1f1257..8b37eb36 100644 --- a/frege/compiler/passes/TypeAlias.fr +++ b/frege/compiler/passes/TypeAlias.fr @@ -9,6 +9,8 @@ package frege.compiler.passes.TypeAlias where import frege.Prelude hiding (<+>) +import frege.compiler.common.Lens (set) + import Data.Graph (stronglyConnectedComponents tsort) import Lib.PP (msgdoc, text, <+>) @@ -30,32 +32,29 @@ import Compiler.common.SymbolTable pass = do g <- getST - let (adefs,other) = partitioned isTypDcl g.sub.sourcedefs + let (adefs,other) = extractTypDcl g.sub.sourcedefs adeps = map aliasdep adefs agrps = tsort adeps aflat = [ a | grp <- agrps, a <- grp ] - sdefs = [ d | a <- aflat, d <- adefs, QName.base a == DefinitionS.name d ] - isTypDcl (TypDcl {pos}) = true - isTypDcl _ = false + sdefs = [ d | a <- aflat, d <- adefs, QName.base a == TypDcl.name d ] aliasdep (TypDcl {pos, name, typ}) = (tn, filter (g.our) deps) where tn = TName g.thisPack name deps = collectRho typ.rho [] - aliasdep x = error "no TypDcl" - collectRho (RhoFun _ sig rho) acc = collectRho rho (collectSigma sig acc) - collectRho (RhoTau _ tau) acc = collectTau tau acc + collectRho (RhoT.Fun r) acc = collectRho r.rho (collectSigma r.sigma acc) + collectRho (RhoT.Tau r) acc = collectTau r.tau acc collectSigma (ForAll _ rho) acc = collectRho rho acc - collectTau (TVar{}) acc = acc - collectTau (Meta _) acc = acc - collectTau (TApp a b) acc = collectTau a (collectTau b acc) - collectTau (TSig s) acc = collectSigma s acc - collectTau (TCon{name = n}) acc = case U.nstname n g of + collectTau (TauT.Var _) acc = acc + collectTau (Meta _) acc = acc + collectTau (TApp a b) acc = collectTau a (collectTau b acc) + collectTau (TSig s) acc = collectSigma s acc + collectTau (TauT.Con c) acc = case U.nstname c.name g of Nothing -> acc Just tn | tn `elem` acc = acc - | Just (SymA {name}) <- g.findit tn = if name `elem` acc then acc else name:acc + | Just (SymbolT.A SymA{name}) <- g.findit tn = if name `elem` acc then acc else name:acc | otherwise = acc -- do not complain about unknown type constructors getpos tn - | Just (SymA {pos}) <- g.findit tn = pos + | Just (SymbolT.A SymA{pos}) <- g.findit tn = pos | otherwise = Position.null checkmutual [] = stio () checkmutual [a] = stio () @@ -65,29 +64,41 @@ pass = do | tn `elem` deps = E.error (getpos tn) (msgdoc ("Self referential type alias `" ++ QName.nice tn g ++ "`")) | otherwise = stio () - changeST Global.{sub <- SubSt.{sourcedefs=reverse other}} -- no more type aliases henceforth + changeST Global.{sub <- SubSt.{sourcedefs=other}} -- no more type aliases henceforth foreach agrps checkmutual foreach adeps checkselfref g <- getST unless (g.errors > 0) do foreach sdefs transalias return ("type aliases", length adefs) - -transalias :: DefinitionS -> StG () + +extractTypDcl :: [DefinitionS] -> ([TypDcl], [DefinitionS]) +extractTypDcl = \xs -> (typDcls xs, others xs) + where + typDcls [] = [] + typDcls (x:xs) + | DefinitionS.Typ t <- x = t : typDcls xs + | otherwise = typDcls xs + others [] = [] + others (x:xs) + | DefinitionS.Typ _ <- x = others xs + | otherwise = x : others xs + +transalias :: TypDcl -> StG () transalias (d@TypDcl {pos}) = do g <- getST let tname = TName g.thisPack d.name case g.findit tname of - Just sym | SymA {pos} <- sym = case d.typ.bound of + Just sym | SymbolT.A SymA{pos} <- sym = case d.typ.bound of [] -> do -- type aliases may be incomplete - typS <- U.validSigma1 (map Tau.var d.vars) d.typ + typS <- U.validSigma1 (map _.var d.vars) d.typ typ <- U.transSigma (ForAll [] typS.rho) - changeSym sym.{typ = typ.{bound=[]}} + changeSym $ set SymbolT._typ typ.{bound=[]} sym bound -> do -- type X a b c = forall x y. ...... -- The bound variables x y must be distinct from the type args a b c - let bvars = map Tau.var bound - targs = map Tau.var d.vars + let bvars = map _.var bound + targs = map _.var d.vars fvars = U.freeTVnames [] d.typ.rho badfree = filter (`notElem` targs) (filter (`notElem` bvars) fvars) bad = DL.intersect bvars targs @@ -95,7 +106,7 @@ transalias (d@TypDcl {pos}) = do if null badfree then do typ1 <- U.transSigma d.typ.{bound=[]} bounds ← U.transBounds bound - changeSym sym.{typ = typ1.{bound=bounds}} + changeSym $ set SymbolT._typ typ1.{bound=bounds} sym pure () else E.error pos (text "Type variable(s) " @@ -106,4 +117,3 @@ transalias (d@TypDcl {pos}) = do <+> text (joined ", " bad) <+> text " must either be type args or bound in forall, but not both.") nothing -> E.fatal pos (text ("Cannot happen, type alias " ++ tname.nice g ++ " missing")) -transalias _ = return () diff --git a/frege/compiler/tc/Methods.fr b/frege/compiler/tc/Methods.fr index ea4119c5..b4c3aa20 100644 --- a/frege/compiler/tc/Methods.fr +++ b/frege/compiler/tc/Methods.fr @@ -127,7 +127,7 @@ niKind _ = NIStatic - A pure native function may not return mutable data. -} -sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) +sanity (SymbolT.V (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over})) | not (null over) = return () -- | otherwise = do unconstrained typ.rho @@ -167,9 +167,9 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) nargs = length args stiotyp phantom tau = TApp (TApp st phantom) tau - tv s = TVar {pos, var = s, kind = KType} - st = TCon {pos, name = TName pPreludeBase "ST"} - mt = TCon {pos, name = mutableName} + tv s = TauT.Var TVar{pos, var = s, kind = KType} + st = TauT.Con TCon{pos, name = TName pPreludeBase "ST"} + mt = TauT.Con TCon{pos, name = mutableName} sttyp tau | [s] <- keys (U.freeTauTVars [] empty tau) = stiotyp (tv s) tau @@ -183,7 +183,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) g <- getST let ctxs = case name of MName{tynm, base} - | Just SymC{} <- g.findit tynm + | Just (SymbolT.C _) <- g.findit tynm = filter ((!= tynm) . Context.cname) (Rho.context r) _ = r.context case ctxs of @@ -258,7 +258,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) goodMutable g phantom p r tau case phantom of -- warn if we have a mutable result of a non-function - Nothing | null args = U.symWarning E.warn symv (msgdoc("note that the java expression " + Nothing | null args = U.symWarning E.warn (SymbolT.V symv) (msgdoc("note that the java expression " ++ item ++ " is supposed to be constant." ++ " Consider using IO or ST if the native implementation" ++ " could modify it.")) @@ -309,10 +309,10 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) commonValidArg first phantom arg = do g <- getST case tauRho arg.rho of - RhoFun{} -> E.error (getpos arg) (msgdoc ( - "Higher rank polymorphic function" - ++ " cannot appear as argument for a native function.")) - RhoTau{tau} + Nothing -> E.error (getpos arg) $ msgdoc + $ "Higher rank polymorphic function" + ++ " cannot appear as argument for a native function." + Just (argRhoTau@RhoTau{tau}) | Just _ <- U.isUnit tau = if length args == 1 && (nki == NINew || nki == NIStatic) then return () else E.error (getpos arg) (msgdoc ( @@ -323,7 +323,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) Just _ -> E.error (getpos tau) (msgdoc ( "The type Maybe () does not make sense in the native interface.")) _ | first -> if nki == NINew || nki == NIStatic - then validFirstArg phantom arg.{rho <- Rho.{tau = r}} + then validFirstArg phantom arg.{rho=RhoT.Tau argRhoTau.{tau=r}} else E.error (getpos tau) (msgdoc ( nicer tau g ++ " makes no sense for " ++ item ++ ", as `null` cannot be passed as first argument." )) @@ -361,7 +361,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) | first, nki == NINewArray = E.error (getpos tau) (msgdoc ("`Int` expected.")) | first, nki == NIMember || nki == NIMethod = case tau of - TVar{} -> return () + TauT.Var _ -> return () _ -> E.error (getpos tau) (msgdoc ( "Instance method or getter must be applied to java reference type.")) | otherwise = return () @@ -407,7 +407,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) <+> text " is not a native type.") return Nothing -- it is at least a native one - _ | sym.pur = do + _ | sym.pur -> do E.error (getpos r) ( text "The type " <+> text (nicer tau g) @@ -417,8 +417,7 @@ sanity (symv@SymV{pos, name, typ, nativ = Just item, pur, throwing, over}) return Nothing _ -> case phantom of Nothing - -- Nothing <- mp = return (Just r) -- mutable only in value - | TCon{} <- mp = return (Just r) -- Mutable RealWorld xxx + | TauT.Con _ <- mp = return (Just r) -- Mutable RealWorld xxx | otherwise -> do -- use of mutable type in non IO? E.error (getpos tau) ( @@ -469,29 +468,26 @@ sanity sym = do --- structural equality of 'Tau' types, variables are not unified, but compared by name matches :: Tau -> Tau -> Bool -matches (TApp a b) (TApp c d) = (a `matches` c) && (b `matches` d) -matches TCon{name=a} TCon{name=b} = a == b -matches TVar{var=a} TVar{var=b} = a == b -matches _ _ = false +matches = TauT.textualEq mutableName = TName pPreludeIO "Mutable" eitherName = TName pPreludeBase "Either" -realWorld = TCon{pos=Position.null, name = TName pPreludeBase "RealWorld"} -unitTau = TCon{pos=Position.null, name = TName pPreludeBase "()"} +realWorld = TauT.Con TCon{pos=Position.null, name = TName pPreludeBase "RealWorld"} +unitTau = TauT.Con TCon{pos=Position.null, name = TName pPreludeBase "()"} -- was the 'RealWorld' originating form a mutable only type? -- mutableOnly tcon = tcon `matches` realWorld && tcon.pos.first.tokid == MUTABLE --- check if _tau_ is (Either a b) and return Just (a,b) if this is so. isEither t = case Tau.flat t of - [TCon{name}, a, b] | name == eitherName = Just (a, b) + [TauT.Con c, a, b] | c.name == eitherName = Just (a, b) _ -> Nothing --- > isMutable g tau --- Checks if _tau_ is @(Mutable a b)@ and return @Just (a,b)@ if this is so. isMutable g t = case Tau.flat t of - [TCon{name}, a, b] | name == mutableName = Just (a, b) + [TauT.Con c, a, b] | c.name == mutableName = Just (a, b) _ -> Nothing @@ -500,4 +496,4 @@ checkException g t = filter (not . U.isThrowable g) (collect t) where collect t = case isEither t of Just (left, right) -> right : collect left - _ -> [t] \ No newline at end of file + _ -> [t] diff --git a/frege/compiler/tc/Patterns.fr b/frege/compiler/tc/Patterns.fr index 5c0fad4b..aefd5242 100644 --- a/frege/compiler/tc/Patterns.fr +++ b/frege/compiler/tc/Patterns.fr @@ -10,6 +10,7 @@ import Compiler.types.Positions import Compiler.types.Packs import Compiler.types.QNames import Compiler.types.Patterns as P +import Compiler.types.Symbols (SymbolT) import Compiler.types.Expression import Compiler.types.Global as G @@ -55,7 +56,7 @@ replDWIM p = case p of let pvar = PVar{pos, uid, var = "dwim" ++ show uid} xvar = Vbl{pos, name = Local{uid, base="dwim" ++ show uid}, typ = Nothing} xlit = Lit{pos, kind, value, typ=Nothing, negated} - enter (U.patLocal pos uid pvar.var) + enter $ SymbolT.V $ U.patLocal pos uid pvar.var return (PUser{pat = pvar, lazy = false}, [eq `nApp` xlit `nApp` xvar]) else return (p, []) PVar{pos, uid, var} -> return (p, []) diff --git a/frege/compiler/tc/Util.fr b/frege/compiler/tc/Util.fr index d104ce81..ea48fd32 100644 --- a/frege/compiler/tc/Util.fr +++ b/frege/compiler/tc/Util.fr @@ -43,7 +43,7 @@ package frege.compiler.tc.Util where import frege.Prelude hiding(<+>) -import Data.TreeMap (TreeMap, values, lookup, insert, keys, +import Data.TreeMap (TreeMap, TreeSet, values, lookup, insert, keys, including, union, contains) import Data.List as DL(unique, uniq, sort, elemBy, partition) @@ -58,6 +58,7 @@ import Compiler.types.Global as G import Compiler.common.Errors as E() import Compiler.common.Binders +import Compiler.common.Lens (over, set) import Compiler.common.Types as TT (betterReadable, substRho) import Compiler.classes.Nice @@ -72,15 +73,20 @@ import frege.compiler.Javatypes data Expected t = Check t | Infer t +newSigmaTyVar :: (String, Kind) -> StG Sigma newSigmaTyVar d = ForAll [] <$> newRhoTyVar d -newRhoTyVar d = RhoTau [] <$> newMeta2 d +newRhoTyVar :: (String, Kind) -> StG Rho +newRhoTyVar d = RhoT.Tau . RhoTau [] <$> newMeta2 d +newMeta :: TVar QName -> StG Tau newMeta d = Meta <$> newFlexiTyVar d -newMeta2 d = Meta <$> newFlexiTyVar (TVar Position.null (snd d) (fst d)) +newMeta2 :: (String, Kind) -> StG Tau +newMeta2 d = Meta <$> newFlexiTyVar (TVar{pos=Position.null, kind=snd d, var=fst d}) +newFlexiTyVar :: TVar QName -> StG MetaTv newFlexiTyVar TVar{kind=k, var=n} = do u <- uniqid; stio (Flexi u n k) -newFlexiTyVar _ = error "no tyvar" +newRigidTyVar :: TVar QName -> StG MetaTv newRigidTyVar TVar{kind=k, var=n} = do u <- uniqid; stio (Rigid u n k) -newRigidTyVar _ = error "no tyvar" +instSigma :: Expr -> Sigma -> Expected Rho -> StG Expr instSigma ex sig erho = do g <- getST E.logmsg TRACET (getpos ex) (text ("instSigma: " ++ ex.nice g ++ " :: " @@ -88,6 +94,7 @@ instSigma ex sig erho = do rho <- instantiate sig instRho ex rho erho +instExplain :: (Positioned e, Nice e, Nice ty) => e -> ty -> Expected ty -> StG () instExplain ex ty (Infer _) = do g <- getST E.explain (getpos ex) (msgdoc (is ex ++ " " ++ ex.nice g ++ " :: " ++ ty.nicer g)) @@ -108,7 +115,7 @@ instRho ex ty ety = do case ety of Check r -> do subsCheckRR ex ty r g ← getST -- make unifications visible - let mty = ty.{context ← mergeCtx r.context . reducedCtxs g} + let mty = over RhoT._context (mergeCtx r.context . reducedCtxs g) ty instExplain ex mty ety E.logmsg TRACET (getpos ex) (text ("instRho subschecked: " ++ ex.nice g ++ " :: " ++ mty.nice g)) @@ -117,8 +124,9 @@ instRho ex ty ety = do instExplain ex ty ety -- subsCheckRR ex ty r -- doio (ref.put (Just ty)) - pure ex.{typ=Just (ForAll [] ty.{context ← reducedCtxs g})} + pure ex.{typ=Just (ForAll [] $ over RhoT._context (reducedCtxs g) ty)} +instPatSigma :: (Positioned e, Nice e) => e -> Sigma -> Expected Sigma -> StG () instPatSigma pat sigma esig = do g <- getST E.logmsg TRACET (getpos pat) (text ("InstPatSigma: " ++ pat.nice g ++ " :: " ++ sigma.nice g)) @@ -127,7 +135,7 @@ instPatSigma pat sigma esig = do Check s -> subsCheck pat sigma s Infer r -> subsCheck pat sigma r --- subsCheck exp s1 (RhoTau +subsCheck :: (Positioned e, Nice e) => e -> Sigma -> Sigma -> StG () subsCheck exp s1 s2 = do g <- getST E.logmsg TRACET (exp.getpos) (text ("subsCheck: " ++ s1.nice g ++ " <= " ++ s2.nice g)) @@ -167,6 +175,7 @@ subsCheck exp s1 s2 = do (text "inferred from " <+/> text (exp.nice g) <+/> text "is not as polymorphic as") (text "expected type " <+/> text (s2.nicer g))) +subsCheckSR :: (Positioned e, Nice e) => e -> Sigma -> Rho -> StG () subsCheckSR exp sig rho = do g <- getST E.logmsg TRACET (getpos exp) (text ("subsCheckSR: " ++ sig.nice g ++ " :> " ++ rho.nice g)) @@ -176,6 +185,7 @@ subsCheckSR exp sig rho = do -- check constraints (used only from Classes.fr) -- offered type must not be less constrained than expected -- which means, all contexts from the expected type must be implied by the offered ones +checkConstraints :: (Positioned e, Nice e) => e -> Sigma -> Sigma -> StG () checkConstraints exp s1 s2 = do (_,skol) <- skolemise s2 offered <- instantiate s1 @@ -199,7 +209,7 @@ checkConstraints exp s1 s2 = do (text "expected: " <+> text (nicer ety g))) stio () --- subsCheckRR :: (Positioned e, Nice e) => e -> Rho -> Rho -> StG () +subsCheckRR :: (Positioned e, Nice e) => e -> Rho -> Rho -> StG () subsCheckRR ex ty ety = do g <- getST E.logmsg TRACET (getpos ex) (text ("subsCheckRR: " ++ ty.nice g ++ " <= " ++ ety.nice g)) @@ -208,38 +218,41 @@ subsCheckRR ex ty ety = do {- - implement rule FUN if one of the types is a RhoFun -} - subsCheckRR' exp t1 (RhoFun _ a2 r2) = do + -- matching t1 as RhoTau is redundant, but needed to convince the compiler that these patterns are exhaustive + subsCheckRR' exp (t1@RhoT.Tau _) (RhoT.Fun (RhoFun _ a2 r2)) = do (a1,r1) <- unifyFun exp t1 subsCheckFun exp a1 r1 a2 r2 - subsCheckRR' exp (RhoFun _ a1 r1) t2 = do + subsCheckRR' exp (RhoT.Fun (RhoFun _ a1 r1)) t2 = do (a2,r2) <- unifyFun exp t2 subsCheckFun exp a1 r1 a2 r2 {- | otherwise revert to ordinary unification -} - subsCheckRR' expr (RhoTau _ off) exp = unify expr off exp.tau + subsCheckRR' expr (RhoT.Tau (RhoTau _ off)) (RhoT.Tau exp) = unify expr off exp.tau +subsCheckFun :: (Positioned e, Nice e) => e -> Sigma -> Rho -> Sigma -> Rho -> StG () subsCheckFun exp s1 r1 s2 r2 = do subsCheck exp s2 s1 subsCheckRR exp r1 r2 -unifyFun exp (RhoFun cx sigma res) = pure (sigma, res) -unifyFun exp (RhoTau cx tau) = do +unifyFun :: (Positioned e, Nice e) => e -> Rho -> StG (Sigma, Rho) +unifyFun _ (RhoT.Fun r) = pure (r.sigma, r.rho) +unifyFun exp (RhoT.Tau r) = do g <- getST arg_ty <- newMeta2 ("arg", KType) res_ty <- newMeta2 ("res", KType) let !funty = Tau.tfun arg_ty res_ty - b <- unified exp tau funty + b <- unified exp r.tau funty unless b do g <- getST E.error (getpos exp) (message g funty) E.hint (getpos exp) (text ("too many or too few arguments perhaps?")) - pure (ForAll [] (RhoTau [] arg_ty), RhoTau [] res_ty) + pure (ForAll [] (RhoT.Tau $ RhoTau [] arg_ty), RhoT.Tau $ RhoTau [] res_ty) where message g funty = part1 part2 part3 where part1 = text "type error in" <+> text exp.is nest 2 (nicest g exp) - part2 = text "type is apparently " <+> text (tau.nicer g) + part2 = text "type is apparently " <+> text (r.tau.nicer g) part3 = text "does not match function type " <+> text (better g funty) @@ -251,31 +264,38 @@ sigmaTvs g = keys . getSigmaTvs g rhoTvs :: Global -> Rho -> [MetaTv] rhoTvs g = keys . getRhoTvs g +tauTvs :: Global -> Tau -> [MetaTv] tauTvs g = keys . getTauTvs g ctxTvs :: Global -> Context -> [MetaTv] ctxTvs g ctx = tauTvs g ctx.tau +getSigmaTvs :: Global -> Sigma -> TreeSet MetaTv getSigmaTvs g (ForAll _ rho) = getRhoTvs g rho -getRhoTvs g (RhoFun cs sig rho) = let + +getRhoTvs :: Global -> Rho -> TreeSet MetaTv +getRhoTvs g (RhoT.Fun (RhoFun cs sig rho)) = let csTvs = map (getCtxTvs g) cs sTvs = getSigmaTvs g sig rTvs = getRhoTvs g rho in (fold union (sTvs `union` rTvs) csTvs) -getRhoTvs g (RhoTau cs tau) = let +getRhoTvs g (RhoT.Tau (RhoTau cs tau)) = let csTvs = map (getCtxTvs g) cs tTvs = getTauTvs g tau in (fold union tTvs csTvs) +getCtxTvs :: Global -> Context -> TreeSet MetaTv getCtxTvs g = getTauTvs g . Context.tau +getTauTvs :: Global -> Tau -> TreeSet MetaTv getTauTvs g tau = getTauTvsT g TreeMap.empty tau +getTauTvsT :: Global -> TreeSet MetaTv -> Tau -> TreeSet MetaTv getTauTvsT g t (TApp a b) = let ta = getTauTvsT g t a in getTauTvsT g ta b -getTauTvsT g t (TCon {pos}) = t -getTauTvsT g t (TVar {pos}) = t +getTauTvsT _ t (TauT.Con _) = t +getTauTvsT _ t (TauT.Var _) = t getTauTvsT g t (Meta tv) = case Global.bound g tv of Just ty -> getTauTvsT g t ty @@ -289,10 +309,9 @@ getTauTvsT g t (TSig s) = fold including t (sigmaTvs g s) envTvs g sid = [ m | q <- g.typEnv, sym <- g.findit q, - sym <- (g.follow sym), -- follow aliases - sym.{expr?}, - sym.sid != sid, - m <- sigmaTvs g sym.typ ] + SymbolT.V symv <- (g.follow sym), -- follow aliases + symv.sid != sid, + m <- sigmaTvs g symv.typ ] --- read a type var monadically readTv :: MetaTv -> StG (Maybe Tau) @@ -325,39 +344,44 @@ instantiate (ForAll ns ty) = do --- Substitute all wild cards with flexible Meta types --- This cannot be done with 'substRho' and friends, since wild cards are unnamed. --- Every wild card gets its own meta type var. -instWildRho RhoFun{context, sigma, rho} = do - c ← mapM instWildCtx context - s ← instWildSigma sigma - r ← instWildRho rho - pure RhoFun{context=c, sigma=s, rho=r} -instWildRho RhoTau{context, tau} = do - c ← mapM instWildCtx context - t ← instWildTau tau - pure RhoTau{context=c, tau=t} +instWildRho :: Rho -> StG Rho +instWildRho (RhoT.Fun it) = do + context <- mapM instWildCtx it.context + sigma <- instWildSigma it.sigma + rho <- instWildRho it.rho + pure $ RhoT.Fun RhoFun{context, sigma, rho} +instWildRho (RhoT.Tau it) = do + context <- mapM instWildCtx it.context + tau <- instWildTau it.tau + pure $ RhoT.Tau RhoTau{context, tau} --- see 'instWildRho' --- don't descend into higher rank types yet (or should we?) +instWildSigma :: Sigma -> StG Sigma instWildSigma (sigma@ForAll{bound, rho}) | null bound = ForAll bound <$> instWildRho rho | otherwise = pure sigma +instWildCtx :: Context -> StG Context instWildCtx (ctx@Ctx{pos, cname, tau}) = ctx.{tau=} <$> instWildTau tau -instWildTau (tv@TVar{pos, kind, var}) = case tv.wildTau of +instWildTau :: Tau -> StG Tau +instWildTau (TauT.Var (tv@TVar{kind})) = case tv.wildTau of Just _ | KGen tau ← kind = mapM instWildTau tau >>= newMeta . tv.{kind=} . KGen - other = pure tv -- ordinary TVars must not be instantiated/skolemised here + other = pure $ TauT.Var tv -- ordinary TVars must not be instantiated/skolemised here instWildTau (TApp t1 t2) = do t1' ← instWildTau t1 t2' ← instWildTau t2 pure (TApp t1' t2') -instWildTau (tcon@TCon{pos, name}) = pure tcon -instWildTau (tsig@TSig s) = TSig <$> instWildSigma s -instWildTau (meta@Meta m) = case m.kind of +instWildTau (tcon@TauT.Con _) = pure tcon +instWildTau (tsig@TSig s) = TSig <$> instWildSigma s +instWildTau (meta@Meta m) = case m.kind of KGen tau = mapM instWildTau tau >>= pure . Meta . m.{kind=} . KGen other = pure meta {-- * like instantiate, but give the tvs back -} +instantiateTvs :: Sigma -> StG ([Tau], Rho) instantiateTvs (ForAll [] ty) = stio ([], ty) instantiateTvs (ForAll ns ty) = do tvs <- mapSt newMeta ns @@ -408,9 +432,9 @@ unified ex tau1 tau2 = do | tv.isFlexi = unifyVar ex tv (Right ty) (ty, Meta tv) | tv.isFlexi = unifyVar ex tv (Left ty) -- (TFun a b, TFun c d) = liftM2 (&&) (unified ex a c) (unified ex b d) - (TCon{}, TCon{}) = if t1.name == t2.name - then return true - else unifyTCon (getpos ex) t1.name t2.name + (TauT.Con c1, TauT.Con c2) = if c1.name == c2.name + then return true + else unifyTCon (getpos ex) c1.name c2.name (TApp a b, TApp c d) = do left <- unified ex a c if left then unified ex b d @@ -432,7 +456,7 @@ unified ex tau1 tau2 = do _ = stio false where badType :: Tau -> Bool - badType (TVar {pos}) = true + badType (TauT.Var _) = true badType _ = false -- unifyTCon will only be called with real type names (no aliases) -- It returns true if both 'TCon's describe native types and the @@ -493,7 +517,7 @@ unifyVar ex tv lrtau = do unbound tau = do -- unifyUnboundVar g <- getST let tauTvs = getTauTvs g tau - tvar = TVar{pos=getpos tau, kind=KVar, var=" occurs in type "} -- trick to make 'better' work + tvar = TauT.Var TVar{pos=getpos tau, kind=KVar, var=" occurs in type "} -- trick to make 'better' work tapp = TApp (TApp (Meta tv) tvar) tau -- fake type for showing if tauTvs `contains` tv then do E.error (getpos ex) ( @@ -502,7 +526,6 @@ unifyVar ex tv lrtau = do nicest g ex) stio false else case tv.kind of - -- KGen t -> unifyKinded t tau other -> do writeTv tv tau g <- getST @@ -511,21 +534,15 @@ unifyVar ex tv lrtau = do ++ tv.nice g ++ " :: " ++ show tv.kind)) stio true - -- We have tv≤Foo and Bar - -- Unification is ok when Bar is a subtype of Foo - -- We need to expand the MetaTv one step - unifyKinded t tau = do - st ← substMeta tv.uid (Meta tv) t - unified ex st tau --- substitute MetaTV with given UID in a Tau substMeta ∷ Int → Tau → Tau → StG Tau substMeta uid rep tau = case tau of - TVar{kind=KGen ts} = mapM (substMeta uid rep) ts >>= pure . tau.{kind=} . KGen - TApp a b = liftM2 TApp (substMeta uid rep a) (substMeta uid rep b) - TCon{} = pure tau + TauT.Var (tvar@TVar{kind=KGen ts}) = mapM (substMeta uid rep) ts >>= pure . TauT.Var . tvar.{kind=} . KGen + TApp a b = liftM2 TApp (substMeta uid rep a) (substMeta uid rep b) + TauT.Con _ = pure tau Meta tv | uid == tv.uid = pure rep - Meta tv = do + Meta tv = do bound ← readTv tv case bound of Just ty -> substMeta uid rep ty -- skip enclosing Metas @@ -545,10 +562,25 @@ zonkSigma (ForAll ns ty) = do rho <- zonkRho ty; stio (ForAll ns rho) cleanSigma (ForAll ns ty) = do rho <- cleanRho ty; stio (ForAll ns rho) zonkRho :: Rho -> StG Rho -zonkRho (RhoFun ctxs arg res) = liftM3 RhoFun (mapSt zonkCtx ctxs) (zonkSigma arg) (zonkRho res) -zonkRho (RhoTau ctxs tau) = liftM2 RhoTau (mapSt zonkCtx ctxs) (zonkTau tau) -cleanRho (RhoFun ctxs arg res) = liftM3 RhoFun (zonkCtxs ctxs) (zonkSigma arg) (zonkRho res) -cleanRho (RhoTau ctxs tau) = liftM2 RhoTau (zonkCtxs ctxs) (zonkTau tau) +zonkRho (RhoT.Fun it) = do + context <- mapSt zonkCtx it.context + sigma <- zonkSigma it.sigma + rho <- zonkRho it.rho + pure $ RhoT.Fun RhoFun{context, sigma, rho} +zonkRho (RhoT.Tau it) = do + context <- mapSt zonkCtx it.context + tau <- zonkTau it.tau + pure $ RhoT.Tau RhoTau{context, tau} +cleanRho :: Rho -> StG Rho +cleanRho (RhoT.Fun it) = do + context <- zonkCtxs it.context + sigma <- zonkSigma it.sigma + rho <- zonkRho it.rho + pure $ RhoT.Fun RhoFun{context, sigma, rho} +cleanRho (RhoT.Tau it) = do + context <- zonkCtxs it.context + tau <- zonkTau it.tau + pure $ RhoT.Tau RhoTau{context, tau} zonkCtxs :: [Context] -> StG [Context] zonkCtxs ctxs = do @@ -561,10 +593,9 @@ zonkCtx ctx = do return ctx.{tau} withVars = withTauVars . Context.tau -withTauVars (TCon {}) = false --- withTauVars (TFun a b) = withTauVars a || withTauVars b -withTauVars (TApp a b) = withTauVars a || withTauVars b -withTauVars vars = true +withTauVars (TauT.Con _) = false +withTauVars (TApp a b) = withTauVars a || withTauVars b +withTauVars _ = true zonkTau :: Tau -> StG Tau -- zonkTau (TFun arg res) = liftM2 TFun (zonkTau arg) (zonkTau res) @@ -574,7 +605,7 @@ zonkTau (m@Meta tv) = do case mbtau of Nothing | Just x ← m.wildTau = do k ← zonkKind tv.kind - pure TVar{pos=getpos m, kind=k, var=x} + pure $ TauT.Var TVar{pos=getpos m, kind=k, var=x} | otherwise = pure m Just ty -> do -- short out multiple hops ty <- zonkTau ty @@ -587,33 +618,40 @@ zonkKind (KGen t) = KGen <$> mapM zonkTau t zonkKind other = pure other +substRigidSigma :: [String] -> Sigma -> Sigma substRigidSigma [] sigma = sigma substRigidSigma bound (ForAll b rho) = ForAll b (substRigidRho (filter (`notElem` map _.var b) bound) rho) - + +substRigidRho :: [String] -> Rho -> Rho substRigidRho [] rho = rho -substRigidRho bound (RhoFun ctxs sig rho) = RhoFun - (map (substRigidCtx bound) ctxs) - (substRigidSigma bound sig) - (substRigidRho bound rho) - -substRigidRho bound (RhoTau ctxs tau) = - RhoTau (map (substRigidCtx bound) ctxs) (substRigidTau bound tau) +substRigidRho bound (RhoT.Fun it) = RhoT.Fun $ RhoFun + { context = map (substRigidCtx bound) it.context + , sigma = substRigidSigma bound it.sigma + , rho = substRigidRho bound it.rho + } + +substRigidRho bound (RhoT.Tau it) = RhoT.Tau $ RhoTau + { context = map (substRigidCtx bound) it.context + , tau = substRigidTau bound it.tau + } substRigidCtx :: [String] -> Context -> Context substRigidCtx bound ctx = ctx.{tau <- substRigidTau bound} +substRigidTau :: [String] -> Tau -> Tau substRigidTau bound (TApp a b) = TApp (substRigidTau bound a) (substRigidTau bound b) substRigidTau bound (meta@Meta (Rigid {hint, kind})) -- this is what happens in the end - | hint `elem` bound = (TVar Position.null kind hint) + | hint `elem` bound = TauT.Var TVar{pos=Position.null, kind, var=hint} substRigidTau bound tau = tau - +quantified :: [Rho] -> StG [Sigma] quantified = quantifiedExcept 0 + {- * quantify a bunch of rho types * do not take a certain symbol into account @@ -650,11 +688,11 @@ quantifiedExcept exc rhos = do bind ∷ (String,MetaTv) → StG () bind (var,tv) = case tv.kind of KGen t → do - writeTv tv (TVar {pos, var, kind=KVar}) + writeTv tv (TauT.Var TVar{pos, var, kind=KVar}) t' ← mapM zonkTau t - writeTv tv (TVar {pos, var, kind=KGen t'}) - other → writeTv tv (TVar {pos, var, kind=tv.kind}) - + writeTv tv (TauT.Var TVar{pos, var, kind=KGen t'}) + _ -> writeTv tv (TauT.Var TVar{pos, var, kind=tv.kind}) + quantify rho = do sigs <- quantified [rho] @@ -668,8 +706,9 @@ canonicSignature sig = (instantiate sig >>= zonkRho) >>= quantify * get all the binders used in ForAlls in the type so that when * quantifying an outer forall we can avoid these inner ones -} +tyVarBndrs :: Rho -> [String] tyVarBndrs ty = (uniq • sort) (bndrs ty) where - bndrs (RhoFun _ (ForAll tvs arg) res) + bndrs (RhoT.Fun (RhoFun _ (ForAll tvs arg) res)) = (map _.var tvs ++ bndrs arg) ++ bndrs res bndrs _ = [] @@ -686,6 +725,7 @@ exContext g ex = case Expr.typ ex of {-- * enrich the type by all contexts found in any subexpr -} +contexts :: ExprT -> Rho -> StG Rho contexts ex typ = do g <- getST let pos = getpos ex @@ -696,11 +736,11 @@ contexts ex typ = do Lit {pos} -> simplify pos rho Ann ex ty -> do let ectx = exContext g ex - simplify pos rho.{context <- mergeCtx ectx} + simplify pos $ over RhoT._context (mergeCtx ectx) rho App fun arg _ -> do let fctx = exContext g fun let actx = exContext g arg - simplify pos rho.{context <- mergeCtx (mergeCtx fctx actx)} + simplify pos $ over RhoT._context (mergeCtx (mergeCtx fctx actx)) rho Let {env,ex} -> do let ectx = exContext g ex syms <- mapSt U.findV env @@ -711,38 +751,36 @@ contexts ex typ = do rtvss = map (ctxTvs g) rctxs let ctxs = [ ctx | (ctx,tvs) <- zip rctxs rtvss, any (MetaTv.isFlexi) tvs] let merged = fold mergeCtx rho.context [ectx,ctxs] - simplify pos rho.{context=merged} + simplify pos $ set RhoT._context merged rho Lam {ex} -> do let ectx = exContext g ex E.logmsg TRACET (getpos ex) (text ("contexts: lamrho=" ++ nicectx rho.context g ++ ", ectx=" ++ nicectx ectx g)) - simplify pos rho.{context <- mergeCtx ectx} + simplify pos $ over RhoT._context (mergeCtx ectx) rho Ifte c t e _ -> do let ctxs = map (exContext g) [c,t,e] let merged = fold mergeCtx rho.context ctxs - simplify pos rho.{context=merged} + simplify pos $ set RhoT._context merged rho Case {ex,alts} -> do let ectx = exContext g ex ctxs = map (exContext g • CAlt.ex) alts let merged = fold mergeCtx rho.context (ectx:ctxs) - simplify pos rho.{context=merged} + simplify pos $ set RhoT._context merged rho Mem {ex} -> do -- can happen when x.xyz does not typecheck let ectx = exContext g ex - simplify pos rho.{context <- mergeCtx ectx} + simplify pos $ over RhoT._context (mergeCtx ectx) rho inv -> do g <- getST E.fatal (getpos inv) (text ("contexts: Invalid expression " ++ inv.nice g)) canonicContext :: Global -> Rho -> Rho -canonicContext g (RhoTau ctxs tau) = - let rctxs = reducedCtxs g ctxs - in (RhoTau rctxs tau) -canonicContext g (RhoFun ctxs (ForAll bs rhoA) rhoB) = - let rctxs = reducedCtxs g ctxs - rho1 = canonicContext g rhoA - rho2 = canonicContext g rhoB - in (RhoFun rctxs {-merged-} (ForAll bs rho1.{context=[]}) rho2.{context=[]}) +canonicContext g (RhoT.Tau it) = + RhoT.Tau it.{context <- reducedCtxs g} +canonicContext g (RhoT.Fun it) = + let f = set RhoT._context [] . canonicContext g + in + RhoT.Fun it.{context <- reducedCtxs g, sigma <- _.{rho <- f}, rho <- f} {-- * Reduce a 'Tau' to a form where only unbound 'Meta's occur. @@ -754,9 +792,9 @@ reducedTau g (TApp a b) = TApp (reducedTau g a) (reducedTau g b) reducedTau g (meta@Meta{}) = case reduced meta g of t@Meta{} → t -- unbound tau → reducedTau g tau -- could be -> -reducedTau g (t@TVar{}) = t -reducedTau g (t@TCon{}) = t -reducedTau g (t@TSig{}) = t +reducedTau _ (t@TauT.Var _) = t +reducedTau _ (t@TauT.Con _) = t +reducedTau _ (t@TSig{}) = t {-- * reduce a list of 'Context's, so that only unbound 'Meta' remain @@ -782,12 +820,7 @@ sameCtx ca cb = ca.{cname?} && cb.{cname?} && ca.cname == cb.cname && sameTau ca --- check identity of 2 'Tau's. This works only on 'reducedTau's. sameTau :: Tau -> Tau -> Bool -sameTau (Meta a) (Meta b) = a == b -sameTau (TVar {var=a}) (TVar {var=b}) = a == b -sameTau (TCon {name=a}) (TCon {name=b}) = a == b -sameTau (TApp a b) (TApp c d) = sameTau a c && sameTau b d --- sameTau (TFun a b) (TFun c d) = sameTau a c && sameTau b d -sameTau _ _ = false +sameTau = TauT.textualEq --- if /C/ is a super class of /D/, then /D tau/ implies /C tau/ for the same tau --- example: 'Ord' a implies 'Eq' a @@ -811,17 +844,17 @@ simplify pos rho = do singler ctx = nicerctx [ctx] g context = reducedCtxs g rho.context case context of - [] -> stio rho.{context} + [] -> pure $ set RhoT._context context rho (ctx:ctxs) -> case ctx.tau.flat of [] -> Prelude.error "Tau.flat returns empty list" -- avoid case warning t1:ts | isVarMeta t1 = if (any (`implies` ctx) ctxs2) then do E.logmsg TRACET pos (text ("dropped: " ++ single ctx ++ " (implied)")) - simplify pos rho.{context=ctxs2} -- drop ctx as it is implied + simplify pos $ set RhoT._context ctxs2 rho -- drop ctx as it is implied else do E.logmsg TRACET pos (text ("retained: " ++ single ctx)) - rho <- simplify pos rho.{context=ctxs2} - stio rho.{context <- (ctx:)} + rho <- simplify pos $ set RhoT._context ctxs2 rho + pure $ over RhoT._context (ctx:) rho | otherwise = do implications <- instanceOf ctx.pos ctx.cname ctx.tau let reducedctxs = reducedCtxs g (ctx:implications) @@ -832,13 +865,13 @@ simplify pos rho = do when (not (null implications)) do E.explain pos (text ("the implications of " ++ singler ctx ++ " are " ++ joined ", " (map singler implications))) - rho <- simplify pos rho.{context = ctxs2 ++ implications} + rho <- simplify pos $ set RhoT._context (ctxs2 ++ implications) rho -- tau <- reducedTau ctx.tau stio rho -- .{context <- (ctx.{checked=true, tau}:)} where ctxs2 = filter (not • (ctx `implies`)) ctxs --- tell if this is either a 'TVar' or a 'Meta' -isVarMeta (TVar {var}) = true +isVarMeta (TauT.Var _) = true isVarMeta (Meta _) = true isVarMeta _ = false @@ -852,7 +885,7 @@ instanceOf pos qn tau = do showtn (TName pack base) = pack.raw ++ "." ++ base showtn _ = error "showtn: must be type name" case tcon of - TCon {name} -> do + TauT.Con TCon{name} -> do E.logmsg TRACET pos (text ("tcon is " ++ showtn name)) clas <- findC qn E.logmsg TRACET pos (text ("class " ++ showtn clas.name ++ " has instances for " @@ -870,7 +903,7 @@ instanceOf pos qn tau = do E.explain pos (text ("we assume there is a variable inst::" ++ nicer tau g ++ " and check if it unifies with " ++ rho.nicer g)) let inst = Local 0 "inst" - subsCheckRR (Vbl pos inst Nothing) (RhoTau [] tau) rho + subsCheckRR (Vbl pos inst Nothing) (RhoT.Tau (RhoTau [] tau)) rho stio (map _.{pos} rho.context) _ -> do E.error pos (msgdoc (nicer tau g ++ " is not, and cannot be, an instance of " ++ nice qn g)) diff --git a/frege/compiler/types/Global.fr b/frege/compiler/types/Global.fr index 00de434d..b3ede6e4 100644 --- a/frege/compiler/types/Global.fr +++ b/frege/compiler/types/Global.fr @@ -120,7 +120,7 @@ data GenSt = !Gen { xTree :: TreeMap ExprA Int --- expr table expSym :: TreeMap QName Int --- keeps track of expression numbers used for exported symbols consts :: TreeMap (Literalkind, String, Bool) Int --- constant table - symi8 :: TreeMap Symbol SymInfo8 --- cached information about symbols return/arg types + symi8 :: TreeMap (SymVal Global) SymInfo8 --- cached information about symbols return/arg types jimport :: TreeMap String Pack --- packages we have a java import statement for, by base name main :: String --- bare name of the top level class, set in GenMeta } @@ -135,8 +135,8 @@ data Global = !Global { packages :: TreeMap Pack Symtab --- map packages to symbol table namespaces :: TreeMap NSName Pack --- map namespaces to packages javaEnv :: TreeMap String ([String],[QName]) --- names of supertypes and types that implement a certain java type - genEnv :: [Symbol] --- symbols of function that is being compiled - locals :: TreeMap Int Symbol --- local ids identified by name + genEnv :: [SymV Global] --- symbols of function that is being compiled + locals :: TreeMap Int (SymV Global) --- local ids identified by name typEnv :: [QName] --- names of functions being type checked tySubst :: TreeMap Int Tau --- substitutions for type variables } where @@ -197,11 +197,11 @@ data Global = !Global { --- tell if a 'Symbol' is from the module we're just compiling ourSym :: Global -> Symbol -> Bool - ourSym g sy = our g (Symbol.name sy) + ourSym g sy = our g sy.name --- find the 'Symbol' for a 'QName', which may be a 'SymL' (symbolic link) find :: Global -> QName -> Maybe Symbol - find g (this@Local{uid}) = g.locals.lookupI uid + find g (this@Local{uid}) = fmap SymbolT.V $ g.locals.lookupI uid find g (this@TName p s) = case g.packages.lookup p of Just env -> env.lookupS this.key Nothing -> Nothing @@ -212,13 +212,13 @@ data Global = !Global { --- find a member of a type, type class or instance findm ∷ Global → QName → String → Maybe Symbol findm g t s = case findit g t of - Just sy | sy.{env?} = sy.env.lookupS s - Just (SymA {typ}) = case instTSym typ g of + Just sy | Just env <- sy.env' = env.lookupS s + Just (SymbolT.A SymA{typ}) = case instTSym typ g of Just sym | Just r <- findm g sym.name s = Just r - | ForAll _ (RhoTau{tau=tau1}) <- typ, -- look if its - [TCon{name}, _, tau2] <- tau1.flat, -- type T = Mutable s X - name == TName pPreludeIO "Mutable", -- and look into X + | RhoT.Tau RhoTau{tau=tau1} <- typ.rho, -- look if its + [TauT.Con c, _, tau2] <- tau1.flat, -- type T = Mutable s X + c.name == TName pPreludeIO "Mutable", -- and look into X Just other <- instTauSym tau2 g = findm g other.name s | otherwise = Nothing Nothing -> Nothing @@ -230,7 +230,7 @@ data Global = !Global { Nothing -> Nothing --- follow a symbolic link follow ∷ Global → Symbol → Maybe Symbol - follow g (ali@SymL {alias}) = findit g alias + follow g (SymbolT.L SymL{alias}) = findit g alias follow g sym = Just sym --- tell if the 'MetaTv' is bound @@ -257,21 +257,23 @@ inPrelude p g = (p `elem` map fst preludePacks) --- Determine type symbol of some type --- This is either a function, or basically a 'Tau' type -instTSym ∷ Sigma → Global → Maybe Symbol -instTSym (ForAll _ (RhoTau _ tau)) g = instTauSym tau g --- no need to deconstruct this again -instTSym _ {- (ForAll _ (RhoFun{})) -} g = g.findit (TName pPreludeBase "->") - - --- instTSym _ g = Nothing +instTSym :: Sigma -> Global -> Maybe (SymT Global) +instTSym (ForAll _ (RhoT.Tau RhoTau{tau})) g = instTauSym tau g +instTSym _ g = fmap assertSymT (g.findit (TName pPreludeBase "->")) + where + assertSymT (SymbolT.T symt) = symt + assertSymT _ = error "instTSym: frege.PreludeBase.(->) not a SymT??" --- return type symbol for constructor of tau, if any -instTauSym ∷ Tau → Global → Maybe Symbol +instTauSym :: Tau -> Global -> Maybe (SymT Global) instTauSym tau g = case tau of - TCon {name} -> Global.findit g name + TauT.Con c -> fmap (assertSymT c.name) $ g.findit c.name TApp a _ -> instTauSym a g _ -> Nothing + where + assertSymT _ (SymbolT.T symt) = symt + assertSymT name _ = error $ "instTauSym: TCon{name=" ++ show name ++ "} refers to a non-SymT??" --- The names of the java primitive types diff --git a/frege/compiler/types/SourceDefinitions.fr b/frege/compiler/types/SourceDefinitions.fr index 0dd1b367..bcc18474 100644 --- a/frege/compiler/types/SourceDefinitions.fr +++ b/frege/compiler/types/SourceDefinitions.fr @@ -24,39 +24,98 @@ infixl 16 `App` `nApp` `TApp` * definitions -} data DefinitionS = - ImpDcl {pos::Position, pack::String, as::Maybe String, - imports::ImportList} - | FixDcl {pos::Position, opid::TokenID, ops::[String]} - | DocDcl {pos::Position, text::String} - | TypDcl {pos::Position, vis::Visibility, name::String, - vars::[TauS], typ::SigmaS, doc::Maybe String} - | ClaDcl {pos::Position, vis::Visibility, name::String, - clvar::TauS, supers::[SName], - defs::[DefinitionS], doc::Maybe String} - | InsDcl {pos::Position, vis::Visibility, - clas::SName, typ::SigmaS, - defs::[DefinitionS], doc::Maybe String} - | DrvDcl {pos::Position, vis::Visibility, - clas::SName, typ::SigmaS, - doc::Maybe String} - | AnnDcl {pos::Position, vis::Visibility, name::String, typ::SigmaS, doc::Maybe String} - | NatDcl {pos::Position, vis::Visibility, name::String, txs::[SigExs], - meth::String, isPure::Bool, gargs::Maybe [TauS], doc::Maybe String} - | FunDcl {vis::Visibility, lhs::ExprS, - pats::[ExprS], expr::ExprS, - doc::Maybe String, - positions::[Token] --- the tokens that introduce the equally named definitions - } - | DatDcl {pos::Position, vis::Visibility, name::String, newt :: Bool, - vars::[TauS], ctrs::[DCon], defs::[DefinitionS], - doc::Maybe String} - | JavDcl {pos::Position, vis::Visibility, name::String, isPure::Bool, - jclas::String, vars::[TauS], gargs::Maybe [TauS], defs::[DefinitionS], - doc::Maybe String} - | ModDcl {pos::Position, extending::Maybe TauS, implementing::[TauS], code::[Token]} + protected Imp ImpDcl + | protected Fix FixDcl + | protected Doc DocDcl + | protected Typ TypDcl + | protected Cla ClaDcl + | protected Ins InsDcl + | protected Drv DrvDcl + | protected Ann AnnDcl + | protected Nat NatDcl + | protected Fun FunDcl + | protected Dat DatDcl + | protected Jav JavDcl + | protected Mod ModDcl + +--- A sum type of definitions which are valid members of a @class@ excluding documentation +data ClassMemberS = + protected Ann AnnDcl + | protected Nat NatDcl + | protected Fun FunDcl + where + toDefinitionS :: ClassMemberS -> DefinitionS + toDefinitionS (Ann x) = DefinitionS.Ann x + toDefinitionS (Nat x) = DefinitionS.Nat x + toDefinitionS (Fun x) = DefinitionS.Fun x + fromDefinitionS :: DefinitionS -> Maybe ClassMemberS + fromDefinitionS (DefinitionS.Ann x) = Just $ Ann x + fromDefinitionS (DefinitionS.Nat x) = Just $ Nat x + fromDefinitionS (DefinitionS.Fun x) = Just $ Fun x + fromDefinitionS _ = Nothing + vis :: ClassMemberS -> Visibility + vis (Ann AnnDcl{vis=v}) = v + vis (Nat NatDcl{vis=v}) = v + vis (Fun FunDcl{vis=v}) = v + chgVis :: ClassMemberS -> (Visibility -> Visibility) -> ClassMemberS + chgVis (Ann x) f = Ann $ x.{vis <- f} + chgVis (Nat x) f = Nat $ x.{vis <- f} + chgVis (Fun x) f = Fun $ x.{vis <- f} + +{-- + - A sum type of definitions which are valid members of @let@ expressions or + - @where@ clauses on ordinary functions. + -} +data LetMemberS = + protected Ann AnnDcl + | protected Fun FunDcl + where + toDefinitionS :: LetMemberS -> DefinitionS + toDefinitionS (Ann x) = DefinitionS.Ann x + toDefinitionS (Fun x) = DefinitionS.Fun x + fromDefinitionS :: DefinitionS -> Maybe LetMemberS + fromDefinitionS (DefinitionS.Ann x) = Just $ Ann x + fromDefinitionS (DefinitionS.Fun x) = Just $ Fun x + fromDefinitionS _ = Nothing + +data ImpDcl = ImpDcl {pos::Position, pack::String, as::Maybe String, + imports::ImportList} +data FixDcl = FixDcl {pos::Position, opid::TokenID, ops::[String]} +data DocDcl = DocDcl {pos::Position, text::String} +data TypDcl = TypDcl {pos::Position, vis::Visibility, name::String, + vars::[TVar SName], typ::SigmaS, doc::Maybe String} +data ClaDcl = ClaDcl {pos::Position, vis::Visibility, name::String, + clvar::TVar SName, supers::[SName], + defs::[DefinitionS], doc::Maybe String} + where + -- after the @fix@ pass, all of 'ClaDcl.defs' should return 'Just' if applied to + -- 'ClassMemberS.fromDefinitionS' + members :: ClaDcl -> [ClassMemberS] + members this = mapMaybe ClassMemberS.fromDefinitionS this.defs +data InsDcl = InsDcl {pos::Position, vis::Visibility, + clas::SName, typ::SigmaS, + defs::[DefinitionS], doc::Maybe String} +data DrvDcl = DrvDcl {pos::Position, vis::Visibility, + clas::SName, typ::SigmaS, + doc::Maybe String} +data AnnDcl = AnnDcl {pos::Position, vis::Visibility, name::String, typ::SigmaS, doc::Maybe String} +data NatDcl = NatDcl {pos::Position, vis::Visibility, name::String, txs::[SigExs], + meth::String, isPure::Bool, gargs::Maybe [TVar SName], doc::Maybe String} +data FunDcl = FunDcl {vis::Visibility, lhs::ExprS, + pats::[ExprS], expr::ExprS, + doc::Maybe String, + positions::[Token]} --- the tokens that introduce the equally named definitions +data DatDcl = DatDcl {pos::Position, vis::Visibility, name::String, newt :: Bool, + vars::[TVar SName], ctrs::[DCon], defs::[DefinitionS], + doc::Maybe String} +data JavDcl = JavDcl {pos::Position, vis::Visibility, name::String, isPure::Bool, + jclas::String, vars::[TVar SName], gargs::Maybe [TVar SName], defs::[DefinitionS], + doc::Maybe String} +data ModDcl = ModDcl {pos::Position, extending::Maybe TauS, implementing::[TauS], code::[Token]} --- Is this a function binding? --- If so, return the identifier. +funbinding :: FunDcl -> Maybe Token funbinding FunDcl{lhs = Vbl{name=Simple{id}},pats} | null pats = Just id | id.value != "!", @@ -157,7 +216,7 @@ data ExprS = | !ConFS { name::SName, fields::[(String, ExprS)] } --- > Con{field1 = ex1, field2 = ex2} | !App { fun, arg::ExprS } --- > fun arg - | !Let { defs::[DefinitionS], ex :: ExprS } --- > let {defs} in ex + | !Let { defs::[LetMemberS], ex :: ExprS } --- > let {defs} in ex | !Lam { pat, ex::ExprS, fromDO :: Bool } --- > \pat -> ex | !Ifte { cnd, thn, els::ExprS } --- > if cnd then thn else els | !Mem { ex::ExprS, member::Token } --- > ex.member diff --git a/frege/compiler/types/Symbols.fr b/frege/compiler/types/Symbols.fr index 91a40d18..42f46dd8 100644 --- a/frege/compiler/types/Symbols.fr +++ b/frege/compiler/types/Symbols.fr @@ -3,6 +3,7 @@ module frege.compiler.types.Symbols where import frege.data.TreeMap as TM(TreeMap, each, values) import frege.control.monad.State +import frege.compiler.common.Lens (preview) import frege.compiler.enums.RFlag(RState, RFlag) import frege.compiler.types.Positions import frege.compiler.types.Strictness @@ -20,74 +21,443 @@ import frege.compiler.enums.TokenID --- A delayed expressions that will be build on demand. type ExprD a = State a Expr +--- data type +data SymT global = !SymT + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, + kind::Kind, typ::Sigma, env::TreeMap String (SymbolT global), nativ::Maybe String, + gargs::[TVar QName] --- generic arguments of a native type + product::Bool --- indicate product type + enum::Bool --- indicates enumeration type + pur::Bool --- indicates *pure native* types + newt::Bool --- indicates *newtype* + } + +--- alias name +data SymL global = !SymL + { sid::Int, pos::Position, vis::Visibility, name::QName, alias::QName } + +--- data constructor +data SymD global = !SymD + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, + cid::Int --- constructor number + typ::Sigma, flds::[ConField QName], + strsig :: Strictness, + op :: TokenID --- how to use as operator + } + +--- class +data SymC global = !SymC + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, + clvar::TVar QName, supers::[QName], insts::[(QName, QName)], + meth::TreeMap String (SymMeth global) + } + +--- instance +data SymI global = !SymI + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, + clas::QName, typ::Sigma, + meth::TreeMap String (SymMeth global) + } + +--- variable or function +data SymV global = !SymV + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, + typ::Sigma, + --- For imported expressions, we will make them on demand + expr::Maybe (ExprD global), + nativ::Maybe String, + pur::Bool, anno::Bool, exported::Bool, state::SymState, + strsig :: Strictness, depth :: Int, rkind :: RState, + throwing :: [Tau] --- list of exceptions thrown + over :: [QName ] --- list of overloaded members, if any + gargs::[TVar QName]--- generic arguments that must be used on the method + op :: TokenID --- how to use as operator + } + where + -- functions for querying the field 'Symbol.rkind' + --- Check certain bit in 'Symbol.rkind' + has :: SymV a -> RFlag -> Bool + has sym bit = bit RState.`member` sym.rkind + --- Check if this is 'RMethod' + isMethod sym = has sym RMethod + gExpr SymV{expr} g = fmap (\x -> evalState x g) expr + +--- type alias +data SymA global = !SymA + { sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, + kind::Kind, typ::Sigma, vars::[TVar QName] + } + +--- generalized value +--- variable, function, or data constructor +data SymVal global + = protected !D (SymD global) + | protected !V (SymV global) + where + toSymbol :: SymVal g -> SymbolT g + toSymbol (D s) = SymbolT.D s + toSymbol (V s) = SymbolT.V s + fromSymbol :: SymbolT g -> Maybe (SymVal g) + fromSymbol (SymbolT.D s) = Just (D s) + fromSymbol (SymbolT.V s) = Just (V s) + fromSymbol _ = Nothing + + name :: SymVal g -> QName + name (D s) = s.name + name (V s) = s.name + op :: SymVal g -> TokenID + op (D s) = s.op + op (V s) = s.op + pos :: SymVal g -> Position + pos (D s) = s.pos + pos (V s) = s.pos + sid :: SymVal g -> Int + sid (D s) = s.sid + sid (V s) = s.sid + strsig :: SymVal g -> Strictness + strsig (D s) = s.strsig + strsig (V s) = s.strsig + typ :: SymVal g -> Sigma + typ (D s) = s.typ + typ (V s) = s.typ + + -- _name :: Lens' (SymVal g) QName + _name :: Functor f => (QName -> f QName) -> SymVal g -> f (SymVal g) + _name f (D s) = (\name -> D s.{name}) <$> f s.name + _name f (V s) = (\name -> V s.{name}) <$> f s.name + -- _op :: Lens' (SymVal g) TokenID + _op :: Functor f => (TokenID -> f TokenID) -> SymVal g -> f (SymVal g) + _op f (D s) = (\op -> D s.{op}) <$> f s.op + _op f (V s) = (\op -> V s.{op}) <$> f s.op + -- _pos :: Lens' (SymVal g) Position + _pos :: Functor f => (Position -> f Position) -> SymVal g -> f (SymVal g) + _pos f (D s) = (\pos -> D s.{pos}) <$> f s.pos + _pos f (V s) = (\pos -> V s.{pos}) <$> f s.pos + -- _sid :: Lens' (SymVal g) Int + _sid :: Functor f => (Int -> f Int) -> SymVal g -> f (SymVal g) + _sid f (D s) = (\sid -> D s.{sid}) <$> f s.sid + _sid f (V s) = (\sid -> V s.{sid}) <$> f s.sid + -- _strsig :: Lens' (SymVal g) Strictness + _strsig :: Functor f => (Strictness -> f Strictness) -> SymVal g -> f (SymVal g) + _strsig f (D s) = (\strsig -> D s.{strsig}) <$> f s.strsig + _strsig f (V s) = (\strsig -> V s.{strsig}) <$> f s.strsig + -- _typ :: Lens' (SymVal g) Sigma + _typ :: Functor f => (Sigma -> f Sigma) -> SymVal g -> f (SymVal g) + _typ f (D s) = (\typ -> D s.{typ}) <$> f s.typ + _typ f (V s) = (\typ -> V s.{typ}) <$> f s.typ + +--- the type of 'SymI.env' +--- method of a class +data SymMeth global + = --- inherited by super classes + protected !L (SymL global) + | --- ordinary members (methods) + protected !V (SymV global) + where + toSymbol :: SymMeth g -> SymbolT g + toSymbol (L s) = SymbolT.L s + toSymbol (V s) = SymbolT.V s + fromSymbol :: SymbolT g -> Maybe (SymMeth g) + fromSymbol (SymbolT.L s) = Just (L s) + fromSymbol (SymbolT.V s) = Just (V s) + fromSymbol _ = Nothing + + name :: SymMeth g -> QName + name (L s) = s.name + name (V s) = s.name + pos :: SymMeth g -> Position + pos (L s) = s.pos + pos (V s) = s.pos + + -- _name :: Lens' (SymMeth g) QName + _name :: Functor f => (QName -> f QName) -> SymMeth g -> f (SymMeth g) + _name f (L s) = (\name -> L s.{name}) <$> f s.name + _name f (V s) = (\name -> V s.{name}) <$> f s.name + -- _pos :: Lens' (SymMeth g) Position + _pos :: Functor f => (Position -> f Position) -> SymMeth g -> f (SymMeth g) + _pos f (L s) = (\pos -> L s.{pos}) <$> f s.pos + _pos f (V s) = (\pos -> V s.{pos}) <$> f s.pos + + -- _L :: Traversal' (SymMeth g) (SymL g) + _L :: Applicative f => (SymL g -> f (SymL g)) -> SymMeth g -> f (SymMeth g) + _L f (L s) = L <$> f s + _L _ s = pure s + -- _V :: Traversal' (SymMeth g) (SymV g) + _V :: Applicative f => (SymV g -> f (SymV g)) -> SymMeth g -> f (SymMeth g) + _V f (V s) = V <$> f s + _V _ s = pure s {-- The information stored in the 'Symtab' nodes. -} data SymbolT global = - !SymT {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, - kind::Kind, typ::Sigma, env::TreeMap String (SymbolT global), nativ::Maybe String, - gargs::[Tau] --- generic arguments of a native type - product::Bool --- indicate product type - enum::Bool --- indicates enumeration type - pur::Bool --- indicates *pure native* types - newt::Bool --- indicates *newtype* - } --- data type - | !SymL {sid::Int, pos::Position, vis::Visibility, name::QName, - alias::QName} --- alias name - | !SymD {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, - cid::Int --- constructor number - typ::Sigma, flds::[ConField QName], - strsig :: Strictness, - op :: TokenID --- how to use as operator - } --- data constructor - | !SymC {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name::QName, - tau::Tau, supers::[QName], insts::[(QName, QName)], - env::TreeMap String (SymbolT global)} --- class - | !SymI {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, - clas::QName, typ::Sigma, - env::TreeMap String (SymbolT global)} --- instance - | !SymV {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, - typ::Sigma, - --- For imported expressions, we will make them on demand - expr::Maybe (ExprD global), - nativ::Maybe String, - pur::Bool, anno::Bool, exported::Bool, state::SymState, - strsig :: Strictness, depth :: Int, rkind :: RState, - throwing :: [Tau] --- list of exceptions thrown - over :: [QName ] --- list of overloaded members, if any - gargs::[Tau] --- generic arguments that must be used on the method - op :: TokenID --- how to use as operator - } --- variable or function - | !SymA {sid::Int, pos::Position, vis::Visibility, doc::Maybe String, name ::QName, - kind::Kind, typ::Sigma, vars::[Tau]} --- type alias + protected !T (SymT global) --- data type + | protected !L (SymL global) --- alias name + | protected !D (SymD global) --- data constructor + | protected !C (SymC global) --- class + | protected !I (SymI global) --- instance + | protected !V (SymV global) --- variable or function + | protected !A (SymA global) --- type alias where + hashCode :: SymbolT global -> Int hashCode = SymbolT.sid - gExpr SymV{expr=Just x} g = Just (evalState x g) - gExpr _ _ = Nothing - -- functions for querying the field 'Symbol.rkind' - --- Check certain bit in 'Symbol.rkind' - has ∷ SymbolT a → RFlag → Bool - has sym bit = bit RState.`member` sym.rkind - --- Check if this is 'RMethod' - isMethod sym = has sym RMethod + + name :: SymbolT g -> QName + name (T s) = s.name + name (L s) = s.name + name (D s) = s.name + name (C s) = s.name + name (I s) = s.name + name (V s) = s.name + name (A s) = s.name + pos :: SymbolT g -> Position + pos (T s) = s.pos + pos (L s) = s.pos + pos (D s) = s.pos + pos (C s) = s.pos + pos (I s) = s.pos + pos (V s) = s.pos + pos (A s) = s.pos + sid :: SymbolT g -> Int + sid (T s) = s.sid + sid (L s) = s.sid + sid (D s) = s.sid + sid (C s) = s.sid + sid (I s) = s.sid + sid (V s) = s.sid + sid (A s) = s.sid + vis :: SymbolT g -> Visibility + vis (T s) = s.vis + vis (L s) = s.vis + vis (D s) = s.vis + vis (C s) = s.vis + vis (I s) = s.vis + vis (V s) = s.vis + vis (A s) = s.vis + + -- _doc :: Traversal' (SymbolT g) (Maybe String) + _doc :: Applicative f => (Maybe String -> f (Maybe String)) -> SymbolT g -> f (SymbolT g) + _doc f (T s) = (\doc -> T s.{doc}) <$> f s.doc + _doc _ (sym@(L _)) = pure sym + _doc f (D s) = (\doc -> D s.{doc}) <$> f s.doc + _doc f (C s) = (\doc -> C s.{doc}) <$> f s.doc + _doc f (I s) = (\doc -> I s.{doc}) <$> f s.doc + _doc f (V s) = (\doc -> V s.{doc}) <$> f s.doc + _doc f (A s) = (\doc -> A s.{doc}) <$> f s.doc + -- _kind :: Traversal' (SymbolT g) Kind + _kind :: Applicative f => (Kind -> f Kind) -> SymbolT g -> f (SymbolT g) + _kind f (T s) = (\kind -> T s.{kind}) <$> f s.kind + _kind _ (sym@(L _)) = pure sym + _kind _ (sym@(D _)) = pure sym + _kind _ (sym@(C _)) = pure sym + _kind _ (sym@(I _)) = pure sym + _kind _ (sym@(V _)) = pure sym + _kind f (A s) = (\kind -> A s.{kind}) <$> f s.kind + -- _meth :: Traversal' (SymbolT g) (TreeMap String (SymMeth g)) + _meth :: Applicative f => (TreeMap String (SymMeth g) -> f (TreeMap String (SymMeth g))) -> SymbolT g -> f (SymbolT g) + _meth _ (sym@(T _)) = pure sym + _meth _ (sym@(L _)) = pure sym + _meth _ (sym@(D _)) = pure sym + _meth f (C s) = (\meth -> C s.{meth}) <$> f s.meth + _meth f (I s) = (\meth -> I s.{meth}) <$> f s.meth + _meth _ (sym@(V _)) = pure sym + _meth _ (sym@(A _)) = pure sym + -- _name :: Lens' (SymbolT g) QName + _name :: Functor f => (QName -> f QName) -> SymbolT g -> f (SymbolT g) + _name f (T s) = (\name -> T s.{name}) <$> f s.name + _name f (L s) = (\name -> L s.{name}) <$> f s.name + _name f (D s) = (\name -> D s.{name}) <$> f s.name + _name f (C s) = (\name -> C s.{name}) <$> f s.name + _name f (I s) = (\name -> I s.{name}) <$> f s.name + _name f (V s) = (\name -> V s.{name}) <$> f s.name + _name f (A s) = (\name -> A s.{name}) <$> f s.name + -- _nativ :: Traversal' (SymbolT g) (Maybe String) + _nativ :: Applicative f => (Maybe String -> f (Maybe String)) -> SymbolT g -> f (SymbolT g) + _nativ f (T s) = (\nativ -> T s.{nativ}) <$> f s.nativ + _nativ _ (sym@(L _)) = pure sym + _nativ _ (sym@(D _)) = pure sym + _nativ _ (sym@(C _)) = pure sym + _nativ _ (sym@(I _)) = pure sym + _nativ f (V s) = (\nativ -> V s.{nativ}) <$> f s.nativ + _nativ _ (sym@(A _)) = pure sym + -- _op :: Traversal' (SymbolT g) TokenID + _op :: Applicative f => (TokenID -> f TokenID) -> SymbolT g -> f (SymbolT g) + _op _ (sym@(T _)) = pure sym + _op _ (sym@(L _)) = pure sym + _op f (D s) = (\op -> D s.{op}) <$> f s.op + _op _ (sym@(C _)) = pure sym + _op _ (sym@(I _)) = pure sym + _op f (V s) = (\op -> V s.{op}) <$> f s.op + _op _ (sym@(A _)) = pure sym + -- _pos :: Lens' (SymbolT g) Position + _pos :: Functor f => (Position -> f Position) -> SymbolT g -> f (SymbolT g) + _pos f (T s) = (\pos -> T s.{pos}) <$> f s.pos + _pos f (L s) = (\pos -> L s.{pos}) <$> f s.pos + _pos f (D s) = (\pos -> D s.{pos}) <$> f s.pos + _pos f (C s) = (\pos -> C s.{pos}) <$> f s.pos + _pos f (I s) = (\pos -> I s.{pos}) <$> f s.pos + _pos f (V s) = (\pos -> V s.{pos}) <$> f s.pos + _pos f (A s) = (\pos -> A s.{pos}) <$> f s.pos + -- _pur :: Traversal' (SymbolT g) Bool + _pur :: Applicative f => (Bool -> f Bool) -> SymbolT g -> f (SymbolT g) + _pur f (T s) = (\pur -> T s.{pur}) <$> f s.pur + _pur _ (sym@(L _)) = pure sym + _pur _ (sym@(D _)) = pure sym + _pur _ (sym@(C _)) = pure sym + _pur _ (sym@(I _)) = pure sym + _pur f (V s) = (\pur -> V s.{pur}) <$> f s.pur + _pur _ (sym@(A _)) = pure sym + -- _sid :: Lens' (SymbolT g) Int + _sid :: Functor f => (Int -> f Int) -> SymbolT g -> f (SymbolT g) + _sid f (T s) = (\sid -> T s.{sid}) <$> f s.sid + _sid f (L s) = (\sid -> L s.{sid}) <$> f s.sid + _sid f (D s) = (\sid -> D s.{sid}) <$> f s.sid + _sid f (C s) = (\sid -> C s.{sid}) <$> f s.sid + _sid f (I s) = (\sid -> I s.{sid}) <$> f s.sid + _sid f (V s) = (\sid -> V s.{sid}) <$> f s.sid + _sid f (A s) = (\sid -> A s.{sid}) <$> f s.sid + -- _strsig :: Traversal' (SymbolT g) Strictness + _strsig :: Applicative f => (Strictness -> f Strictness) -> SymbolT g -> f (SymbolT g) + _strsig _ (sym@(T _)) = pure sym + _strsig _ (sym@(L _)) = pure sym + _strsig f (D s) = (\strsig -> D s.{strsig}) <$> f s.strsig + _strsig _ (sym@(C _)) = pure sym + _strsig _ (sym@(I _)) = pure sym + _strsig f (V s) = (\strsig -> V s.{strsig}) <$> f s.strsig + _strsig _ (sym@(A _)) = pure sym + -- _typ :: Traversal' (SymbolT g) Sigma + _typ :: Applicative f => (Sigma -> f Sigma) -> SymbolT g -> f (SymbolT g) + _typ f (T s) = (\typ -> T s.{typ}) <$> f s.typ + _typ _ (sym@(L _)) = pure sym + _typ f (D s) = (\typ -> D s.{typ}) <$> f s.typ + _typ _ (sym@(C _)) = pure sym + _typ f (I s) = (\typ -> I s.{typ}) <$> f s.typ + _typ f (V s) = (\typ -> V s.{typ}) <$> f s.typ + _typ f (A s) = (\typ -> A s.{typ}) <$> f s.typ + -- _vis :: Lens' (SymbolT g) Visibility + _vis :: Functor f => (Visibility -> f Visibility) -> SymbolT g -> f (SymbolT g) + _vis f (T s) = (\vis -> T s.{vis}) <$> f s.vis + _vis f (L s) = (\vis -> L s.{vis}) <$> f s.vis + _vis f (D s) = (\vis -> D s.{vis}) <$> f s.vis + _vis f (C s) = (\vis -> C s.{vis}) <$> f s.vis + _vis f (I s) = (\vis -> I s.{vis}) <$> f s.vis + _vis f (V s) = (\vis -> V s.{vis}) <$> f s.vis + _vis f (A s) = (\vis -> A s.{vis}) <$> f s.vis + + --- a generalized read-only view of 'env' + env' :: SymbolT g -> Maybe (TreeMap String (SymbolT g)) + env' (T s) = Just s.env + env' s = fmap (fmap SymMeth.toSymbol) $ preview _meth s + -- TODO add for performance? + -- envValues' :: SymbolT g -> Maybe [SymbolT g] + + -- _T :: Traversal' (SymbolT g) (SymT g) + _T :: Applicative f => (SymT g -> f (SymT g)) -> SymbolT g -> f (SymbolT g) + _T f (T s) = T <$> f s + _T _ s = pure s + -- _L :: Traversal' (SymbolT g) (SymL g) + _L :: Applicative f => (SymL g -> f (SymL g)) -> SymbolT g -> f (SymbolT g) + _L f (L s) = L <$> f s + _L _ s = pure s + -- _D :: Traversal' (SymbolT g) (SymD g) + _D :: Applicative f => (SymD g -> f (SymD g)) -> SymbolT g -> f (SymbolT g) + _D f (D s) = D <$> f s + _D _ s = pure s + -- _C :: Traversal' (SymbolT g) (SymC g) + _C :: Applicative f => (SymC g -> f (SymC g)) -> SymbolT g -> f (SymbolT g) + _C f (C s) = C <$> f s + _C _ s = pure s + -- _I :: Traversal' (SymbolT g) (SymI g) + _I :: Applicative f => (SymI g -> f (SymI g)) -> SymbolT g -> f (SymbolT g) + _I f (I s) = I <$> f s + _I _ s = pure s + -- _V :: Traversal' (SymbolT g) (SymV g) + _V :: Applicative f => (SymV g -> f (SymV g)) -> SymbolT g -> f (SymbolT g) + _V f (V s) = V <$> f s + _V _ s = pure s + -- _A :: Traversal' (SymbolT g) (SymA g) + _A :: Applicative f => (SymA g -> f (SymA g)) -> SymbolT g -> f (SymbolT g) + _A f (A s) = A <$> f s + _A _ s = pure s + + -- _Val :: Traversal' (SymbolT g) (SymVal g) + _Val :: Applicative f => (SymVal g -> f (SymVal g)) -> SymbolT g -> f (SymbolT g) + _Val f s = case SymVal.fromSymbol s of + Just sv -> SymVal.toSymbol <$> f sv + Nothing -> pure s + -- _Meth :: Traversal' (SymbolT g) (SymMeth g) + _Meth :: Applicative f => (SymMeth g -> f (SymMeth g)) -> SymbolT g -> f (SymbolT g) + _Meth f s = case SymMeth.fromSymbol s of + Just sm -> SymMeth.toSymbol <$> f sm + Nothing -> pure s + + + +instance Ord (SymT g) where + sym1 <=> sym2 = SymbolT.T sym1 <=> SymbolT.T sym2 + sym1 == sym2 = SymbolT.T sym1 == SymbolT.T sym2 + sym1 != sym2 = SymbolT.T sym1 != SymbolT.T sym2 + hashCode = hashCode . SymbolT.T +instance Ord (SymL g) where + sym1 <=> sym2 = SymbolT.L sym1 <=> SymbolT.L sym2 + sym1 == sym2 = SymbolT.L sym1 == SymbolT.L sym2 + sym1 != sym2 = SymbolT.L sym1 != SymbolT.L sym2 + hashCode = hashCode . SymbolT.L +instance Ord (SymD g) where + sym1 <=> sym2 = SymbolT.D sym1 <=> SymbolT.D sym2 + sym1 == sym2 = SymbolT.D sym1 == SymbolT.D sym2 + sym1 != sym2 = SymbolT.D sym1 != SymbolT.D sym2 + hashCode = hashCode . SymbolT.D +instance Ord (SymC g) where + sym1 <=> sym2 = SymbolT.C sym1 <=> SymbolT.C sym2 + sym1 == sym2 = SymbolT.C sym1 == SymbolT.C sym2 + sym1 != sym2 = SymbolT.C sym1 != SymbolT.C sym2 + hashCode = hashCode . SymbolT.C +instance Ord (SymI g) where + sym1 <=> sym2 = SymbolT.I sym1 <=> SymbolT.I sym2 + sym1 == sym2 = SymbolT.I sym1 == SymbolT.I sym2 + sym1 != sym2 = SymbolT.I sym1 != SymbolT.I sym2 + hashCode = hashCode . SymbolT.I +instance Ord (SymV g) where + sym1 <=> sym2 = SymbolT.V sym1 <=> SymbolT.V sym2 + sym1 == sym2 = SymbolT.V sym1 == SymbolT.V sym2 + sym1 != sym2 = SymbolT.V sym1 != SymbolT.V sym2 + hashCode = hashCode . SymbolT.V +instance Ord (SymA g) where + sym1 <=> sym2 = SymbolT.A sym1 <=> SymbolT.A sym2 + sym1 == sym2 = SymbolT.A sym1 == SymbolT.A sym2 + sym1 != sym2 = SymbolT.A sym1 != SymbolT.A sym2 + hashCode = hashCode . SymbolT.A + +instance Ord (SymVal g) where + sym1 <=> sym2 = sym1.toSymbol <=> sym2.toSymbol + sym1 == sym2 = sym1.toSymbol == sym2.toSymbol + sym1 != sym2 = sym1.toSymbol != sym2.toSymbol + hashCode = hashCode . _.toSymbol + +instance Ord (SymMeth g) where + sym1 <=> sym2 = sym1.toSymbol <=> sym2.toSymbol + sym1 == sym2 = sym1.toSymbol == sym2.toSymbol + sym1 != sym2 = sym1.toSymbol != sym2.toSymbol + hashCode = hashCode . _.toSymbol --- Symbols ordered by the 'Symbol.sid' field, which is a unique number. --- This allows us to have sets of symbols. instance Ord (SymbolT g) where - sym1 <=> sym2 = (SymbolT.sid sym1). <=> (SymbolT.sid sym2) - sym1 == sym2 = (SymbolT.sid sym1). == (SymbolT.sid sym2) - sym1 != sym2 = (SymbolT.sid sym1). != (SymbolT.sid sym2) + sym1 <=> sym2 = sym1.sid <=> sym2.sid + sym1 == sym2 = sym1.sid == sym2.sid + sym1 != sym2 = sym1.sid != sym2.sid +instance Positioned (SymMeth g) where + is = is . _.toSymbol + getpos = getpos . _.toSymbol + getrange = getrange . _.toSymbol instance Positioned (SymbolT g) where is x = "" getpos = SymbolT.pos - getrange sym - | sym.{env?} = fold Position.merge sym.pos (map getrange (values sym.env)) - -- SymV{expr = Just x} <- sym = sym.pos.merge x.getrange - | otherwise = getpos sym - -- untyped = id - - + getrange sym = + case sym.env' of + Just env -> fold Position.merge sym.pos (map getrange (values env)) + Nothing -> getpos sym diff --git a/frege/compiler/types/Types.fr b/frege/compiler/types/Types.fr index 3e10573f..a071b107 100644 --- a/frege/compiler/types/Types.fr +++ b/frege/compiler/types/Types.fr @@ -1,6 +1,7 @@ --- The data types to represent types. module frege.compiler.types.Types where +import frege.compiler.common.Lens (preview) import frege.compiler.types.Positions import frege.compiler.types.SNames import frege.compiler.types.Packs @@ -54,8 +55,24 @@ keq apple orange = false derive ArrayElement (KindT s) +--- type constructor +data TCon s = TCon {!pos::Position, !name::s} +--- type variable quantified over +data TVar s = TVar {!pos::Position, !kind::KindT s, !var::String} + where + varkind :: TVar s -> (String, KindT s) + varkind TVar{var, kind} = (var, kind) + --- see 'TauT.wildTau' + wildTau :: TVar a -> Maybe String + wildTau TVar{kind=KGen{}, var} | var == "<" || var == ">" = Just var + wildTau _ = Nothing + + -- _kind :: Lens (TVar s) (TVar t) (KindT s) (KindT t) + _kind :: Functor f => (KindT s -> f (KindT t)) -> TVar s -> f (TVar t) + _kind f t = t.{kind=} <$> f t.kind + {-- Represents type variables in type checking @@ -143,17 +160,15 @@ type MetaTv = MetaTvT QName -} data TauT s = !TApp (TauT s) (TauT s) --- type application - | !TCon {pos::Position, name::s} --- type constructor - | !TVar {pos::Position, kind::KindT s, var::String} --- type variable quantified over + | protected !Con (TCon s) --- type constructor + | protected !Var (TVar s) --- type variable quantified over | !TSig (SigmaT s) -- only used in parser for now | !Meta (MetaTvT s) --- type variable where - varkind (TVar{var,kind}) = (var,kind) - varkind _ = error "varkind only applicable to TVar" --- Convenience function to create a function type @a->b@ - tfun a b = TApp (TApp (TCon Position.null (TName pPreludeBase "->")) a) b + tfun a b = TApp (TApp (Con TCon{pos=Position.null, name=TName pPreludeBase "->"}) a) b --- Unpack a function type - getFun (TApp (TApp TCon{name = TName p "->"} a) b) | p == pPreludeBase = Just (a,b) + getFun (TApp (TApp (Con TCon{name = TName p "->"}) a) b) | p == pPreludeBase = Just (a,b) getFun _ = Nothing --- Tell if this is a function type. isFun = maybe false (const true) • getFun @@ -174,30 +189,47 @@ data TauT s = --- - type constructors and variables match only if their names are textually equal. --- This function is necessary and used only in kind inference. textualEq ∷ Eq a ⇒ TauT a → TauT a → Bool - textualEq (TApp a b) (TApp c d) = a.textualEq c && b.textualEq d - textualEq TCon{name=a} TCon{name=b} = a == b - textualEq TVar{var=a} TVar{var=b} = a == b - textualEq (Meta a) (Meta b) = a == b - textualEq apfel birne = false + textualEq (TApp a b) (TApp c d) = a.textualEq c && b.textualEq d + textualEq (Con a) (Con b) = a.name == b.name + textualEq (Var a) (Var b) = a.var == b.var + textualEq (Meta a) (Meta b) = a == b + textualEq _ _ = false --- tell if this 'TVar' or 'MetaTv' is generic isGeneric ∷ TauT α → Bool - isGeneric TVar{pos, kind=KGen{}, var} = true + isGeneric (Var TVar{kind=KGen{}}) = true isGeneric (Meta mt) | KGen{} ← mt.kind = true isGeneric _ = false --- Returns @Just ">"@ or @Just "<"@ if this is a generic wildcard, otherwise @Nothing@ wildTau ∷ TauT α → Maybe String - wildTau TVar{pos, kind=KGen{}, var} | var == "<" || var == ">" = Just var + wildTau (Var tvar) = tvar.wildTau wildTau (Meta mt) | KGen{} ← mt.kind, mt.hint == "<" || mt.hint == ">" = Just mt.hint wildTau _ = Nothing --- Returns the bounds when this type is a generic (meta) type variable. --- Occurences of the same (meta) variable in the bound types appear as having kind ? bounds ∷ TauT α → [TauT α] - bounds TVar{pos, kind, var} = unkindVar var <$> kind.bounds - bounds (Meta t) = unkindMeta t.uid <$> t.kind.bounds - bounds _ = [] + bounds (Var TVar{kind, var}) = unkindVar var <$> kind.bounds + bounds (Meta t) = unkindMeta t.uid <$> t.kind.bounds + bounds _ = [] + + -- _Con :: Traversal' (TauT s) (TCon s) + _Con :: Applicative f => (TCon s -> f (TCon s)) -> TauT s -> f (TauT s) + _Con f (Con t) = Con <$> f t + _Con _ t = pure t + -- _Var :: Traversal' (TauT s) (TVar s) + _Var :: Applicative f => (TVar s -> f (TVar s)) -> TauT s -> f (TauT s) + _Var f (Var t) = Var <$> f t + _Var _ t = pure t + -- _pos :: Traversal' (TauT s) Position + _pos :: Applicative f => (Position -> f Position) -> TauT s -> f (TauT s) + _pos _ (t@(TApp _ _)) = pure t + _pos f (Con con) = Con . con.{pos=} <$> f con.pos + _pos f (Var var) = Var . var.{pos=} <$> f var.pos + _pos _ (t@(TSig _)) = pure t + _pos _ (t@(Meta _)) = pure t + unkindVar :: String -> TauT a -> TauT a -unkindVar s TVar{pos, kind, var} | s == var = TVar{pos, kind=KVar, var} +unkindVar s (TauT.Var v) | s == v.var = TauT.Var v.{kind=KVar} unkindVar s (TApp a b) = TApp (unkindVar s a) (unkindVar s b) unkindVar _ other = other @@ -225,7 +257,7 @@ derive ArrayElement Sigma {-- The type for modelling sigma types (@forall@ types) -} -data SigmaT s = ForAll { !bound :: [TauT s], !rho :: RhoT s } where +data SigmaT s = ForAll { !bound :: [TVar s], !rho :: RhoT s } where --- get the names of the bound type variables vars (ForAll b _) = map _.var b --- get the 'KindT's of the bound type variables @@ -233,10 +265,9 @@ data SigmaT s = ForAll { !bound :: [TauT s], !rho :: RhoT s } where --- get the bound type variables as list of 'TVar's. tvars (ForAll b _) = b -- zipWith (\(v,k)\p -> TVar p k v) b (repeat pos) --- tell if this is a function - isFun (ForAll _ RhoFun{}) = true - isFun (ForAll _ RhoTau{tau}) = tau.isFun + isFun (ForAll _ rho) = rho.isFun --- add our bound variables to a type environment - extendEnv (ForAll bound _) env = fold (\e\tv → insert tv.var tv e) env bound + extendEnv (ForAll bound _) env = fold (\e tv -> insert tv.var tv e) env bound --- sigmas after translation @@ -256,6 +287,35 @@ type Context = ContextT QName type ContextS = ContextT SName +--- The rho type for functions +data RhoFun s = !RhoFun {context::[ContextT s], sigma::SigmaT s, rho::RhoT s} + where + -- _context :: Lens' (RhoFun s) [ContextT s] + _context :: Functor f => ([ContextT s] -> f [ContextT s]) -> RhoFun s -> f (RhoFun s) + _context f r = r.{context=} <$> f r.context + -- _sigma :: Lens' (RhoFun s) [SigmaT s] + _sigma :: Functor f => (SigmaT s -> f (SigmaT s)) -> RhoFun s -> f (RhoFun s) + _sigma f r = r.{sigma=} <$> f r.sigma + -- _rho :: Lens' (RhoFun s) [RhoT s] + _rho :: Functor f => (RhoT s -> f (RhoT s)) -> RhoFun s -> f (RhoFun s) + _rho f r = r.{rho=} <$> f r.rho + +{-- + The rho type for (perhaps) non-functions + + Note that a @RhoTau@ may represent functions because @RhoTau.tau@ can represent one. + See 'unTau' and 'tauRho' for conversion between 'RhoFun'. + -} +data RhoTau s = !RhoTau {context::[ContextT s], tau::TauT s} + where + -- _context :: Lens' (RhoTau s) [ContextT s] + _context :: Functor f => ([ContextT s] -> f [ContextT s]) -> RhoTau s -> f (RhoTau s) + _context f r = r.{context=} <$> f r.context + -- _tau :: Lens' (RhoTau s) [TauT s] + _tau :: Functor f => (TauT s -> f (TauT s)) -> RhoTau s -> f (RhoTau s) + _tau f r = r.{tau=} <$> f r.tau + + {-- The type for modelling rho types, which are constraint bearing types that may be functions. @@ -273,9 +333,35 @@ type ContextS = ContextT SName If some function has the above type, it will compile to a method with two arguments and return type @[b]@. -} -data RhoT s = - !RhoFun {context::[ContextT s], sigma::SigmaT s, rho::RhoT s} - | !RhoTau {context::[ContextT s], tau::TauT s} +data RhoT s + = protected !Fun (RhoFun s) + | protected !Tau (RhoTau s) + where + --- tell if this is a function + isFun (Fun _) = true + isFun (Tau RhoTau{tau}) = tau.isFun + context :: RhoT s -> [ContextT s] + context (Fun r) = r.context + context (Tau r) = r.context + + -- _context :: Lens' (RhoT s) [ContextT s] + _context :: Functor f => ([ContextT s] -> f [ContextT s]) -> RhoT s -> f (RhoT s) + _context f (Fun r) = Fun . r.{context=} <$> f r.context + _context f (Tau r) = Tau . r.{context=} <$> f r.context + -- _Fun :: Traversal' (RhoT s) (RhoFun s) + _Fun :: Applicative f => (RhoFun s -> f (RhoFun s)) -> RhoT s -> f (RhoT s) + _Fun f (Fun r) = Fun <$> f r + _Fun _ r = pure r + -- _Tau :: Traversal' (RhoT s) (RhoTau s) + _Tau :: Applicative f => (RhoTau s -> f (RhoTau s)) -> RhoT s -> f (RhoT s) + _Tau f (Tau r) = Tau <$> f r + _Tau _ r = pure r + + --- Access @context@, and if this is @RhoFun@ recurse into @RhoFun.rho@ + -- _traverseCtxs :: Traversal' (RhoT s) [ContextT s] + _traverseCtxs :: Applicative f => ([ContextT s] -> f [ContextT s]) -> RhoT s -> f (RhoT s) + _traverseCtxs f (RhoT.Tau r) = RhoT.Tau . r.{context=} <$> f r.context + _traverseCtxs f (RhoT.Fun r) = (\context rho -> RhoT.Fun r.{context, rho}) <$> f r.context <*> _traverseCtxs f r.rho --- rho as returned from parsing @@ -290,19 +376,24 @@ type Rho = RhoT QName type SigExs = (SigmaS, [TauS]) +instance Positioned (TVar a) where + is p = "tau type" + getpos t = t.pos + + instance Positioned (TauT a) where is p = "tau type" -- getpos (TFun a b) = a.getpos.merge b.getpos getpos (TApp a b) = a.getpos.merge b.getpos - getpos t | t.{pos?} = t.pos - | otherwise = Position.null + getpos (TauT.Var t) = getpos t + getpos t = fromMaybe Position.null $ preview TauT._pos t instance Positioned (RhoT a) where is p = "rho type" getpos rho = case rho of - RhoFun{sigma,rho} = (c.merge sigma.getpos).merge rho.getpos - RhoTau{tau} = c.merge tau.getpos + RhoT.Fun RhoFun{sigma,rho} = (c.merge sigma.getpos).merge rho.getpos + RhoT.Tau RhoTau{tau} = c.merge tau.getpos where c = Position.merges (map Context.getpos rho.context) @@ -319,7 +410,7 @@ instance Positioned (SigmaT a) where --- true if and only if the 'Tau' type is a 'TVar' or an application of 'TVar's -isTvApp (TVar {}) = true +isTvApp (TauT.Var _) = true isTvApp (TApp a b) = isTvApp a && isTvApp b isTvApp _ = false @@ -328,18 +419,18 @@ isTvApp _ = false {-- a provisional 'Sigma' shared by all 'Symbol's that have no type yet -} pSigma :: Sigma -pSigma = ForAll [] (RhoTau [] (Meta (Rigid (negate 1) "provisional" KVar))) +pSigma = ForAll [] (RhoT.Tau RhoTau{context=[], tau=Meta (Rigid (negate 1) "provisional" KVar)}) {-- check if this is the provisional 'Sigma' -} -isPSigma (ForAll [] (RhoTau [] (Meta (Rigid n "provisional" KVar)))) = n == negate 1 +isPSigma (ForAll [] (RhoT.Tau RhoTau{context=[], tau=Meta (Rigid n "provisional" KVar)})) = n == negate 1 isPSigma _ = false --- checks if a 'Tau' type is of the form --- > ST s t --- and returns (s,t) if this is so. -unST (TApp (TApp (TCon {name = TName p "ST"}) st ) ty) +unST (TApp (TApp (TauT.Con TCon{name = TName p "ST"}) st ) ty) | p == pPreludeBase = Just (st, ty) unST _ = Nothing diff --git a/frege/ide/Utilities.fr b/frege/ide/Utilities.fr index 7cc9c967..be637af9 100644 --- a/frege/ide/Utilities.fr +++ b/frege/ide/Utilities.fr @@ -10,6 +10,8 @@ import frege.compiler.passes.Imp as I(getFP) import frege.compiler.tc.Util as TC import frege.compiler.Typecheck as TY hiding(pass, post) +import frege.compiler.common.Lens (preview) + import Compiler.enums.TokenID(TokenID, defaultInfix) import Compiler.enums.Visibility(Private, Public) import Compiler.enums.Flags @@ -36,6 +38,7 @@ import Compiler.Main as M() import Data.TreeMap as TM(TreeMap, each, values, delete) import Data.List as DL(sortBy, maximumBy, groupBy) +import frege.compiler.gen.java.InstanceCode (symItau) import frege.tools.doc.Utilities as DU(docit, docSym, DL, Doc, emitHtml) import frege.lib.Modules @@ -229,8 +232,8 @@ proposeContent !global root !offset !tokens !index = propose after.line > token.line, traceLn("before ¦" ++ show after) || true, Token{tokid=VARID, value} ← after, - (sym:_) ← [ s | - s@SymV{expr=Just _} ← U.allourvars global ++ values global.locals, + (sym:_) ← [ SymbolT.V s | + s@SymV{expr=Just _} <- U.allourvars global ++ values global.locals, s.name.base == value, -- not s.anno, s.pos.first.offset == offset], traceLn("rule anno ¦" ++ value) || true @@ -249,15 +252,17 @@ proposeContent !global root !offset !tokens !index = propose Just (Right qname) <- Global.resolved global qual, traceLn ("resolved " ++ qual.value) || true, Just sym <- global.findit qname, + Just typ <- preview SymbolT._typ sym, traceLn ("found " ++ sym.nice global) || true, - = memProposal sym theProposal + = memProposal typ theProposal | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=VARID}) :_) <- snekot, traceLn ("rule: " ++ qual.value ++ "." ++ insideProposal.prefix) || true, Just (Right qname) <- Global.resolved global qual, traceLn ("resolved " ++ qual.value) || true, Just sym <- global.findit qname, + Just typ <- preview SymbolT._typ sym, traceLn ("found " ++ sym.nice global) || true, - = memProposal sym insideProposal + = memProposal typ insideProposal | (Token{tokid=VARID}:Token{tokid=CHAR, value="."}:(qual@Token{tokid=STRCONST}):_) <- snekot, (true, proposals) <- tauProposal TY.tauString theProposal = proposals @@ -265,46 +270,46 @@ proposeContent !global root !offset !tokens !index = propose (true, proposals) <- tauProposal TY.tauString insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."}:(qual@Token{tokid=INTCONST}):_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Int") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Int") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=INTCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Int") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Int") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=LONGCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Long") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Long") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=LONGCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Long") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Long") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=BIGCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Integer") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Integer") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=BIGCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Integer") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Integer") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=DBLCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Double") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Double") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=DBLCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Double") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Double") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=FLTCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Float") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Float") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=FLTCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Float") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Float") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=CHRCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Char") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Char") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=CHRCONST}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Char") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Char") insideProposal = proposals | (Token{tokid=VARID}:Token{tokid=CHAR, value="."} : (qual@Token{tokid=REGEXP}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Regex") theProposal + (true, proposals) <- tauProposal (TY.tcTau "Regex") theProposal = proposals | (Token{tokid=CHAR, value="."} : (qual@Token{tokid=REGEXP}) :_) <- snekot, - (true, proposals) <- tauProposal (TY.tc "Regex") insideProposal + (true, proposals) <- tauProposal (TY.tcTau "Regex") insideProposal = proposals | (Token{tokid=someid}:Token{tokid=QUALIFIER, value=base}:Token{tokid=QUALIFIER, value}:_) <- snekot, someid == VARID || someid == CONID @@ -329,7 +334,7 @@ proposeContent !global root !offset !tokens !index = propose traceLn ("rule fundef " ++ value ++ "¦") || true, Just (Right qname) <- Global.resolved global varid, traceLn ("resolved " ++ nicer qname global) || true, - Just sym <- global.findit qname, + Just (SymbolT.V sym) <- global.findit qname, traceLn ("found " ++ sym.nice global) || true, sym.anno, traceLn (sym.nice global ++ " is annotated") || true, isNothing sym.nativ, traceLn (sym.nice global ++ " is not nativ") || true, @@ -345,7 +350,7 @@ proposeContent !global root !offset !tokens !index = propose | !inside, Token{tokid=CONID, value} <- token, traceLn ("rule case " ++ value ++ "¦") || true, - Just (symbol@SymT{}) <- global.findit TName{pack=global.thisPack, base=value}, + Just (SymbolT.T symbol) <- global.findit TName{pack=global.thisPack, base=value}, traceLn (value ++ " is a type") || true -- cons <- [ con | con@SymD{} <- values symtab ], -- traceLn (value ++ " has " ++ show (length cons) ++ " constructors.") || true @@ -356,11 +361,12 @@ proposeContent !global root !offset !tokens !index = propose Just (Right qname) <- Global.resolved global token, traceLn ("resolved " ++ value) || true, Just sym <- global.findit qname, + Just typ <- preview SymbolT._typ sym, traceLn ("found " ++ sym.nice global) || true, - RhoTau{tau} <- sym.typ.rho, + RhoT.Tau RhoTau{tau} <- typ.rho, tau <- TC.reduced tau global, traceLn ("type is " ++ nicer tau global) || true, - Just (symbol@SymT{}) <- instTauSym tau global + Just symbol <- instTauSym tau global = caseProposal false (Just symbol) | !inside, Token{tokid=VARID, value} <- token, @@ -368,11 +374,12 @@ proposeContent !global root !offset !tokens !index = propose Just (Right qname) <- Global.resolved global token, traceLn ("resolved " ++ value) || true, Just sym <- global.findit qname, + Just typ <- preview SymbolT._typ sym, traceLn ("found " ++ sym.nice global) || true, - (tau,_) <- U.returnType sym.typ.rho, + (tau,_) <- U.returnType typ.rho, tau <- TC.reduced tau global, traceLn ("return type is " ++ nicer tau global) || true, - Just (symbol@SymT{}) <- instTauSym tau global + Just symbol <- instTauSym tau global = caseProposal false (Just symbol) | direct, token.tokid == VARID = localProposal directProposal @@ -400,8 +407,8 @@ proposeContent !global root !offset !tokens !index = propose fundefProposal token args = [proposal] where tsyms = map instSigmaSym args - instSigmaSym ForAll{rho = RhoFun{}} = Nothing - instSigmaSym ForAll{rho = RhoTau{tau}} = instTauSym tau global + instSigmaSym ForAll{rho = RhoT.Fun _} = Nothing + instSigmaSym ForAll{rho = RhoT.Tau r} = instTauSym r.tau global conss [] = [""] conss (tsym:tsyms) = [ cons ++ " " ++ line | cons <- (conts true tsym), @@ -427,7 +434,7 @@ proposeContent !global root !offset !tokens !index = propose -- make a case statement -- given the symbol for a type, produce a proposal -- - caseProposal :: Bool -> Maybe Symbol -> [Proposal] + caseProposal :: Bool -> Maybe (SymT Global) -> [Proposal] caseProposal conid tsym = if !direct then [proposal] -- sym ¦ @@ -442,7 +449,7 @@ proposeContent !global root !offset !tokens !index = propose forWhat = case tsym of Nothing -> "for some type" Just t -> if conid - then "for type " ++ t.name.base + then "for type " ++ t.name.base else "for value of type " ++ t.name.base disp = 5 + (if conid then 0 else token.length + 1) proposal = Proposal{ @@ -464,20 +471,20 @@ proposeContent !global root !offset !tokens !index = propose texts = map (spaces ++) (map (++ " → undefined -- TODO: complete code\n") (conts false tsym)) - conts ∷ Bool → Maybe Symbol → [String] + conts :: Bool -> Maybe (SymT Global) -> [String] conts parens tsym = case tsym of Just sym -> case cons of - (_:_) -> (map (conText parens) . sortBy (comparing Symbol.cid)) cons - [] -- traceLn(show (Symbol.name sym) ++ " vs. " ++ show (TName pPreludeBase "Bool")) || true - = if Symbol.name sym == TName pPreludeBase "Bool" + (_:_) -> (map (conText parens) . sortBy (comparing _.cid)) cons + [] -> if sym.name == TName pPreludeBase "Bool" then ["true", "false"] else ["_"] - where cons = [ con | con@SymD{} <- values (Symbol.env sym)] + where cons = [ con | SymbolT.D con <- values sym.env ] Nothing -> ["_"] -- null cons = ["_"] -- otherwise = map conText cons - conText parens sym = enclosed (snd (symProp (base sym) sym)) + conText :: Bool -> SymD Global -> String + conText parens sym = enclosed (snd (symProp (base sym) $ SymbolT.D sym)) where base sym | sym.vis != Public, @@ -486,19 +493,19 @@ proposeContent !global root !offset !tokens !index = propose -- put complicated constructor in (), if required enclosed it | parens, - (Symbol.name sym).base != ":", -- not list cons - (Symbol.name sym).base !~ ´^\(´, -- not tuple - any (isNothing . ConField.name) (Symbol.flds sym) = "(" ++ it ++ ")" + sym.name.base != ":", -- not list cons + sym.name.base !~ ´^\(´, -- not tuple + any (isNothing . ConField.name) sym.flds = "(" ++ it ++ ")" | otherwise = it -- Find a proposal for id.member -- - memProposal :: Symbol -> Proposal -> [Proposal] - memProposal sym prop - | RhoTau _ tau <- sym.typ.rho, -- look in env of type tau + memProposal :: Sigma -> Proposal -> [Proposal] + memProposal typ prop + | RhoT.Tau RhoTau{tau} <- typ.rho, -- look in env of type tau (true, result) <- tauProposal tau prop = result - | RhoFun{rho} <- sym.typ.rho, -- look in return type of fn - RhoTau _ tau <- rho, + | RhoT.Fun RhoFun{rho} <- typ.rho, -- look in return type of fn + RhoT.Tau RhoTau{tau} <- rho, (true, result) <- tauProposal tau prop = result | otherwise = filteredEnvProposal prop (classMember:standardFilter) (thisTab global) @@ -512,12 +519,13 @@ proposeContent !global root !offset !tokens !index = propose Just s | ss <- s:U.supersOfNativ s global, -- the supertypes of s (including s) -- traceLn("supertypes are " ++ show ss) || true, - envs <- [ Symbol.env sym | s <- ss, + envs <- [ env | s <- ss, q <- U.typesOfNativ s global, - sym <- global.findit q ] + sym <- global.findit q, + env <- sym.env' ] = (true, concatMap (flip envProposal prop) envs) other - | [TCon{name}, _, tau2] <- tau.flat, + | [TauT.Con TCon{name}, _, tau2] <- tau.flat, name == TName{pack=pPreludeIO, base="Mutable"} = (true, snd (tauProposal tau2 prop) ++ envProposal env prop) | otherwise = (true, envProposal env prop) @@ -528,14 +536,14 @@ proposeContent !global root !offset !tokens !index = propose -- Then, find the local symbols that are between them and make proposals for them localProposal :: Proposal -> [Proposal] localProposal model - = [ model.{proposal = label global sym, + = [ model.{proposal = label global (SymbolT.V sym), newText = sym.name.base} | - sym <- DL.uniqueBy (using (QName.base . Symbol.name)) [ sym | + sym <- DL.uniqueBy (using (QName.base . _.name)) [ sym | sym <- values global.locals, offBefore = maybe 0 symoffset before, offAfter = maybe 999999999 symoffset after, - symoffset sym > offBefore, - symoffset sym < offAfter, + symoffset (SymbolT.V sym) > offBefore, + symoffset (SymbolT.V sym) < offAfter, sym.name.base != "_", sym.name.base.startsWith model.prefix ] ] @@ -546,10 +554,10 @@ proposeContent !global root !offset !tokens !index = propose after = if null afters then Nothing else Just (DL.minimumBy (comparing symoffset) afters) - symoffset = Token.offset . Position.first . Symbol.pos + symoffset = Token.offset . Position.first . _.pos (befores, afters) = DL.partitioned (( getEnv (instTauSym tau global) + [_, tau] -> getEnv (fmap SymbolT.T $ instTauSym tau global) _ -> getEnv (global.findit name) else getEnv (global.findit name) getEnv other = Nothing @@ -604,34 +612,34 @@ proposeContent !global root !offset !tokens !index = propose if length model.prefix > 0 then sym.name.base.startsWith model.prefix else true, - let (proposal, newText) = symProp sym.name.base sym + let (proposal, newText) = symProp sym.name.base sym ] -- standardFilter standardFilter = [notPrivate, notTuple, notInstance, notOverloaded] - notPrivate sym = Symbol.vis sym != Private - || global.our sym.name - || Symbol.{alias?} sym - notTuple = not . (flip String.startsWith "(") . QName.base . Symbol.name + notPrivate sym = sym.vis != Private + || global.our sym.name + || Lens.has SymbolT._L sym + notTuple = not . (flip String.startsWith "(") . QName.base . _.name notInstance = (Just "instance" !=) . fmap (flip Nice.category global) . global.follow notOverloaded sym - | SymV{over} <- sym = null over + | SymbolT.V SymV{over} <- sym = null over | otherwise = true classMember sym | Just member <- global.follow sym, - MName{tynm, base} <- Symbol.name member, - Just SymC{} <- global.findit tynm = true + MName{tynm, base} <- member.name, + Just (SymbolT.C _) <- global.findit tynm = true | otherwise = false -- make proposals for symbols in given symtab, considering prefix if any envProposal :: Symtab -> Proposal -> [Proposal] envProposal symtab model = filteredEnvProposal model standardFilter symtab -- nice up a symbol - symProp base (sym@SymL{}) = case global.follow sym of + symProp base (sym@(SymbolT.L _)) = case global.follow sym of Just target -> symProp base target Nothing -> (base, base) - symProp base (sym@SymD{name,flds}) + symProp base (SymbolT.D (sym@SymD{name,flds})) | null flds = (verbose, base) | base == ":" = (verbose, "(_:_)") | m~´^\(,+\)$´ <- base, Just commata <- m.group 0 = (verbose, tuple commata) @@ -642,22 +650,22 @@ proposeContent !global root !offset !tokens !index = propose verbose = base ++ " (" ++ nicer sym.name.tynm global ++ "." ++ base ++ ")" constr = base ++ joined "" (map (const " _") flds) fields = base ++ "{" ++ joined ", " (mapMaybe ConField.name flds) ++ "}" - symProp base SymV{name=MName{base = it@m~´^(...)\$(.+)$´}} + symProp base (SymbolT.V SymV{name=MName{base = it@m~´^(...)\$(.+)$´}}) | Just field <- m.group 2 = case m.group 1 of Just "chg" -> (field ++ " (change/modify field)", "{" ++ field ++ "<-}") Just "upd" -> (field ++ " (update field)", "{" ++ field ++ "=}") Just "has" -> (field ++ " (check if field exists)", "{" ++ field ++ "?}") other -> (it, it) symProp base sym - | SymV{nativ = Just _} <- sym, + | SymbolT.V SymV{name, nativ = Just _} <- sym, m~´^(.+)[αβγδεζηθιßκλμνξοπρςστυφχψω]+$´ <- base, -- overloaded?? Just stem <- m.group 1, - Just overld <- global.findit sym.name.{base=stem}, - sym.name `elem` overld.over = symProp stem overld + Just (SymbolT.V overld) <- global.findit name.{base=stem}, + name `elem` overld.over = symProp stem $ SymbolT.V overld | otherwise = (imported, base) where - imported | global.our sym.name = base - | otherwise = base ++ " (" ++ nice sym.name global ++ ")" + imported | global.our sym.name = base + | otherwise = base ++ " (" ++ nice sym.name global ++ ")" {-- Create a list of triples with position, namespace and package @@ -675,16 +683,15 @@ imports g = [ (pos, NSName.unNS ns, Pack.raw pack) | symbols :: Symtab -> [Symbol] symbols tab = (sortBy positionAndName • filter wanted • values) tab where - positionAndName a b = case Symbol.pos a <=> Symbol.pos b of - Eq -> comparing (QName.base • Symbol.name) a b + positionAndName a b = case a.pos <=> b.pos of + Eq -> comparing (QName.base . _.name) a b ne -> ne wanted :: Symbol -> Bool wanted sym - | sym.{alias?} = false - | Local{} <- sym.name = true - -- sym.vis == Private = false + | SymbolT.L _ <- sym = false + | Local{} <- sym.name = true | sym.name.base ~ ´^(chg|upd|has|let|anon|lc)\$´ = false - | otherwise = true + | otherwise = true exprSymbols = U.foldEx false collectsyms [] where @@ -703,21 +710,20 @@ dcolon = DU.symDcolon Make a label for a symbol -} label ∷ Global → SymbolT a → String -label g SymI{clas,typ} = nicer (instanceHead clas typ.rho) g - -- ++ " " ++ clas.nicer g ++ " " ++ verbose g typ -label g SymV{name,typ} = name.base ++ dcolon g ++ verbose g typ -label g SymD{name,typ} = name.base ++ dcolon g ++ verbose g typ -label g SymC{name,tau} = name.base ++ dcolon g ++ show tau.kind -label g SymT{name, nativ = Just n, pur} +label g (SymbolT.I (sym@SymI{clas})) = nicer (instanceHead clas (symItau sym)) g +label g (SymbolT.V SymV{name,typ}) = name.base ++ dcolon g ++ verbose g typ +label g (SymbolT.D SymD{name,typ}) = name.base ++ dcolon g ++ verbose g typ +label g (SymbolT.C SymC{name,clvar}) = name.base ++ dcolon g ++ show clvar.kind +label g (SymbolT.T SymT{name, nativ = Just n, pur}) | pur = name.base ++ dcolon g ++ "immutable native " ++ n | otherwise = name.base ++ dcolon g ++ "mutable native " ++ n -label g SymA{name,typ} = name.base ++ " = " ++ typ.rho.nicer gspecial +label g (SymbolT.A SymA{name,typ}) = name.base ++ " = " ++ typ.rho.nicer gspecial where gspecial = g.{options <- _.{flags <- Flags.flagSet SPECIAL}} label g sym - | sym.{kind?} = sym.name.base ++ dcolon g ++ show sym.kind - | otherwise = sym.name.base - + | Just kind <- preview SymbolT._kind sym = sym.name.base ++ dcolon g ++ show kind + | otherwise = sym.name.base + {-- Increment the pass number in the state -} @@ -790,8 +796,8 @@ symbolDocumentation sym = do changeSTT Global.{gen <- GenSt.{printer=p}} g <- getSTT let syms = case sym of - SymL{alias} | Just target <- g.findit alias = - if sym.name.base == target.name.base + SymbolT.L SymL{alias} | Just target <- g.findit alias = + if sym.name.base == target.name.base then [target] else [sym, target] other = [sym] @@ -844,10 +850,11 @@ infixDoc g = joined "
\n" (map htmlsafe lines) where tab = thisTab g - syms = [ (desc sym.op, sym0.name.base) | + syms = [ (desc op, sym0.name.base) | sym0 ← values tab, sym ← g.follow sym0, -- resolve symlinks - sym.{op?}, sym.op != defaultInfix ] + op <- preview SymbolT._op sym, + op != defaultInfix ] groups = map toTuple • groupBy (using fst) • sortBy (descending fst) $ syms where diff --git a/frege/prelude/Maybe.fr b/frege/prelude/Maybe.fr index 173f5330..e474c49a 100644 --- a/frege/prelude/Maybe.fr +++ b/frege/prelude/Maybe.fr @@ -71,13 +71,16 @@ instance Monad Maybe where a >> b = a >>= const b -- pure = Just +instance Alt Maybe where + Nothing <|> x = x + x <|> _ = x + instance MonadFail Maybe where fail = const Nothing instance MonadPlus Maybe where mzero = Nothing - mplus Nothing x = x - mplus x _ = x + mplus = (<|>) instance ListEmpty Maybe where empty = Nothing diff --git a/frege/tools/Doc.fr b/frege/tools/Doc.fr index 914c4d78..b27d1e64 100644 --- a/frege/tools/Doc.fr +++ b/frege/tools/Doc.fr @@ -63,6 +63,8 @@ import Data.TreeMap as TM(TreeMap, keys, values, each, insert) import Data.List as DL(sortBy, groupBy, intersperse) import Data.Bits +import frege.compiler.common.Lens () + import Compiler.enums.Flags as Compilerflags(VERBOSE) import Compiler.enums.Visibility(Public) @@ -318,11 +320,11 @@ mkLinks ns pack = do g <- getST case g.thisTab.lookupS sym.name.key of Just _ -> return () - Nothing -> let rsym = fromMaybe sym (g.findit sym.name) in + Nothing -> let rsym = fromMaybe sym (g.findit sym.name) in I.linkHere (ns.unNS) pack protoItem.{name=Simple sym.pos.first.{value=sym.name.base}, - members = if rsym.{env?} && not rsym.{clas?} + members = if isJust (SymbolT.env' rsym) && not (Lens.has SymbolT._I rsym) then Just [] else Nothing, alias=sym.name.base} sym @@ -374,7 +376,7 @@ continueNamespaces fp = do tableOC = [h3 (text "Table of Content"), toc] toc = ul (Just "data") (tocpars [ (asyms++csyms++dsyms - ++(sortBy (comparing Symbol.pos) (funs++links)), "data", "Definitions"), + ++(sortBy (comparing _.pos) (map SymbolT.V funs ++ links)), "data", "Definitions"), -- (asyms, "data", "Type Aliases"), -- (csyms, "data", "Type Classes"), -- (dsyms, "data", "Data Types"), @@ -420,35 +422,37 @@ continueNamespaces fp = do DL (Just "func") (map docTypes ordfuns)] definitions = [h2 (XLbl "data" (text "Definitions")), DL (Just "data") (map (docSym g) sourcesyms)] - sourcesyms = sortBy (comparing Symbol.pos) (asyms ++ csyms ++ dsyms ++ funs ++ links) - asyms = sortBy (comparing Symbol.name) [sym | sym@SymA {pos} <- values g.thisTab] - csyms = sortBy (comparing Symbol.name) [sym | sym@SymC {pos} <- values g.thisTab] - isyms = sortBy (comparing Symbol.name) [sym | sym@SymI {pos} <- values g.thisTab] - dsyms = sortBy (comparing Symbol.name) [sym | sym@SymT {pos} <- values g.thisTab] - funs = sortBy (comparing Symbol.name) [sym | sym@SymV {pos} <- values g.thisTab] - links = sortBy (comparing Symbol.name) [sym | sym@SymL {alias} <- values g.thisTab, + sourcesyms = sortBy (comparing _.pos) (asyms ++ csyms ++ dsyms ++ map SymbolT.V funs ++ links) + asyms = sortBy (comparing _.name) [sym | sym@(SymbolT.A _) <- values g.thisTab] + csyms = sortBy (comparing _.name) [sym | sym@(SymbolT.C _) <- values g.thisTab] + isyms = sortBy (comparing _.name) [sym | sym@(SymbolT.I _) <- values g.thisTab] + dsyms = sortBy (comparing _.name) [sym | sym@(SymbolT.T _) <- values g.thisTab] + funs = sortBy (comparing _.name) [symv | SymbolT.V symv <- values g.thisTab] + links = sortBy (comparing _.name) [sym | sym@(SymbolT.L SymL{alias}) <- values g.thisTab, g.our alias, other <- g.findit alias, - not other.{flds?}, -- no constructor aliases + Lens.hasn't SymbolT._D other, -- no constructor aliases noclassmember g other.name] where noclassmember g (MName tname _) = case g.findit tname of - Just SymC{} -> false - other -> true - noclassmember f _ = true - allfuns = funs ++ [ s | syms <- [csyms, isyms, dsyms], sym :: Symbol <- syms, - sym.{env?}, - s <- values sym.env, Symbol.{typ?} s ] - ordfuns = groupBy (using Symbol.typ) (sortBy (comparing Symbol.typ) allfuns) - expfuns = sortBy (comparing Symbol.name) [sym | sym@SymL {pos,vis,alias} <- values g.thisTab, + Just (SymbolT.C _) -> false + other -> true + noclassmember _ _ = true + allfuns = funs ++ [ s + | syms <- [csyms, isyms, dsyms] + , sym :: Symbol <- syms + , env <- SymbolT.env' sym + , SymbolT.V s <- values env ] + ordfuns = groupBy (using _.typ) (sortBy (comparing _.typ) allfuns) + expfuns = sortBy (comparing _.name) [sym | sym@(SymbolT.L SymL{pos,vis,alias}) <- values g.thisTab, vis == Public, not (g.our alias) ] - docTypes :: [Symbol] -> (Text, [Paragraph]) + docTypes :: [SymV Global] -> (Text, [Paragraph]) docTypes [] = undefined docTypes ss = (code typ, [par $ content ss]) where typ = dRho g (head ss).typ.rho (repeat false) - content = fold (:-) (text "") • intersperse (text ", ") • map (flip fref g • Symbol.name) + content = fold (:-) (text "") . intersperse (text ", ") . map (flip fref g . _.name) -- h3 (text "Imports"), ul Nothing (map docImp (Tree.keyvalues ?S.packs Eq))] -- we are producing strict HTML401 diff --git a/frege/tools/Quick.fr b/frege/tools/Quick.fr index c2908249..34c03775 100644 --- a/frege/tools/Quick.fr +++ b/frege/tools/Quick.fr @@ -211,9 +211,9 @@ getProps pack = do when (g.errors > 0) printAndClearErrors return [] Just env -> return [ sym.name.base | - sym@SymV{} <- values env, - ForAll _ RhoTau{context=[], tau} <- Just sym.typ, - TApp TCon{name=gen} TCon{name=prop} <- Just tau, + SymbolT.V sym <- values env, + ForAll _ (RhoT.Tau RhoTau{context=[], tau}) <- Just sym.typ, + TApp (TauT.Con TCon{name=gen}) (TauT.Con TCon{name=prop}) <- Just tau, gen == genName, prop == propName ] diff --git a/frege/tools/Splitter.fr b/frege/tools/Splitter.fr index 232babe6..4a11ea23 100644 --- a/frege/tools/Splitter.fr +++ b/frege/tools/Splitter.fr @@ -4,11 +4,13 @@ module frege.tools.Splitter where import frege.Prelude hiding(comparing) import Data.List -import Data.TreeMap as L(values, keys, each, TreeMap) +import Data.TreeMap as L(values, keys, each, TreeMap, TreeSet) -- import Data.Monoid import Data.Bits import Data.Graph (stronglyConnectedComponents tsort) +import frege.compiler.common.Lens (set) + import Compiler.enums.Flags as Compilerflags(IDETOKENS, NOUNLET) import Compiler.enums.TokenID @@ -19,7 +21,7 @@ import Compiler.types.QNames import Compiler.types.Types import Compiler.types.Patterns import Compiler.types.Expression -import Compiler.types.SourceDefinitions(DefinitionS) +import Compiler.types.SourceDefinitions(DefinitionS, ImpDcl) import Compiler.types.Symbols import Compiler.types.Global as G @@ -118,10 +120,10 @@ ideoff = do ours :: Global -> [Symbol] ours g = (filter (g.ourSym) . filter noAliases) (values g.thisTab) where - noAliases SymL{name=n@VName{},alias=a@VName{}} = g.our a && g.our n - noAliases SymL{} = false - noAliases _ = true -ascending g = sortBy (Prelude.comparing Symbol.pos) (ours g) + noAliases (SymbolT.L SymL{name=n@VName{},alias=a@VName{}}) = g.our a && g.our n + noAliases (SymbolT.L _) = false + noAliases _ = true +ascending g = sortBy (Prelude.comparing (_.pos)) (ours g) split :: [String] -> StIO (String, Int) split args = do @@ -135,7 +137,7 @@ split args = do -- doio $ mapM_ (printRange g) (ascending g) let deps g = map (symDep g) (ascending g) udeps = map (\(a,as) -> (a, filter (a!=) as)) -- eliminate self recursion - (zip (map Symbol.name (ascending g)) (map keys (deps g))) + (zip (map (_.name) (ascending g)) (map keys (deps g))) deptree = L.fromList udeps tdeps = tsort udeps asc = ascending g @@ -278,7 +280,7 @@ printMods g modul mbHelper mItems hItems syms = do mod.println return hpw Nothing -> do - unless (modul `elem` [ pack | ImpDcl{pack} <- g.definitions]) do + unless (modul `elem` [ pack | DefinitionS.Imp ImpDcl{pack} <- g.definitions ]) do orig.println orig.println "-- import outsourced modules" orig.println ("import " ++ modul) @@ -292,36 +294,25 @@ printMods g modul mbHelper mItems hItems syms = do where out :: String -> MutableIO PrintWriter -> MutableIO PrintWriter -> MutableIO PrintWriter -> Symbol -> IO () out dat ow mw hw sym = do - stderr.println (nicer sym.name g - ++ ", range=" ++ sym.pos.first.value ++ " .. " - ++ show sym.pos.last) - let src = substr dat sym.pos.first.offset end - end = if sym.pos.end < sym.pos.first.offset || sym.pos.end > dat.length + let symName = sym.name + symPos = sym.pos + stderr.println (nicer symName g + ++ ", range=" ++ symPos.first.value ++ " .. " + ++ show symPos.last) + let src = substr dat symPos.first.offset end + end = if symPos.end < symPos.first.offset || symPos.end > dat.length then dat.length - else sym.pos.end - -- braces e = if e < dat.length && - -- (dat.charAt e == '}' - -- || Char.isWhitespace (dat.charAt e)) - -- then braces (e+1) - -- else if e+1 < dat.length - -- && dat.charAt e == '-' - -- && dat.charAt (e+1) == '-' - -- then endofline (e+2) - -- else e - -- endofline e - -- | e >= dat.length = e - -- | dat.charAt e == '\r' || dat.charAt e == '\n' = e - -- | otherwise = endofline (e+1) - - writer = if sym.name `elem` mItems - then if sym.name `elem` hItems + else symPos.end + + writer = if symName `elem` mItems + then if symName `elem` hItems then hw else mw else ow writer.println src writer.println writer.println - + --- make filename from package name @x.y.z.Packet@ => @dest/x/y/z/Packet.suffix@ targetPath :: Global -> String -> String -> String @@ -374,9 +365,11 @@ printHeader pw pack = do pw.println (" -- generated by Splitter") +printImports :: Global -> MutableIO PrintWriter -> IO () printImports g pw = mapM_ (printImpDcl g pw) - [ idef | idef @ImpDcl{pos, pack, as, imports} <- g.definitions ] + [ idef | DefinitionS.Imp idef <- g.definitions ] +printImpDcl :: Global -> MutableIO PrintWriter -> ImpDcl -> IO () printImpDcl g pw ImpDcl{pos, pack, as, imports} = do PrintWriter.println pw ("import " ++ pack ++ maybe "" (" as " ++) as @@ -396,7 +389,6 @@ printImpDcl g pw ImpDcl{pos, pack, as, imports} = do ++ (if null alias then "" else if alias == name.id.value then "" else " " ++ alias) -printImpDcl g pw _ = error "can only print ImpDcl" dotDep :: MutableIO PrintWriter -> Global -> (TreeMap QName [QName]) -> [QName] -> IO () dotDep writer g tree qns = do @@ -435,11 +427,13 @@ printDep g tree qns = do println "" println (" :: " ++ show (map (flip nicer g) xs)) -printRange g symbol = do - println (show symbol.pos.first.offset - ++ "-" ++ show (symbol.pos.end) - ++ Symbol.nicer symbol g - ++ " " ++ symbol.pos.first.value ++ " .. " ++ symbol.pos.last.value) +printRange :: Global -> Symbol -> IO () +printRange g symbol = do + let pos = symbol.pos + println (show pos.first.offset + ++ "-" ++ show (pos.end) + ++ symbol.nicer g + ++ " " ++ pos.first.value ++ " .. " ++ pos.last.value) {-- The full range goes from the lower range to the upper range, inclusive. @@ -492,10 +486,6 @@ fullRange symbol next = do skipComments :: Int -> JArray Token -> Int skipComments 0 arr = 0 skipComments n arr - -- | traceLn ("skipComments: " - -- ++ maybe "" (_.base . Symbol.name) next - -- ++ ", n=" ++ show n - -- ++ " found " ++ show [prev,this]) = undefined | -- prev.tokid == DOCUMENTATION || prev.tokid == COMMENT, prev.line < this.line, prev.col > this.col = n -- most likely not our token @@ -541,32 +531,32 @@ makeRanges ascending = do let nextTokens = map Just (tail ascending) ++ [Nothing] ranges = zipWith fullRange ascending nextTokens ranges <- sequence ranges - mapM_ (liftStG . changeSym) (zipWith Symbol.{pos=} ascending ranges) + mapM_ (liftStG . changeSym) (zipWith (flip $ set SymbolT._pos) ascending ranges) -- symDep g _ sym | traceLn ("doing symDep for " ++ nicer sym g) = undefined -symDep g SymA{typ} = sigmaDep g typ -symDep g SymT{env} = fold L.union empty [ symDep g sym | +symDep g (SymbolT.A SymA{typ}) = sigmaDep g typ +symDep g (SymbolT.T SymT{env}) = fold L.union empty [ symDep g sym | sym <- values env, not (instLink sym)] where - instLink SymL{alias} - | Just SymV{name} <- g.findit alias, - MName{tynm} <- name, - Just SymI{} <- g.findit tynm = true + instLink (SymbolT.L SymL{alias}) + | Just (SymbolT.V SymV{name}) <- g.findit alias, + MName{tynm} <- name, + Just (SymbolT.I _) <- g.findit tynm = true instLink other = false -symDep g SymD{typ} = sigmaDep g typ -symDep g (symv@SymV{typ}) = sigmaDep g typ L.`union` maybe empty (exprDep g) (symv.gExpr g) -symDep g SymL{name, alias} +symDep g (SymbolT.D SymD{typ}) = sigmaDep g typ +symDep g (SymbolT.V (symv@SymV{typ})) = sigmaDep g typ L.`union` maybe empty (exprDep g) (symv.gExpr g) +symDep g (SymbolT.L SymL{name, alias}) | g.our name, not (g.our alias) = nameDep g empty name -- imported item | otherwise = nameDep g empty alias | false = case g.findit alias of Just sym -> nameDep g (symDep g sym) alias Nothing -> empty -symDep g SymI{clas, typ, env} = fold L.union tree (map (symDep g) (values env)) +symDep g (SymbolT.I SymI{clas, typ, meth}) = fold L.union tree (map (symDep g . _.toSymbol) (values meth)) where tree = nameDep g sigt clas sigt = sigmaDep g typ -symDep g SymC{supers, env} = fold L.union tree (map (symDep g) (values env)) +symDep g (SymbolT.C SymC{supers, meth}) = fold L.union tree (map (symDep g . _.toSymbol) (values meth)) where tree = fold (nameDep g) empty supers symDep g sym = error ("don't know dependencies of " ++ nicer sym g) @@ -606,12 +596,13 @@ exprDep g ex = exDep empty ex sigmaDep g (ForAll _ rho) = rhoDep g empty rho -rhoDep g tree RhoFun{context, sigma, rho} = result +rhoDep :: Global -> TreeSet QName -> Rho -> TreeSet QName +rhoDep g tree (RhoT.Fun RhoFun{context, sigma, rho}) = result where result = rhoDep g sdep rho sdep = rhoDep g cdep sigma.rho cdep = fold (ctxDep g) tree context -rhoDep g tree RhoTau{context, tau} = tauDep g cdep tau +rhoDep g tree (RhoT.Tau RhoTau{context, tau}) = tauDep g cdep tau where cdep = fold (ctxDep g) tree context @@ -620,11 +611,8 @@ ctxDep g tree Ctx{pos, cname, tau} = tauDep g ctree tau ctree = nameDep g tree cname tauDep :: Global -> TreeMap QName () -> Tau -> TreeMap QName () -tauDep g tree (TApp a b) = tauDep g (tauDep g tree a) b -tauDep g tree TCon{pos, name} = nameDep g tree name -tauDep g tree TVar{pos, kind, var} = tree -tauDep g tree (Meta _) = tree -tauDep g tree (TSig s) = tree L.`union` sigmaDep g s - - - \ No newline at end of file +tauDep g tree (TApp a b) = tauDep g (tauDep g tree a) b +tauDep g tree (TauT.Con c) = nameDep g tree c.name +tauDep _ tree (TauT.Var _) = tree +tauDep _ tree (Meta _) = tree +tauDep g tree (TSig s) = tree L.`union` sigmaDep g s diff --git a/frege/tools/doc/Utilities.fr b/frege/tools/doc/Utilities.fr index d5b275d9..07fa499f 100644 --- a/frege/tools/doc/Utilities.fr +++ b/frege/tools/doc/Utilities.fr @@ -47,7 +47,6 @@ import Data.TreeMap as TM(TreeMap, keys, values, each, insert) import Data.List as DL(sortBy, groupBy, intersperse) import Java.Net(URI) - import Compiler.enums.Flags as Compilerflags(SPECIAL, isOn, USEUNICODE) import Compiler.enums.Visibility(Public) import Compiler.enums.TokenID @@ -69,8 +68,9 @@ import Compiler.common.Resolve as R(resolve) import Compiler.classes.Nice - + import frege.compiler.Utilities as U(print, println) +import frege.compiler.gen.java.InstanceCode (symItau) import Test.QuickCheck as QC() --- Represents an abstract HTML document. @@ -135,7 +135,6 @@ badref s = T (A "unknown") (P s) tref tn g = Ref tn (text $ nicer tn g) --- a reference to a symbol sref (SymL {name,alias}) g = Ref alias (text $ nicer name g) -sref sym g = tref sym.name g --- a reference to a function or constructor name fref qn g = Ref qn (text $ nicer qn g) --- makes a single text from a list of texts @@ -195,45 +194,45 @@ join = joined joint s f xs = seq (intersperse (text s) (map f xs)) joins n f xs = seq (intersperse (spaces n :- text " ") (map f xs)) -docSym g (syma@SymA {name, vars, typ=ForAll _ rho, doc}) = (code title, docit g doc) where +docSym g (SymbolT.A (syma@SymA{name, vars, typ=ForAll _ rho, doc})) = (code title, docit g doc) where title = (bold • text $ "type ") :- Label name (text name.base) :- text " " - :- joint " " (dTau g) vars + :- joint " " (dTau g . TauT.Var) vars :- text " = " :- dRho g.{options <- Options.{flags <- Compilerflags.flagSet SPECIAL}} rho [] -docSym g (SymC {name,tau,doc,supers,insts,env}) = (code title, content) where +docSym g (SymbolT.C SymC{name,clvar,doc,supers,insts,meth}) = (code title, content) where title = (bold • text $ "class ") - :- dCtx g (map (\c -> Ctx {pos=Position.null, cname=c, tau}) supers) + :- dCtx g (map (\c -> Ctx {pos=Position.null, cname=c, tau=TauT.Var clvar}) supers) :- text " " :- Label name (text name.base) - :- text " " :- dTau g tau - members = sortBy (comparing Symbol.name) (values env) + :- text " " :- dTau g (TauT.Var clvar) + members = sortBy (comparing _.name) (values meth) ki (tname, iname) = Ref iname (text (nice tname g)) content = [ p | d <- [docit g doc, if null insts then [] else [h3 (text "Known Instances"), par (joint ", " ki insts)], if null members then [] else [h3 (text "Member Functions"), - DL (Just "func") (map (docSym g) members)]], + DL (Just "func") (map (docSym g . _.toSymbol) members)]], p <- d ] -docSym g (SymI {pos, name, doc, clas, typ=ForAll _ rho, env}) = (code title, content) where +docSym g (SymbolT.I (sym@SymI{pos, name, doc, clas, typ=ForAll _ rho, meth})) = (code title, content) where title = (bold • text $ "instance ") :- dCtx g rho.context :- Label name (text " ") - :- dTau g (TApp TCon{pos, name=clas} (TH.tauRho rho).tau) + :- dTau g (TApp (TauT.Con TCon{pos, name=clas}) (symItau sym).tau) -- tref clas g :- text " " -- dRho g rho [] - members = sortBy (comparing Symbol.name) (values env) + members = sortBy (comparing _.name) (values meth) content = [ p | d <- [docit g doc, if null members then [] else [h3 (text "Member Functions"), - DL (Just "func") (map (docSym g) members)]], + DL (Just "func") (map (docSym g . _.toSymbol) members)]], p <- d ] -docSym g (SymT {name, doc, typ=ForAll _ rho, env, nativ, pur}) = (code title, content) where +docSym g (SymbolT.T SymT{name, doc, typ=ForAll _ rho, env, nativ, pur}) = (code title, content) where title = (bold • text $ "data ") :- Label name (text " ") :- text " " @@ -244,9 +243,9 @@ docSym g (SymT {name, doc, typ=ForAll _ rho, env, nativ, pur}) = (code title, co nativetype (Just s) = text " = " :- mode pur :- (bold • text $ "native ") :- text s mode true = (bold . text) $ "immutable " mode false = (bold . text) $ "mutable " - members = sortBy (comparing Symbol.name) [ v | v@SymV {pos, name} <- values env, - QName.base name !~ ´\$´] - constrs = sortBy (comparing Symbol.name) [ v | v@SymD {pos} <- values env] + members = sortBy (comparing $ _.name) [ v | v@(SymbolT.V SymV{name}) <- values env, + QName.base name !~ ´\$´] + constrs = sortBy (comparing $ _.name) [ v | v@(SymbolT.D _) <- values env] content = [ p | d <- [docit g doc, if null constrs then [] else [h3 (text "Constructors"), @@ -256,7 +255,7 @@ docSym g (SymT {name, doc, typ=ForAll _ rho, env, nativ, pur}) = (code title, co DL (Just "func") (map (docSym g) members)]], p <- d ] -docSym g (SymD {name, doc, typ, vis, op, flds}) = (code title, docit g doc) where +docSym g (SymbolT.D SymD{name, doc, typ, vis, op, flds}) = (code title, docit g doc) where title = lbl -- label name :- text " " :- typeorfields @@ -269,7 +268,7 @@ docSym g (SymD {name, doc, typ, vis, op, flds}) = (code title, docit g doc) wher fsmap (Field {name=mbs, typ=ForAll _ rho}) = text (fromMaybe "" mbs) :- text (symDcolon g) :- dRho g rho [] drho (ForAll _ r) = dRho2 g r [] -docSym g (sym@SymV {name, typ, doc, nativ, pur, strsig, op, over=(_:_)}) +docSym g (SymbolT.V (sym@SymV{name, typ, doc, nativ, pur, strsig, op, over=(_:_)})) | sigs <- overSig g sym = (code (title sigs), docit g doc) where tpur = if pur then (bold • text $ "pure ") else text "" tnat (Just s) = break :- tpur :- (bold • text $ "native ") :- text s @@ -285,7 +284,7 @@ docSym g (sym@SymV {name, typ, doc, nativ, pur, strsig, op, over=(_:_)}) -- tsig Nothing = badref "no type???" title sigs = label name :- text (symDcolon g) :- types sigs :- tnat nativ :- docop op -- :- tthrows throwing -docSym g (sym@SymV {name, typ, doc, nativ, pur, strsig, op, throwing}) = (code title, docit g doc) where +docSym g (SymbolT.V (sym@SymV{name, typ, doc, nativ, pur, strsig, op, throwing})) = (code title, docit g doc) where tpur = if pur then (bold • text $ "pure ") else text "" tnat (Just s) = break :- tpur :- (bold • text $ "native ") :- text s tnat Nothing = text "" @@ -296,14 +295,14 @@ docSym g (sym@SymV {name, typ, doc, nativ, pur, strsig, op, throwing}) = (code t strBools (S list) = map Strictness.isStrict list -- tsig Nothing = badref "no type???" ovl = case nativ of - Just _ | (o:_) <- overloadOf g sym + Just _ | (o:_) <- overloadOf g (SymbolT.V sym) = spaces 2 :- (bold • text $ "overloads ") :- Ref o.name (text o.name.base) _ = text "" title = label name :- text (symDcolon g) :- tsig typ :- tnat nativ :- tthrows throwing :- ovl :- docop op -docSym g (SymL {name,alias}) = case g.findit alias of +docSym g (SymbolT.L SymL{name,alias}) = case g.findit alias of Nothing -> (badref (name.nice g ++ "links to " ++ alias.nice g ++ " but not found"), []) - Just (vsym@SymV{}) | g.our alias = docSym g vsym.{name, + Just (SymbolT.V vsym) | g.our alias = docSym g $ SymbolT.V vsym.{name, doc = Just ("Alias for '" ++ nicer alias g ++ "'")} Just sym -> docSym g sym @@ -318,18 +317,21 @@ docop tok --- Give the function that is overloaded with this one. overloadOf :: Global -> Symbol -> [Symbol] -overloadOf g sym = [ o | symtab <- g.packages.lookup sym.name.getpack, - symbol <- values symtab, - o@SymV{over=(_:_)} <- symvs symbol, - sym.name `elem` o.over] +overloadOf g sym = [ SymbolT.V o + | symtab <- g.packages.lookup sym.name.getpack + , symbol <- values symtab + , o@SymV{over=(_:_)} <- symvs symbol + , sym.name `elem` o.over + ] where - symvs sym | sym.{env?} = [ sv | sv@SymV{} <- values sym.env ] - | SymV{} <- sym = [sym] - | otherwise = [] + symvs sym + | Just env <- sym.env' = [ sv | SymbolT.V sv <- values env ] + | SymbolT.V sv <- sym = [sv] + | otherwise = [] --- Give a list of sigmas and throws clauses of the overloads for this one -overSig g sym = [(Symbol.typ o, Symbol.throwing o) | q <- Symbol.over sym, o <- Global.findit g q] - +overSig :: Global -> SymV Global -> [(Sigma, [Tau])] +overSig g sym = [(o.typ, o.throwing) | q <- sym.over, SymbolT.V o <- Global.findit g q] --- create a label for a variable or a constructor -- label (MName (TName _ b1) b2) = Label (mangled b1 ++ "." ++ mangled b2) (text b2) @@ -864,45 +866,47 @@ dSigma :: Global -> Sigma -> [Bool] -> Text dSigma g (ForAll [] rho) bs = dRho g rho bs dSigma g (ForAll xs rho) bs = Seq h drho where drho = dRho g rho bs - h = fa :- text " " :- list xs + h = fa :- text " " :- list (map TauT.Var xs) fa = bold (text (symForall g)) -- eForall list [] = text "." list [x] = dTau g x :- text "." list (x:xs) = dTau g x :- text " " :- list xs +dRho :: Global -> Rho -> [Bool] -> Text dRho g rho [] = dRho g rho (repeat false) -dRho g rho (b:bs) = dCtx g (Rho.context rho) :- docu rho where +dRho g rho (b:bs) = dCtx g rho.context :- docu rho where bf = if b then bold else id - docu (RhoFun ctx sigma rho) + docu (RhoT.Fun (RhoFun ctx sigma rho)) | ForAll (_:_) _ <- sigma = text "(" :- bf (dSigma g sigma []) :- text ") " :- text (symArrow g) :- text " " :- dRho g rho bs | isFun sigma g = text "(" :- bf (dSigma g sigma []) :- text ") " :- text (symArrow g) :- text " " :- dRho g rho bs | otherwise = bf (dSigma g sigma []) :- text " " :- text (symArrow g) :- text " " :- dRho g rho bs - docu (RhoTau ctx tau) = bf (dTau g tau) + docu (RhoT.Tau (RhoTau ctx tau)) = bf (dTau g tau) +dRho2 :: Global -> Rho -> [Bool] -> Text dRho2 g rho [] = dRho2 g rho (repeat false) -dRho2 g rho (b:bs) = xpar "(" :- dCtx g (Rho.context rho) :- docu rho :- xpar ")" where +dRho2 g rho (b:bs) = xpar "(" :- dCtx g rho.context :- docu rho :- xpar ")" where bf = if b then bold else id xpar s - | RhoFun _ _ _ <- rho = text s - | RhoTau [] fun <- rho, fun.isFun = text s - | RhoTau [] app <- rho, normalapp app = text s + | RhoT.Fun _ <- rho = text s + | RhoT.Tau RhoTau{tau=fun} <- rho, fun.isFun = text s + | RhoT.Tau RhoTau{tau=app} <- rho, normalapp app = text s | otherwise = text "" where normalapp (app@TApp _ _) - | [TCon {name}, t] <- app.flat, QName.base name == "[]" = false - | (TCon {name}:ts) <- app.flat, QName.base name ~ ´^\(,+\)$´ = false + | [TauT.Con c, t] <- app.flat, c.name.base == "[]" = false + | (TauT.Con c:ts) <- app.flat, c.name.base ~ ´^\(,+\)$´ = false | otherwise = true normalapp _ = false - docu (RhoFun ctx sigma rho) + docu (RhoT.Fun (RhoFun ctx sigma rho)) | ForAll (_:_) _ <- sigma = text "(" :- bf (dSigma g sigma []) :- text ") " :- text (symArrow g) :- text " " :- dRho g rho bs | isFun sigma g = text "(" :- bf (dSigma g sigma []) :- text ") " :- text (symArrow g) :- text " " :- dRho g rho bs | otherwise = bf (dSigma g sigma []) :- text " " :- text (symArrow g) :- text " " :- dRho g rho bs - docu (RhoTau ctx tau) = bf (dTau g tau) + docu (RhoT.Tau (RhoTau ctx tau)) = bf (dTau g tau) dCtx g [] = P "" dCtx g xs | [x] <- xs = single x :- text " " :- text (symDarrow g) :- text " " | otherwise = text "(" :- joint ", " single xs :- text ") " :- text (symDarrow g) :- text " " - where single (Ctx {pos,cname,tau}) = dTau g (TApp (TCon {pos,name=cname}) tau) + where single (Ctx {pos,cname,tau}) = dTau g (TApp (TauT.Con TCon{pos,name=cname}) tau) dTau g tau = showt 2 (unAlias g tau) where @@ -910,14 +914,14 @@ dTau g tau = showt 2 (unAlias g tau) showt 2 (TSig s) = dSigma g s (repeat false) showt 2 x = showt 1 x showt _ (t@TApp _ _) - | [TCon {name}, t] <- tflat, QName.base name == "[]" + | [TauT.Con c, t] <- tflat, c.name.base == "[]" = text "[" :- showt 2 t :- text "]" - | (TCon {name}:ts) <- tflat, QName.base name ~ ´^\(,+\)$´ + | (TauT.Con c:ts) <- tflat, c.name.base ~ ´^\(,+\)$´ = text "(" :- joint ", " (showt 2) ts :- text ")" | isEither tflat = text "(" :- showEither tflat :- text ")" where tflat = Tau.flat t - isEither [TCon{name}, a, b] = QName.base name == "Either" + isEither [TauT.Con c, a, b] = c.name.base == "Either" isEither _ = false showEither [_, a, b] | TApp{} <- a, isEither aflat = showEither aflat :- text " | " :- showt 2 b @@ -926,9 +930,9 @@ dTau g tau = showt 2 (unAlias g tau) showEither _ = text "WTF??" showt 1 (TApp a b) = showt 1 a :- text " " :- showt 0 b showt 1 x = showt 0 x - showt 0 (TVar {var}) = text var + showt 0 (TauT.Var t) = text t.var showt 0 (Meta tv) = badref ("«" ++ show tv.uid ++ "»") - showt 0 (TCon {name}) = tref name g + showt 0 (TauT.Con c) = tref c.name g showt 0 x = text "(" :- showt 2 x :- text ")" showt _ x = Prelude.error ("can't show type with constructor " ++ show (constructor x)) @@ -942,12 +946,20 @@ instance Ord Sigma where ls = (length ts1). <=> (length ts2) derive Eq Context +derive Eq (RhoFun QName) +derive Eq (RhoTau QName) derive Eq Rho +derive Eq (TCon QName) +derive Eq (TVar QName) derive Eq Tau derive Eq Kind derive Ord Context +derive Ord (RhoFun QName) +derive Ord (RhoTau QName) derive Ord Rho +derive Ord (TCon QName) +derive Ord (TVar QName) derive Ord Tau derive Ord Kind