From: Mart Lubbers Date: Wed, 8 Sep 2021 13:25:37 +0000 (+0200) Subject: clean up even more X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=d146fd8b129b2649c521ac5cb81fcfd60d67f311;p=clean-tests.git clean up even more --- diff --git a/datatype/Language.hs b/datatype/Language.hs index c2909f1..9656bcd 100644 --- a/datatype/Language.hs +++ b/datatype/Language.hs @@ -35,15 +35,19 @@ class Expression v where if' :: v Bool -> v a -> v a -> v a bottom :: String -> v a -class Function a v where - fun :: ( (a -> v s) -> In (a -> v s) (Main (v u)) ) -> Main (v u) - infixr 2 |. infixr 3 &. infix 4 ==., /=., <., >., <=., >=. infixl 6 +., -. infixl 7 *., /. +class Function a v where + fun :: ( (a -> v s) -> In (a -> v s) (Main (v u)) ) -> Main (v u) + +true,false :: Expression v => v Bool +true = lit True +false = lit False + class Serialise a where serialise :: a -> Int diff --git a/datatype/Language/GenDSL.hs b/datatype/Language/GenDSL.hs index df227cb..a93f68a 100644 --- a/datatype/Language/GenDSL.hs +++ b/datatype/Language/GenDSL.hs @@ -7,6 +7,10 @@ import Language.Haskell.TH import Data.Char import Control.Monad +import Printer +import Compiler +import Interpreter + className,constructorName,selectorName,predicateName :: Name -> Name className = mkName . (++"'") . stringName constructorName = mkName . map toLower . stringName @@ -16,32 +20,16 @@ predicateName = mkName . ("is"++) . stringName stringName :: Name -> String stringName (Name occ _) = occString occ -numberedArgs :: [a] -> Q [Name] -numberedArgs = zipWithM (\i _->newName $ "f" ++ show i) [0 :: Int ..] - adtFieldName :: Name -> Integer -> Name adtFieldName consName idx = mkName $ map toLower (stringName consName) ++ "f" ++ show idx -data Field = Field { fcons :: Name, ftotal :: Integer, fnum :: Integer, fname :: Name, ftype :: Type } - -toNameType :: Con -> [Field] -toNameType (NormalC consName fs) = [Field {fcons=consName, ftotal=toInteger $ length fs, fnum=i, fname=adtFieldName consName i, ftype=t} | (_, t) <- fs | i <- [0..]] -toNameType (RecC consName fs) = [Field consName (toInteger $ length fs) i n t | (n, _, t)<-fs | i <- [0..]] -toNameType c = fail $ "Unsupported constructor type: " ++ show c - -getConsName :: Con -> Q Name -getConsName (NormalC consName _) +getConsName :: Con -> Q (Name, [(Name, TypeQ)]) +getConsName (NormalC consName fs) | head (stringName consName) == ':' = fail "Infix constructors are not supported" - | otherwise = pure consName -getConsName (RecC consName _) = pure consName + | otherwise = pure (consName, [(adtFieldName consName i, pure t)|(_, t)<-fs | i<-[0..]]) +getConsName (RecC consName fs) = pure (consName, [(n, pure t) | (n, _, t)<-fs]) getConsName c = fail $ "Unsupported constructor type: " ++ show c -int :: Integral a => a -> ExpQ -int = litE . integerL . toInteger - -string :: String -> ExpQ -string = litE . stringL - ifx :: String -> ExpQ -> ExpQ -> ExpQ ifx op a b = infixE (Just a) (varE $ mkName op) (Just b) @@ -55,123 +43,107 @@ fun name args body = funD name [clause args (normalB body) []] genDSL :: Name -> DecsQ genDSL typename = reify typename >>= \info->case info of TyConI (DataD _ _ tyvars _ constructors _) - -> mapM getConsName constructors >>= mkDSL typename tyvars (map toNameType constructors) + -> mapM getConsName constructors >>= mkDSL typename tyvars t - -> fail $ "mkConsClass only supports datatypes and not: " ++ show t + -> fail $ "mkConsClass only supports simple datatypes and not: " ++ show t -mkDSL :: Name -> [TyVarBndr] -> [[Field]] -> [Name] -> DecsQ -mkDSL typeName typeVars fields consNames = sequence [ mkClass, mkPrinter, mkCompiler, mkInterpreter ] +mkDSL :: Name -> [TyVarBndr] -> [(Name, [(Name, TypeQ)])] -> DecsQ +mkDSL typeName typeVars constructors = sequence [ mkClass, mkPrinter, mkCompiler, mkInterpreter ] where + (consNames, fields) = unzip constructors + mkClass :: DecQ mkClass = classD (pure []) (className typeName) [PlainTV (mkName "v")] [] - ( zipWith mkConstructor consNames fields + ( map (uncurry mkConstructor) constructors ++ concatMap (map mkSelector) fields ++ map mkPredicate consNames ) where - view a = varT (mkName "v") `appT` a - arrow = appT . appT arrowT + v = varT $ mkName "v" + arrow x y = [t|$x-> $y|] - mkConstructor :: Name -> [Field] -> DecQ - mkConstructor n fs = sigD (constructorName n) $ foldr arrow resultT $ map (view . pure . ftype) fs + mkConstructor :: Name -> [(Name, TypeQ)] -> DecQ + mkConstructor n fs = sigD (constructorName n) $ foldr arrow resultT $ map (appT v . snd) fs - mkSelector :: Field -> DecQ - mkSelector f = sigD (selectorName (fname f)) $ resultT `arrow` view (pure $ ftype f) + mkSelector :: (Name, TypeQ) -> DecQ + mkSelector (n, t) = sigD (selectorName n) [t|$resultT -> $v $t|] mkPredicate :: Name -> DecQ - mkPredicate n = sigD (predicateName n) $ resultT `arrow` view (conT (mkName "Bool")) + mkPredicate n = sigD (predicateName n) [t|$resultT -> $v Bool|] resultT :: TypeQ - resultT = view $ foldl appT (conT typeName) $ map (varT . getNameTyVarBndr) $ typeVars + resultT = appT v $ foldl appT (conT typeName) $ map (varT . getNameTyVarBndr) $ typeVars mkPrinter :: DecQ - mkPrinter = instanceD (pure []) (appT (conT $ className typeName) (conT $ mkName "Printer")) - $ zipWith mkConstructor consNames fields - ++ concatMap (map mkSelector) fields + mkPrinter = instanceD (pure []) [t|$(conT $ className typeName) Printer|] + $ map (uncurry mkConstructor) constructors + ++ concatMap (map (mkSelector . fst)) fields ++ map mkPredicate consNames where - pl s = varE (mkName "printLit") `appE` string s + pl s = [|printLit $(lift s)|] - mkConstructor :: Name -> [Field] -> DecQ + mkConstructor :: Name -> [(Name, TypeQ)] -> DecQ mkConstructor consName fs = do fresh <- sequence [newName "f" | _<- fs] fun (constructorName consName) (map varP fresh) (pcons `appE` pargs fresh) - where pcons = varE (mkName "printCons") `appE` string (stringName consName) + where pcons = [|printCons $(lift $ stringName consName)|] pargs fresh = foldl (ifx ">->") (pl "") $ map varE fresh - mkSelector :: Field -> DecQ - mkSelector Field{fname=n} = do - fresh <- newName "f" - fun (selectorName n) [varP fresh] (ifx ">>" (varE fresh) $ pl ('.':stringName n)) + mkSelector :: Name -> DecQ + mkSelector n = fun (selectorName n) [] [|\x->x >> $(pl ('.':stringName n))|] mkPredicate :: Name -> DecQ - mkPredicate n = do - fresh <- newName "f" - fun (predicateName n) [varP fresh] (ifx ">->" (pl $ stringName $ predicateName n) $ varE fresh) + mkPredicate n = fun (predicateName n) [] + [|\x-> $(pl $ stringName $ predicateName n) >-> x|] mkCompiler :: DecQ - mkCompiler = instanceD (pure []) (appT (conT $ className typeName) (conT $ mkName "Compiler")) - $ zipWith3 mkConstructor [0..] consNames fields - ++ concat (zipWith (map . mkSelector) [0..] fields) + mkCompiler = instanceD (pure []) [t|$(conT $ className typeName) Compiler|] + $ zipWith (uncurry . mkConstructor) [0..] constructors + ++ concatMap (zipWith mkSelector [0..] . map fst) fields ++ zipWith mkPredicate [0..] consNames where - instrE e = varE (mkName "instr") `appE` listE e - - mkConstructor :: Integer -> Name -> [Field] -> DecQ + mkConstructor :: Integer -> Name -> [(Name, TypeQ)] -> DecQ mkConstructor consNum consName fs = do fresh <- sequence [newName "f" | _<-fs] fun (constructorName consName) (map varP fresh) $ ifx "*>" pushCons $ ifx "<*" (mkBody $ map varE fresh) storeHeap - where storeHeap = instrE [conE (mkName "Sth") `appE` (ifx "+" (int 1) (int $ length fs))] - mkBody = foldl (ifx "<*>") (varE (mkName "pure") `appE` conE consName) - pushCons = instrE [conE (mkName "Push") `appE` int consNum] + where storeHeap = [|instr [Sth $ 1 + $(lift $ length fs)]|] + mkBody = foldl (ifx "<*>") [|pure $(conE consName)|] + pushCons = [|instr [Push $(lift consNum)]|] - mkSelector :: Integer -> Field -> DecQ - mkSelector consNum Field{fname=f} = do - fresh <- newName "f" - fun (selectorName f) [varP fresh] - $ ifx ">>" (varE fresh) $ instrE [conE (mkName "Ldh") `appE` int consNum] + mkSelector :: Integer -> Name -> DecQ + mkSelector fn n = fun (selectorName n) [] [|\x->x >> instr [Ldh $(lift fn)]|] mkPredicate :: Integer -> Name -> DecQ - mkPredicate consNum consName = do - fresh <- newName "f" - fun (predicateName consName) [varP fresh] - $ ifx ">>" (varE fresh) $ instrE - [ conE (mkName "Ldh") `appE` int (-1) - , conE (mkName "Push") `appE` int consNum - , conE (mkName "Eq") - ] + mkPredicate consNum consName = fun (predicateName consName) [] + [|\x->x >> instr [Ldh (-1), Push $(lift consNum), Eq]|] mkInterpreter :: DecQ - mkInterpreter = instanceD (pure []) (appT (conT $ className typeName) (conT $ mkName "Interpreter")) - $ zipWith mkConstructor consNames fields - ++ concatMap (map mkSelector) fields - ++ zipWith mkPredicate consNames fields + mkInterpreter = instanceD (pure []) [t|$(conT $ className typeName) Interpreter|] + $ map (uncurry mkConstructor) constructors + ++ concatMap (\(cn, fs)->zipWith (mkSelector cn (length fs)) [0..] (map fst fs)) constructors + ++ map (uncurry mkPredicate) constructors where - wildcase e = if length consNames == 1 then [] else - [match wildP (normalB e) []] - - mkConstructor :: Name -> [Field] -> DecQ + mkConstructor :: Name -> [(Name, TypeQ)] -> DecQ mkConstructor consName fs = do fresh <- sequence [newName "f" | _<-fs] fun (constructorName consName) (map varP fresh) - $ foldl (ifx "<*>") (varE (mkName "pure") `appE` conE consName) (map varE fresh) + $ foldl (ifx "<*>") [|pure $(conE consName)|] (map varE fresh) - mkSelector :: Field -> DecQ - mkSelector f = do + mkSelector :: Name -> Int -> Int -> Name -> DecQ + mkSelector consName ftotal fnum n = do fresh <- newName "f" - fun (selectorName $ fname f) [varP fresh] $ - ifx ">>=" (varE fresh) $ lamCaseE $ mkMatch : wilds + fun (selectorName n) [varP fresh] $ + ifx ">>=" (varE fresh) $ lamCaseE (mkMatch:wilds) where mkMatch = do fresh <- newName "e" - match (conP (fcons f) [if fnum f == i then (varP fresh) else wildP | i<-[0..ftotal f-1]]) - (normalB $ varE (mkName "pure") `appE` varE fresh) [] - wilds = wildcase (varE (mkName "fail") `appE` string "Exhausted case") - - mkPredicate :: Name -> [Field] -> DecQ - mkPredicate n fs = do - fresh <- newName "f" - fun (predicateName n) [varP fresh] $ ifx "<$>" (lamCaseE (mkMatch:wilds)) (varE fresh) - where mkMatch = match (conP n [wildP | _<-fs]) (normalB $ conE (mkName "True")) [] - wilds = wildcase (conE $ mkName "False") + match (conP consName [if fnum == i then varP fresh else wildP | i<-[0..ftotal-1]]) + (normalB [|pure $(varE fresh)|]) [] + wilds = if length consNames == 1 then [] else + [match wildP (normalB [|fail "Exhausted case"|]) []] + + mkPredicate :: Name -> [(Name, TypeQ)] -> DecQ + mkPredicate n fs = fun (predicateName n) [] + $ if length consNames == 1 then [|\_->true|] else + [|\x->x >>= \p->case p of $(conP n [wildP | _<-fs]) -> true; _ -> false|] diff --git a/datatype/Language/Quote.hs b/datatype/Language/Quote.hs index 60c0d7b..afa5bde 100644 --- a/datatype/Language/Quote.hs +++ b/datatype/Language/Quote.hs @@ -6,7 +6,9 @@ module Language.Quote (dsl) where import Data.Char import Data.Functor.Identity +import Control.Monad +import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote @@ -16,7 +18,7 @@ import Text.Parsec.Expr as E import qualified Text.Parsec.Token as P import Text.Parsec.Language (haskell) -- -import Language.GenDSL +import Language.GenDSL as L dsl :: QuasiQuoter dsl = QuasiQuoter @@ -26,18 +28,13 @@ dsl = QuasiQuoter , quoteDec = undefined } where - parseExpr :: MonadFail m => String -> Loc -> m Exp - parseExpr s loc = - case runParser p () "" s of - Left err -> fail $ show err - Right e -> return e + parseExpr :: String -> Loc -> ExpQ + parseExpr s loc = either (fail . show) id $ runParser p () file s where file = loc_filename loc (line, col) = loc_start loc - p = getPosition >>= setPosition . mPos >> whiteSpace *> funOrExpr <* eof - mPos = (flip setSourceName) file . - (flip setSourceLine) line . - (flip setSourceColumn) col + p = getPosition >>= setPosition . mPos >> whiteSpace *> expr <* eof + mPos p = setSourceName (setSourceLine (setSourceColumn p col) line) file -- Lexer identifier,operator :: Parser String @@ -63,21 +60,10 @@ whiteSpace :: Parser () whiteSpace = P.whiteSpace haskell -- Parser -funOrExpr :: Parser Exp -funOrExpr = expr - -func :: Parser Exp -func = many1 ((,) <$> many1 pat <* reservedOp "=" <*> expr) >>= mkFun - where - mkFun :: MonadFail m => [([Pat], Exp)] -> m Exp - mkFun es - | all ((==1) . length . fst) es = pure $ LamE [VarP (mkName "x")] $ mkCase (VarE (mkName "x")) [(p, e)|([p], e)<-es] - mkFun _ = fail "Multiple patterns/entries not supported yet" - -expr :: Parser Exp +expr :: Parser ExpQ expr = buildExpressionParser --Postfix record selectors - [ [E.Postfix (fmap (\s e->VarE (selectorName (mkName s)) `AppE` e) $ P.lexeme haskell $ char '.' *> identifier)] + [ [E.Postfix (fmap (\s e->varE (selectorName (mkName s)) `appE` e) $ P.lexeme haskell $ char '.' *> identifier)] , [bin "^" AssocRight] , [bin "*" AssocLeft, bin "/" AssocLeft] , [bin "+" AssocLeft, bin "-" AssocLeft] @@ -88,64 +74,78 @@ expr = buildExpressionParser , [E.Infix (fmap ifx $ lexeme $ char '`' *> identifier <* char '`') AssocRight] ] basic where - bin :: String -> Assoc -> Operator String () Identity Exp + bin :: String -> Assoc -> Operator String () Identity ExpQ bin str = E.Infix $ ifx (str++".") <$ sat operator (str==) (("Expected operator " ++ str ++ " but got ")++) - basic :: Parser Exp + basic :: Parser ExpQ basic - = try (AppE . VarE <$> var <*> (TupE <$> parens (commaSep expr))) - <|> VarE <$> var - <|> mkCase <$ reserved "case" <*> expr <* reserved "of" <*> many1 ((,) <$> pat <* reservedOp "->" <*> expr) - <|> (\i t e->VarE (mkName "if'") `AppE` i `AppE` t `AppE` e) <$ reserved "if" <*> expr <* reserved "then" <*> expr <* reserved "else" <*> expr + = try (appE . varE <$> var <*> (tupE <$> parens (commaSep expr))) + <|> varE <$> var + <|> mkCase <$ reserved "case" <*> expr <* reserved "of" <*> many1 ((,) <$> pat <*> body) + <|> (\i t e->[|if' $i $t $e|]) <$ reserved "if" <*> expr <* reserved "then" <*> expr <* reserved "else" <*> expr <|> parens expr - <|> mkLit . LitE <$> lit - <|> mkLit . ConE . mkName <$> sat identifier ("True"==) ("Expected True but got: "++) - <|> mkLit . ConE . mkName <$> sat identifier ("False"==) ("Expected False but got: "++) + <|> mkLit . litE <$> lite + <|> [|lit True|] <$ sat identifier ("True"==) ("Expected True but got: "++) + <|> [|lit False|] <$ sat identifier ("False"==) ("Expected False but got: "++) + + match :: Parser (PatQ, BodyQ) + match = (,) <$> pat <*> body -pat :: Parser Pat + body :: Parser BodyQ + body = guardedB <$> many1 (liftM2 (,) <$> guarded <* reservedOp "->" <*> expr) + <|> normalB <$ reservedOp "->" <*> expr + where + guarded :: Parser GuardQ + guarded = normalG <$ reservedOp "|" <*> expr + +pat :: Parser PatQ pat - = try (RecP <$> con <*> braces (commaSep $ (,) <$> var <* reservedOp "=" <*> pat)) - <|> ConP <$> con <*> many pat - <|> try (AsP <$> var <* reservedOp "@" <*> pat) - <|> VarP <$> var - <|> WildP <$ symbol "_" - <|> LitP <$> lit + = try (recP <$> con <*> braces (commaSep fieldpat)) + <|> conP <$> con <*> many pat + <|> try (asP <$> var <* reservedOp "@" <*> pat) + <|> varP <$> var + <|> wildP <$ symbol "_" + <|> litP <$> lite <|> parens pat + where fieldpat = liftM2 (,) . pure <$> var <* reservedOp "=" <*> pat -lit :: Parser Lit -lit - = CharL <$> P.charLiteral haskell - <|> IntegerL <$> P.natural haskell +lite :: Parser Lit +lite + = charL <$> P.charLiteral haskell + <|> integerL <$> P.natural haskell sat :: Parser a -> (a -> Bool) -> (a -> String) -> Parser a sat p f msg = try (p >>= \a->if f a then pure a else fail (msg a)) -mkLit :: Exp -> Exp -mkLit = AppE $ VarE $ mkName "lit" +mkLit :: ExpQ -> ExpQ +mkLit x = [|lit $x|] con,var :: Parser Name con = mkName <$> sat identifier (isUpper . head) ("Not a data constructor: "++) var = mkName <$> sat identifier (isLower . head) ("Not a variable identifier: "++) -- Convert case to if statements -mkCase :: Exp -> [(Pat, Exp)] -> Exp -mkCase name cases = foldr (uncurry mkCaseMatch) (VarE (mkName "bottom") `AppE` LitE (StringL "Exhausted case")) cases +mkCase :: ExpQ -> [(PatQ, BodyQ)] -> ExpQ +mkCase name cases = foldr (uncurry mkCaseMatch) [|bottom "Exhausted case"|] cases where - mkCaseMatch :: Pat -> Exp -> Exp -> Exp - mkCaseMatch a e rest = case mkCasePred name a of - [] -> mkCaseLets (mkCaseBinding name a) e - ps -> VarE (mkName "if'") `AppE` foldl1 (ifx "&.") ps `AppE` (mkCaseLets (mkCaseBinding name a) e) `AppE` rest - - mkCaseLets :: [Dec] -> Exp -> Exp + mkCaseMatch :: PatQ -> BodyQ -> ExpQ -> ExpQ + mkCaseMatch qa qb rest = qb >>= \b->case b of + NormalB e -> qa >>= \a->case mkCasePred name a of + [] -> ex a e + ps -> [|if' $(foldl1 (ifx "&.") ps) $(ex a e) $rest|] + GuardedB _ -> fail "Guarded bodies not yet supported" + where ex a e = mkCaseLets (mkCaseBinding name a) $ pure e + + mkCaseLets :: [DecQ] -> ExpQ -> ExpQ mkCaseLets [] e = e - mkCaseLets defs e = LetE defs e + mkCaseLets defs e = letE defs e conPtoRecP :: Name -> [Pat] -> Pat conPtoRecP consName = RecP consName . zip (map (adtFieldName consName) [0..]) - mkCasePred :: Exp -> Pat -> [Exp] - mkCasePred e (LitP l) = [ifx "==." (VarE (mkName "lit") `AppE` LitE l) e] + mkCasePred :: ExpQ -> Pat -> [ExpQ] + mkCasePred e (LitP l) = [[|lit $(litE l) ==. $e|]] mkCasePred _ (VarP _) = [] mkCasePred e (ConP cons fs) = mkCasePred e $ conPtoRecP cons fs mkCasePred e (InfixP l cons r) = mkCasePred e (ConP cons [l,r]) @@ -155,20 +155,20 @@ mkCase name cases = foldr (uncurry mkCaseMatch) (VarE (mkName "bottom") `AppE` L mkCasePred e (BangP p) = mkCasePred e p mkCasePred e (AsP _ p) = mkCasePred e p mkCasePred _ WildP = [] - mkCasePred e (RecP cons fs) = VarE (predicateName cons) `AppE` e - : concatMap (\(n, p)->mkCasePred (VarE (selectorName n) `AppE` e) p) fs + mkCasePred e (RecP cons fs) = varE (predicateName cons) `appE` e + : concatMap (\(n, p)->mkCasePred (varE (selectorName n) `appE` e) p) fs mkCasePred _ p = error $ "Unsupported pat: " ++ show p - mkCaseBinding :: Exp -> Pat -> [Dec] + mkCaseBinding :: ExpQ -> Pat -> [DecQ] mkCaseBinding _ (LitP _) = [] - mkCaseBinding e (VarP v) = [FunD v [Clause [] (NormalB $ e) []]] + mkCaseBinding e (VarP v) = [funD v [clause [] (normalB e) []]] mkCaseBinding e (ConP cons fs) = mkCaseBinding e $ conPtoRecP cons fs mkCaseBinding e (InfixP l cons r) = mkCaseBinding e (ConP cons [l,r]) mkCaseBinding e (UInfixP l cons r) = mkCaseBinding e (ConP cons [l,r]) mkCaseBinding e (ParensP p) = mkCaseBinding e p mkCaseBinding e (TildeP p) = mkCaseBinding e p mkCaseBinding e (BangP p) = mkCaseBinding e p - mkCaseBinding e (AsP n p) = FunD n [Clause [] (NormalB $ e) []]:mkCaseBinding e p + mkCaseBinding e (AsP n p) = funD n [clause [] (normalB e) []]:mkCaseBinding e p mkCaseBinding _ WildP = [] - mkCaseBinding e (RecP _ fs) = concatMap (\(n, p)->mkCaseBinding (VarE (selectorName n) `AppE` e) p) fs + mkCaseBinding e (RecP _ fs) = concatMap (\(n, p)->mkCaseBinding (varE (selectorName n) `appE` e) p) fs mkCaseBinding _ p = error $ "Unsupported pat: " ++ show p diff --git a/datatype/Main.hs b/datatype/Main.hs index ec7c51b..e794d9b 100644 --- a/datatype/Main.hs +++ b/datatype/Main.hs @@ -129,7 +129,9 @@ f7' ) :- fun ( \mullist->( -- \l->if' (isNil l) (lit 1) (consf0' l *. mullist (consf1' l)) \l->[dsl|case l of - Cons e rest -> e * mullist(rest) + Cons e rest + | e == 1 -> mullist (rest) + | otherwise -> e * mullist(rest) Nil -> 1 |] ) :- fun ( \fac->( diff --git a/datatype/Tuple.hs b/datatype/Tuple.hs index ab0eff5..8b76339 100644 --- a/datatype/Tuple.hs +++ b/datatype/Tuple.hs @@ -6,6 +6,7 @@ import Printer import Compiler import Interpreter import Language.GenDSL +import Language data Tuple a b = Tuple a b $(genDSL ''Tuple)