packages feed

paragon 0.1.6 → 0.1.7

raw patch · 5 files changed

+29/−67 lines, 5 files

Files

paragon.cabal view
@@ -1,5 +1,5 @@ Name:                   paragon-Version:                0.1.6+Version:                0.1.7 License:                BSD3 License-File:           LICENSE Author:                 Niklas Broberg@@ -50,7 +50,6 @@                         Language.Java.Paragon.TypeCheck.Uniq,                         Language.Java.Paragon.QuasiQuoter,                         Language.Java.Paragon.Compile,-                        Language.Java.Paragon.PiGeneration,                         Language.Java.Paragon.Verbosity    Hs-source-dirs:       src@@ -83,7 +82,6 @@                         Language.Java.Paragon.TypeCheck.Uniq,                         Language.Java.Paragon.QuasiQuoter,                         Language.Java.Paragon.Compile,-                        Language.Java.Paragon.PiGeneration,                         Language.Java.Paragon.Verbosity
src/Language/Java/Paragon.hs view
@@ -31,7 +31,7 @@   when (not (null files)) $     compile flags (head files) -- TODO: Enable multiple files -data Flag = Verbose Int | Version | Help+data Flag = Verbose Int | Version | Help | PiPath String   deriving (Show, Eq)  versionString, usageHeader :: String@@ -47,6 +47,9 @@                  (NoArg Version)       "Show version number"     , Option ['h','?'] ["help"]                  (NoArg Help)          "Show this help"+    , Option ['p'] ["pipath"]          +                 (ReqArg PiPath "<path>")+                 "Path to the root directory for Paragon interface (.pi) files (default is . )"     ]  compilerOpts :: [String] -> IO ([Flag], [String])@@ -68,10 +71,13 @@ compile :: [Flag] -> String -> IO () compile flags filePath = do   let (directory,fileName) = splitFileName filePath --relative or absolute path?+  let pDir = case [ dir | PiPath dir <- flags ] of+               p:_ -> p+               _ -> "."   fc <- readFile filePath   ast <- liftE $ parser compilationUnit fc   extraPrint "Parsing complete!"-  ast2 <- typeCheck directory ast+  ast2 <- typeCheck directory pDir ast   extraPrint "Type checking complete!"   genFiles filePath  ast2   extraPrint "File generation complete!"
src/Language/Java/Paragon/Parser.hs view
@@ -38,6 +38,7 @@ 
 import Language.Java.Paragon.Lexer ( L(..), Token(..), lexer)
 import Language.Java.Paragon.Syntax
+import Language.Java.Paragon.Pretty
 
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Pos
@@ -121,6 +122,7 @@ classOrInterfaceDecl = do
     ms <- list modifier
     de <- (do cd <- classDecl
+              checkConstrs (cd [])
               return $ \ms -> ClassTypeDecl (cd ms)) <|>
           (do id <- interfaceDecl
               return $ \ms -> InterfaceTypeDecl (id ms))
@@ -1296,6 +1298,15 @@ ------------------------------------------------------------
 
 test = "public class Foo { }"
+
+checkConstrs :: ClassDecl -> P ()
+checkConstrs (ClassDecl _ i _ _ _ cb) = do
+    let errs = [ ci | ConstructorDecl _ _ ci _ _ _ <- universeBi cb, ci /= i ]
+    if null errs then return () 
+     else fail $ "Declaration of class " ++ prettyPrint i 
+                  ++ " cannot contain constructor with name " 
+                  ++ prettyPrint (head errs)
+    
 
 -----------------------------------------------------
