diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history for nanopass +## 0.0.3.2 -- 2025-12-02 + +* fixed issue where passes would not compile if the target language had parameters + ## 0.0.3.1 -- 2025-11-12 * updated dependency version bounds; now compiles on ghc 9.2 through 9.12 diff --git a/app/Lang.hs b/app/Lang.hs --- a/app/Lang.hs +++ b/app/Lang.hs @@ -14,10 +14,10 @@ deriving (Show,Functor,Foldable,Traversable) [deflang| -((L0 funny) +((L0 ann funny) (Expr (Var String) - (Lam String (* Stmt)) + (Lam ann String (* Stmt)) (App Expr Expr) (Nope String) (UhOh (& @@ -32,5 +32,5 @@ ) ) |] -deriving stock instance (Show funny) => Show (Expr funny) -deriving stock instance (Show funny) => Show (Stmt funny) +deriving stock instance (Show ann, Show funny) => Show (Expr ann funny) +deriving stock instance (Show ann, Show funny) => Show (Stmt ann funny) diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -11,16 +11,16 @@ import qualified Lang as L0 [deflang| -(L1 from L0:L0 +((L1 ann) from L0:L0 (* Expr (- Lam) - (+ Lam String Expr) + (+ Lam ann String Expr) (- Nope) ) (- Stmt) ) |] -deriving stock instance Show Expr +deriving stock instance (Show ann) => Show (Expr ann) $(pure []) @@ -28,7 +28,7 @@ main :: IO () main = do - let theF = L0.Lam "x" + let theF = L0.Lam () "x" [ L0.Let "y" $ L0.Var "x" , L0.Expr () $ L0.Var "y" ] @@ -36,14 +36,14 @@ pPrint theE pPrint $ compile theE -compile :: L0.Expr () -> Expr +compile :: L0.Expr ann () -> Expr ann compile = descendExprI xlate where xlate = XlateI { onExprI = const Nothing - , onExprLamI = \var body -> case body of - [] -> Lam var $ Var var - L0.Expr () e1 : _ -> Lam var $ compile e1 - L0.Let _ body1 : _ -> Lam var $ compile body1 + , onExprLamI = \ann var body -> case body of + [] -> Lam ann var $ Var var + L0.Expr () e1 : _ -> Lam ann var $ compile e1 + L0.Let _ body1 : _ -> Lam ann var $ compile body1 , onExprNopeI = Var } diff --git a/nanopass.cabal b/nanopass.cabal --- a/nanopass.cabal +++ b/nanopass.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: nanopass -version: 0.0.3.1 +version: 0.0.3.2 synopsis: Create compilers using small passes and many intermediate representations. description: Uses Template Haskell to facilitate using a vast number of intermediate representations. diff --git a/src/Language/Nanopass/LangDef.hs b/src/Language/Nanopass/LangDef.hs --- a/src/Language/Nanopass/LangDef.hs +++ b/src/Language/Nanopass/LangDef.hs @@ -104,14 +104,14 @@ , case (l.langInfo.baseDefdLang, l.langInfo.originalProgram) of (Just baseLang, Just origProg) -> unlines [ "" - , "This language was generated based on the langauge t'" ++ show baseLang.langName.th ++ "'" + , "This language was generated based on the language t'" ++ show baseLang.langName.th ++ "'" , "using the following 'Language.Nanopass.deflang' program:" , "" , unlines . fmap ("> " ++) . lines $ origProg ] (Just baseLang, Nothing) -> unlines [ "" - , "This language was generated based on the langauge t'" ++ show baseLang.langName.th ++ "'." + , "This language was generated based on the language t'" ++ show baseLang.langName.th ++ "'." ] (Nothing, Just origProg) -> unlines [ "" @@ -149,7 +149,7 @@ gets ((vName.th `elem`) . langTyvars) >>= \case True -> do pure $ TH.VarT vName.th - False -> fail $ concat ["in a nanopass language definition: unknown langauge parameter ", show vName] + False -> fail $ concat ["in a nanopass language definition: unknown language parameter ", show vName] subtermType (CtorType cName argDescs) = do args <- subtermType `mapM` argDescs pure $ foldl TH.AppT (TH.ConT cName.th) args @@ -206,7 +206,7 @@ f (Just tvs) (_, _, tvs', _) | tvs == (fixup <$> tvs') = pure (Just tvs) | otherwise = fail $ concat - [ "corrupt language has differing paramaters between syntactic categories. expected:\n" + [ "corrupt language has differing parameters between syntactic categories. expected:\n" , " " ++ show tvs ++ "\n" , "got:\n" , " " ++ show (fixup <$> tvs') @@ -267,9 +267,10 @@ , Just cName <- toUpDotName (TH.nameBase thName) = do decodedArgs <- recurse `mapM` args pure $ CtorType (ValidName cName thName) decodedArgs - recurse (TH.VarT thName) - | Just tvName <- toLowName (TH.nameBase thName) - = pure $ VarType (ValidName tvName thName) + recurse (TH.VarT reifyName) + | thName <- fixup reifyName + , Just tvName <- toLowName thName + = pure $ VarType (ValidName tvName (TH.mkName thName)) recurse otherType = fail $ "corrupt subterm type:\n" ++ show otherType ++ "\n in type:\n" ++ show type0 fromTuple :: TH.Type -> Maybe [TH.Type] fromTuple t0 = case loop t0 of diff --git a/src/Language/Nanopass/QQ.hs b/src/Language/Nanopass/QQ.hs --- a/src/Language/Nanopass/QQ.hs +++ b/src/Language/Nanopass/QQ.hs @@ -49,7 +49,7 @@ bad ctx _ = fail $ "`deflang` quasiquoter cannot be used in " ++ ctx ++ " context,\n\ \it can only appear as part of declarations." --- | Define automatic translation between two langauges. +-- | Define automatic translation between two languages. -- This creates an @Xlate@ type and the @descend\@ family of functions, -- as well as pure variants (@XlateI@ and @descend\I@) and a lifting function @idXlate@. -- A translation function is generated for each syntactic category with the same name in both source and target languages. diff --git a/src/Language/Nanopass/Xlate.hs b/src/Language/Nanopass/Xlate.hs --- a/src/Language/Nanopass/Xlate.hs +++ b/src/Language/Nanopass/Xlate.hs @@ -55,8 +55,8 @@ , xlateFParam :: TH.Name -- ^ a type for an Applicative parameter , xlateNonterms :: [XlateNontermDef] -- ^ information about the syntactic cateories shared by both source and target - -- this is used to allow users to override the bahavior of automatic translation - , xlateProds :: [XlateProd] -- FIXME these should go under xlateNonterms, probly + -- this is used to allow users to override the behavior of automatic translation + , xlateProds :: [XlateProd] -- FIXME these should go under xlateNonterms, probably -- ^ information about the productions in the source that are missing in the target -- this is so that we require the user to supply these in an Xlate type , xlateFrom :: Language 'Valid UpDotName @@ -358,7 +358,7 @@ , "Some (hopefully most) of this function was automatically generated by nanopass." , unwords [ "It is parameterized by an t'Xlate', which" - , "fills holes for which nanopass could not automatcially determine a translation, and also" + , "fills holes for which nanopass could not automatically determine a translation, and also" , "allows for automatic translation to be overridden." ] ] diff --git a/src/Nanopass/Internal/Extend.hs b/src/Nanopass/Internal/Extend.hs --- a/src/Nanopass/Internal/Extend.hs +++ b/src/Nanopass/Internal/Extend.hs @@ -133,7 +133,7 @@ -> Either Error (Map UpName (Production 'Valid)) extendProductions nts tvs orig mods = do let (additions, deletions) = partitionProductionsEdits mods - -- NOTE this forM_ is over-restricive because I don't have a way to modify/outright replace productions + -- NOTE this forM_ is over-restrictive because I don't have a way to modify/outright replace productions -- forM_ additions $ \add -> case add.prodName.name `elem` deletions of -- True -> Left $ IllegalProductionAddedAlsoDeleted add.prodName.name -- _ -> pure () diff --git a/src/Nanopass/Internal/Parser.hs b/src/Nanopass/Internal/Parser.hs --- a/src/Nanopass/Internal/Parser.hs +++ b/src/Nanopass/Internal/Parser.hs @@ -56,7 +56,7 @@ ------------------------------ type ParseResult = Either - (Language 'Unvalidated UpName) -- ^ base language defintion + (Language 'Unvalidated UpName) -- ^ base language definition LangMod -- ^ modifications to a language -- | @ @@ -393,8 +393,8 @@ -- | @ -- Pass --- ::= (\'from\' \ source lagnuage name --- \'to\' \ target lagnuage name +-- ::= (\'from\' \ source language name +-- \'to\' \ target language name -- \ documentation -- @ -- diff --git a/src/Nanopass/Internal/Representation.hs b/src/Nanopass/Internal/Representation.hs --- a/src/Nanopass/Internal/Representation.hs +++ b/src/Nanopass/Internal/Representation.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds #-} -- DEBUG {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} @@ -14,7 +14,7 @@ , Nonterm(..) , Production(..) , TypeDesc(..) - -- * Types for Modifying Manguages + -- * Types for Modifying Languages , LangMod(..) , NontermsEdit(..) , ProductionsEdit(..) @@ -146,7 +146,7 @@ deriving(Show) -- | Seen as a Haskell entity, each 'Language' is a set of mutually-recursive types. --- Seen from the persepctive of a CFG, each of these types is a non-terminal used to define the abstract grammar of a language. +-- Seen from the perspective of a CFG, each of these types is a non-terminal used to define the abstract grammar of a language. -- -- See 'Language' for attributing a name to a set of these types. data LanguageInfo v = LanguageInfo