− src/Language/Java/Paragon/PiGeneration.hs 
@@ -1,53 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-module Language.Java.Paragon.PiGeneration where--import Language.Java.Paragon.Syntax-import Control.Applicative-import Language.Java.Paragon.QuasiQuoter--piTransform :: CompilationUnit -> CompilationUnit -piTransform  = transformCompilationUnit---for generating Pi there should be a package name--- no imports--- one type for each compilationUnit since the execution is for one class but we can transform without considering that condition-transformCompilationUnit :: CompilationUnit -> CompilationUnit-transformCompilationUnit (CompilationUnit mpDecl _  tdecls)-  = CompilationUnit mpDecl []  (transformTypeDecl<$>tdecls)------------------transformTypeDecl :: TypeDecl -> TypeDecl-transformTypeDecl (InterfaceTypeDecl (InterfaceDecl mods iden tparams refts ib))-  =  ClassTypeDecl (ClassDecl mods iden tparams Nothing refts (transformInterfaceBody ib)) -- Maybe typeDecl-transformTypeDecl (ClassTypeDecl (ClassDecl mods iden tparams mt refts (ClassBody dcls))) -  = ClassTypeDecl (ClassDecl mods iden tparams mt refts (ClassBody $ transformDecl<$>dcls))-----------------    -transformDecl :: Decl -> Decl    -transformDecl (MemberDecl md) = MemberDecl $ transformMemberDecl md ------------------transformInterfaceBody :: InterfaceBody -> ClassBody-transformInterfaceBody (InterfaceBody mds) = ClassBody $ (\md->MemberDecl (transformMemberDecl md))<$>mds---------------transformMemberDecl :: MemberDecl -> MemberDecl -transformMemberDecl f@(FieldDecl fmods [typeQQ|actor|] vdecs) = f-transformMemberDecl (FieldDecl fmods ft vdecs) = (FieldDecl fmods ft (transformVarDecls vdecs))-transformMemberDecl m@(MethodDecl mmods mtparams mmaybet mident mformparams mexceptionspecs mb) -  | Typemethod `elem` mmods  = m-  | otherwise  = MethodDecl mmods mtparams mmaybet mident mformparams mexceptionspecs (transformMethodBody mb)-transformMemberDecl (ConstructorDecl cmods ctparams cident cformparams cexceptionspecs cb) -  = ConstructorDecl cmods ctparams cident cformparams cexceptionspecs (transformConstructorBody cb)-transformMemberDecl x = x--- I assumed the LockDecl and PolicyDecl should not be touch --- Also I didnt write code for inner classes/interfaces --------transformVarDecls :: [VarDecl] -> [VarDecl]-transformVarDecls vds = [ VarDecl varDeclId Nothing | (VarDecl varDeclId _) <- vds]---------transformMethodBody :: MethodBody -> MethodBody-transformMethodBody = const $MethodBody  Nothing -- [methodBodyQQ|{}|] --- maybe we have to add nothing instead of "just emptyMethodBody" ---------transformConstructorBody ::  ConstructorBody -> ConstructorBody-transformConstructorBody (ConstructorBody explConstrInvm bs) = ConstructorBody  Nothing [] -- second argument nothing ?----
src/Language/Java/Paragon/TypeCheck.hs view
@@ -33,11 +33,11 @@  import Data.Generics.Uniplate.Data (transformBi) -typeCheck :: DirectoryPath -> CompilationUnit -> IO CompilationUnit-typeCheck currentDir ast@(CompilationUnit pkg imps [td]) = do+typeCheck :: DirectoryPath -> DirectoryPath -> CompilationUnit -> IO CompilationUnit+typeCheck currentDir piDir ast@(CompilationUnit pkg imps [td]) = do       let (skoTd, skoTy) = skolemTypeDecl td       e <- runTcCont skoTy $ do-             withEnvFromImps "" "" allImps $ do+             withEnvFromImps piDir "" allImps $ do                --debug "Import env setup"                withEnvFromImp currentDir (tdIdentStr skoTd) thisPackage $ do                  --debug "TypeMap completed"@@ -111,19 +111,19 @@   withEnvFromImps :: DirectoryPath -> String -> [ImportDecl] -> TcCont r a -> TcCont r a-withEnvFromImps dir thisStr is tcba = do+withEnvFromImps piDir thisStr is tcba = do     --debug ("withEnvFromImpsies: " ++ show is)  --withEnvFromImps dir thisStr (imp:is) =-    withFoldMap (withEnvFromImp dir thisStr) is $ tcba+    withFoldMap (withEnvFromImp piDir thisStr) is $ tcba --    withEnvFromImp dir thisStr imp . withEnvFromImps dir thisStr is   withEnvFromImp :: DirectoryPath -> String -> ImportDecl -> TcCont r a -> TcCont r a -- import java.*;-withEnvFromImp dir thisStr imp@(ImportDecl False (Name pkgNames) True) tcba = do+withEnvFromImp piDir thisStr imp@(ImportDecl False (Name pkgNames) True) tcba = do     --debug $ "Setting up import of: " ++ prettyPrint (Name pkgNames)     let relative    = pathOf pkgNames-        absoluteDir = dir ++ pSep:relative ++ [pSep]+        absoluteDir = piDir ++ pSep:relative ++ [pSep]     names <- liftIO $ getDirectoryContents absoluteDir     let classPathsAndNames = [ (absoluteDir ++ name, takeBaseName name)                                | name <- names @@ -133,10 +133,10 @@     withEnvFromPkg pkgNames classPathsAndNames $ tcba  -- import java.TypeName;-withEnvFromImp dir _ imp@(ImportDecl False (Name clsPkgName) False) tcba = do+withEnvFromImp piDir _ imp@(ImportDecl False (Name clsPkgName) False) tcba = do     --debug $ "Setting up single import of: " ++ show clsPkgName     let relative     = pathOf clsPkgName-        absoluteFile = dir ++ pSep:relative ++ ".pi"+        absoluteFile = piDir ++ pSep:relative ++ ".pi"         (Ident className) = last clsPkgName         pkgNames = init clsPkgName     withEnvFromSingleClass pkgNames absoluteFile className $ tcba