Commit eadbc426 authored by Michael Hanus's avatar Michael Hanus
Browse files

GenInt moved to browser/ShowFlatCurry

parent ceaa5c29
...@@ -7,6 +7,8 @@ Curry_Main_Goal.curry ...@@ -7,6 +7,8 @@ Curry_Main_Goal.curry
# executables # executables
addtypes/AddTypes addtypes/AddTypes
browser/BrowserGUI browser/BrowserGUI
browser/GenInt
browser/ShowFlatCurry
browser/SourceProgGUI browser/SourceProgGUI
CASS/cass CASS/cass
CASS/cass_worker CASS/cass_worker
...@@ -20,7 +22,6 @@ currytest/CurryTest ...@@ -20,7 +22,6 @@ currytest/CurryTest
cusage/CheckUsage cusage/CheckUsage
ertools/ERD2CDBI ertools/ERD2CDBI
ertools/erd2curry ertools/erd2curry
genint/GenInt
importcalls/ImportCalls importcalls/ImportCalls
optimize/bindingopt optimize/bindingopt
optimize/binding_optimization/BindingOpt optimize/binding_optimization/BindingOpt
......
...@@ -5,17 +5,14 @@ ...@@ -5,17 +5,14 @@
-- add access to a new analysis here and recompile the browser. -- add access to a new analysis here and recompile the browser.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module BrowserAnalysis(moduleAnalyses,allFunctionAnalyses,functionAnalyses module BrowserAnalysis( moduleAnalyses, allFunctionAnalyses, functionAnalyses)
, funcModule)
where where
import FileGoodies(stripSuffix) import FileGoodies(stripSuffix)
import List(intersperse) import List(intersperse)
import Pretty (pPrint)
import FlatCurry.Types import FlatCurry.Types
import FlatCurry.Goodies (funcName) import FlatCurry.Goodies (funcName)
import FlatCurry.Pretty (Options (..), defaultOptions, ppProg, ppFuncDecl)
import FlatCurry.Show (showFlatFunc, showFlatProg) import FlatCurry.Show (showFlatFunc, showFlatProg)
import AnalysisTypes import AnalysisTypes
...@@ -33,7 +30,7 @@ import Linearity ...@@ -33,7 +30,7 @@ import Linearity
import AddTypes import AddTypes
import Imports import Imports
import GenInt(showInterface, showCurryModule, showCurryFuncDecl) import ShowFlatCurry
import ShowGraph import ShowGraph
infix 1 `showWith`,`showWithMsg` infix 1 `showWith`,`showWithMsg`
...@@ -68,11 +65,7 @@ addTypes fname ...@@ -68,11 +65,7 @@ addTypes fname
= do prog <- addTypeSignatures (stripSuffix fname) = do prog <- addTypeSignatures (stripSuffix fname)
return (ContentsResult CurryProg prog) return (ContentsResult CurryProg prog)
--- Show FlatCurry module in pretty-printed form -----------------------------------------------------------------------------
showFlatCurry :: Prog -> String
showFlatCurry = pPrint . ppProg defaultOptions
-----------------------------------------------------------------------------------
-- The list of all available analyses for individual functions. -- The list of all available analyses for individual functions.
-- Each analysis must return a string or an IO action representation of its -- Each analysis must return a string or an IO action representation of its
-- analysis result. -- analysis result.
...@@ -112,20 +105,6 @@ functionAnalyses = ...@@ -112,20 +105,6 @@ functionAnalyses =
("Set-valued", GlobalAnalysis analyseSetValued `showWithMsg` showSetValued), ("Set-valued", GlobalAnalysis analyseSetValued `showWithMsg` showSetValued),
("Purity", GlobalAnalysis analyseIndeterminism `showWithMsg` showIndet)] ("Purity", GlobalAnalysis analyseIndeterminism `showWithMsg` showIndet)]
-- Show individual functions:
showFuncDeclAsCurry :: FuncDecl -> String
showFuncDeclAsCurry fd =
showCurryFuncDecl (showQNameInModule (funcModule fd))
(showQNameInModule (funcModule fd)) fd
showFuncDeclAsFlatCurry :: FuncDecl -> String
showFuncDeclAsFlatCurry fd = pPrint (ppFuncDecl opts fd)
where opts = defaultOptions { currentModule = funcModule fd }
funcModule :: FuncDecl -> String
funcModule fd = fst (funcName fd)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- The list of all available analyses for sets of functions. -- The list of all available analyses for sets of functions.
-- Each analysis must return a short(!) string representation (no more than a few chars) -- Each analysis must return a short(!) string representation (no more than a few chars)
......
...@@ -29,7 +29,7 @@ import AnalysisTypes ...@@ -29,7 +29,7 @@ import AnalysisTypes
import BrowserAnalysis import BrowserAnalysis
import Dependency (callsDirectly,indirectlyDependent) import Dependency (callsDirectly,indirectlyDependent)
import ImportCalls import ImportCalls
import GenInt (leqFunc) import ShowFlatCurry (funcModule, leqFunc)
import ShowGraph import ShowGraph
import Analysis (AOutFormat(..)) import Analysis (AOutFormat(..))
......
...@@ -13,24 +13,24 @@ TOOL = $(BINDIR)/currybrowse ...@@ -13,24 +13,24 @@ TOOL = $(BINDIR)/currybrowse
# source modules of the Curry Browser: # source modules of the Curry Browser:
DEPS = BrowserGUI.curry Imports.curry \ DEPS = BrowserGUI.curry Imports.curry \
AnalysisTypes.curry BrowserAnalysis.curry ShowGraph.curry \ AnalysisTypes.curry BrowserAnalysis.curry \
ShowFlatCurry.curry ShowGraph.curry \
$(CASS)/AnalysisServer.curry $(CASS)/AnalysisDoc.curry \ $(CASS)/AnalysisServer.curry $(CASS)/AnalysisDoc.curry \
$(CASS)/Registry.curry \ $(CASS)/Registry.curry \
$(CURRYTOOLS)/addtypes/AddTypes.curry \ $(CURRYTOOLS)/addtypes/AddTypes.curry \
$(CURRYTOOLS)/genint/GenInt.curry \
$(CURRYTOOLS)/importcalls/ImportCalls.curry \ $(CURRYTOOLS)/importcalls/ImportCalls.curry \
$(LIBDIR)/GUI.curry $(LIBDIR)/IOExts.curry $(LIBDIR)/System.curry \ $(LIBDIR)/GUI.curry $(LIBDIR)/IOExts.curry $(LIBDIR)/System.curry \
$(LIBDIR)/FlatCurry/Types.curry $(LIBDIR)/FlatCurry/Files.curry \ $(LIBDIR)/FlatCurry/Types.curry $(LIBDIR)/FlatCurry/Files.curry \
$(LIBDIR)/FlatCurry/Show.curry \ $(LIBDIR)/FlatCurry/Show.curry \
analysis/*.curry $(ANADIR)/*.curry analysis/*.curry $(ANADIR)/*.curry
LOADPATH = analysis:$(CASS):$(ANADIR):$(CURRYTOOLS)/genint:$(CURRYTOOLS)/importcalls:$(CURRYTOOLS)/addtypes LOADPATH = analysis:$(CASS):$(ANADIR):$(CURRYTOOLS)/importcalls:$(CURRYTOOLS)/addtypes
.PHONY: all compile install clean uninstall .PHONY: all compile install clean uninstall
all: install all: install
compile: BrowserGUI SourceProgGUI compile: GenInt BrowserGUI SourceProgGUI
install: compile install: compile
rm -f $(TOOL) rm -f $(TOOL)
...@@ -38,12 +38,16 @@ install: compile ...@@ -38,12 +38,16 @@ install: compile
clean: clean:
$(CLEANCURRY) -r $(CLEANCURRY) -r
rm -f BrowserGUI SourceProgGUI rm -f BrowserGUI SourceProgGUI GenInt
uninstall: clean uninstall: clean
rm -f $(TOOL) rm -f $(TOOL)
# generate executable for Curry Browser: # generate executables:
GenInt: ShowFlatCurry.curry $(LIBDIR)/FlatCurry/*.curry
$(REPL) $(REPL_OPTS) :load ShowFlatCurry :save :quit
rm -f GenInt && ln -s ShowFlatCurry GenInt
BrowserGUI: $(DEPS) BrowserGUI: $(DEPS)
$(REPL) $(REPL_OPTS) :set path $(LOADPATH) \ $(REPL) $(REPL_OPTS) :set path $(LOADPATH) \
:load BrowserGUI :eval "patchReadmeVersion" :save :quit :load BrowserGUI :eval "patchReadmeVersion" :save :quit
......
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
--- Generate an interface description or a human-readable --- This module contains various operations to show a FlatCurry program
--- presentation of a Curry module. --- in human-readable forms, e.g., only the interface or also the
--- complete program translated back into pattern-based rules.
--- These operations are used in the Curry Browser and they are
--- also the basis to implement the `:interface` command
--- of PAKCS or KiCS2.
--- ---
--- The interface description contains the type declarations --- The interface description contains the type declarations
--- for all entities defined and exported by this module. --- for all entities defined and exported by this module.
...@@ -12,18 +16,26 @@ ...@@ -12,18 +16,26 @@
--- @version August 2016 --- @version August 2016
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
module ShowFlatCurry
( main, showInterface, showCurryModule, showCurryFuncDecl
, showFlatCurry, showFuncDeclAsCurry, showFuncDeclAsFlatCurry
, funcModule, leqFunc
) where
import Char (isAlpha) import Char (isAlpha)
import Directory (doesFileExist, getModificationTime) import Directory (doesFileExist, getModificationTime)
import Distribution (stripCurrySuffix,modNameToPath import Distribution (stripCurrySuffix, modNameToPath
,lookupModuleSourceInLoadPath) ,lookupModuleSourceInLoadPath)
import FilePath (takeFileName, (</>)) import FilePath (takeFileName, (</>))
import List (intercalate) import List (intercalate)
import Sort (mergeSortBy,leqString) import Pretty (pPrint)
import System (getArgs,getEnviron,system) import Sort (sortBy, leqString)
import System (getArgs, getEnviron, system)
import FlatCurry.Types import FlatCurry.Types
import FlatCurry.Files import FlatCurry.Files
import FlatCurry.Goodies (funcName)
import FlatCurry.Pretty (Options (..), defaultOptions, ppProg, ppFuncDecl)
import FlatCurry.Show import FlatCurry.Show
main :: IO () main :: IO ()
...@@ -84,15 +96,15 @@ genInt genstub progname = getFlatInt progname >>= return . showInterface genstub ...@@ -84,15 +96,15 @@ genInt genstub progname = getFlatInt progname >>= return . showInterface genstub
-- If first argument is True, generate stubs (...external) for -- If first argument is True, generate stubs (...external) for
-- all functions so that the resulting interface is a valid Curry program. -- all functions so that the resulting interface is a valid Curry program.
showInterface :: Bool -> Prog -> String showInterface :: Bool -> Prog -> String
showInterface genstub (Prog mod imports types funcs ops) = showInterface genstub (Prog mod imports types funcs ops) = unlines $
"module " ++ mod ++ " where\n" ++ ["module " ++ mod ++ " where\n"] ++
concatMap showInterfaceImport imports ++ "\n" ++ concatMap showInterfaceImport imports ++ [""] ++
concatMap showInterfaceOpDecl (mergeSortBy leqOp ops) ++ map showInterfaceOpDecl (sortBy leqOp ops) ++
(if null ops then "" else "\n") ++ (if null ops then [] else [""]) ++
concatMap (showInterfaceType (showQNameInModule mod)) concatMap (showInterfaceType (showQNameInModule mod))
(mergeSortBy leqType types) ++ "\n" ++ (sortBy leqType types) ++ [""] ++
concatMap (showInterfaceFunc (showQNameInModule mod) genstub) map (showInterfaceFunc (showQNameInModule mod) genstub)
(mergeSortBy leqFunc funcs) ++ "\n" (sortBy leqFunc funcs)
-- Get a FlatCurry program (parse only if necessary): -- Get a FlatCurry program (parse only if necessary):
getFlatInt :: String -> IO Prog getFlatInt :: String -> IO Prog
...@@ -112,40 +124,40 @@ getFlatInt modname = do ...@@ -112,40 +124,40 @@ getFlatInt modname = do
else readFlatCurryFile fintprogname else readFlatCurryFile fintprogname
-- write import declaration -- write import declaration
showInterfaceImport :: String -> String showInterfaceImport :: String -> [String]
showInterfaceImport impmod = if impmod=="Prelude" showInterfaceImport impmod = if impmod=="Prelude"
then "" then []
else "import "++impmod++"\n" else ["import "++impmod]
-- show operator declaration -- show operator declaration
showInterfaceOpDecl :: OpDecl -> String showInterfaceOpDecl :: OpDecl -> String
showInterfaceOpDecl (Op op InfixOp prec) = "infix "++show prec++" "++showOp op++"\n" showInterfaceOpDecl (Op op InfixOp prec) = "infix "++show prec++" "++showOp op
showInterfaceOpDecl (Op op InfixlOp prec) = "infixl "++show prec++" "++showOp op++"\n" showInterfaceOpDecl (Op op InfixlOp prec) = "infixl "++show prec++" "++showOp op
showInterfaceOpDecl (Op op InfixrOp prec) = "infixr "++show prec++" "++showOp op++"\n" showInterfaceOpDecl (Op op InfixrOp prec) = "infixr "++show prec++" "++showOp op
showOp :: (_,String) -> String showOp :: (_,String) -> String
showOp (_,on) = if isAlpha (head on) then '`':on++"`" showOp (_,on) = if isAlpha (head on) then '`':on++"`"
else on else on
-- show type declaration if it is not a dictionary -- show type declaration if it is not a dictionary
showInterfaceType :: (QName -> String) -> TypeDecl -> String showInterfaceType :: (QName -> String) -> TypeDecl -> [String]
showInterfaceType tt (Type (_,tcons) vis tvars constrs) = showInterfaceType tt (Type (_,tcons) vis tvars constrs) =
if vis==Public && not (isDict tcons) if vis==Public && not (isDict tcons)
then "data " ++ tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++ then ["data " ++ tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++
(if null constxt then "" else " = " ++ constxt) (if null constxt then "" else " = " ++ constxt)]
++ "\n" else []
else ""
where where
isDict fn = take 6 fn == "_Dict#" isDict fn = take 6 fn == "_Dict#"
constxt = intercalate " | " constxt = intercalate " | "
(map (showExportConsDecl tt) (map (showExportConsDecl tt)
(filter (\ (Cons _ _ cvis _)->cvis==Public) constrs)) (filter (\ (Cons _ _ cvis _)->cvis==Public) constrs))
showInterfaceType tt (TypeSyn (_,tcons) vis tvars texp) = showInterfaceType tt (TypeSyn (_,tcons) vis tvars texp) =
if vis==Public if vis==Public
then "type " ++ tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++ then ["type " ++ tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++
" = " ++ showCurryType tt True texp ++ "\n" " = " ++ showCurryType tt True texp]
else "" else []
showExportConsDecl :: (QName -> String) -> ConsDecl -> String showExportConsDecl :: (QName -> String) -> ConsDecl -> String
showExportConsDecl tt (Cons (_,cname) _ _ argtypes) = showExportConsDecl tt (Cons (_,cname) _ _ argtypes) =
...@@ -157,8 +169,8 @@ showInterfaceFunc :: (QName -> String) -> Bool -> FuncDecl -> String ...@@ -157,8 +169,8 @@ showInterfaceFunc :: (QName -> String) -> Bool -> FuncDecl -> String
showInterfaceFunc ttrans genstub (Func (_,fname) _ vis ftype _) = showInterfaceFunc ttrans genstub (Func (_,fname) _ vis ftype _) =
if vis==Public && not (classOperations fname) if vis==Public && not (classOperations fname)
then showCurryId fname ++ " :: " ++ then showCurryId fname ++ " :: " ++
showCurryType ttrans False ftype ++ "\n" ++ showCurryType ttrans False ftype ++
(if genstub then showCurryId fname ++ " external\n\n" else "") (if genstub then "\n" ++ showCurryId fname ++ " external\n" else "")
else "" else ""
where where
classOperations fn = take 6 fn `elem` ["_impl#","_inst#"] classOperations fn = take 6 fn `elem` ["_impl#","_inst#"]
...@@ -190,17 +202,16 @@ genCurryMod progname = do ...@@ -190,17 +202,16 @@ genCurryMod progname = do
return $ showCurryModule prog return $ showCurryModule prog
showCurryModule :: Prog -> String showCurryModule :: Prog -> String
showCurryModule (Prog mod imports types funcs ops) = showCurryModule (Prog mod imports types funcs ops) = unlines $
"module "++mod++"("++showTypeExports types++ ["module "++mod++"("++showTypeExports types ++
showFuncExports funcs++") where\n\n"++ showFuncExports funcs++") where\n"] ++
concatMap showInterfaceImport imports ++ "\n" ++ concatMap showInterfaceImport imports ++ [""] ++
concatMap showInterfaceOpDecl ops ++ map showInterfaceOpDecl ops ++
(if null ops then "" else "\n") ++ (if null ops then [] else [""]) ++
concatMap (showCurryDataDecl (showQNameInModule mod)) types map (showCurryDataDecl (showQNameInModule mod)) types
++ "\n" ++ ++ [""] ++
concatMap (showCurryFuncDecl (showQNameInModule mod) map (showCurryFuncDecl (showQNameInModule mod)
(showQNameInModule mod)) funcs (showQNameInModule mod)) funcs
++ "\n-- end of module " ++ mod ++ "\n"
showTypeExports :: [TypeDecl] -> String showTypeExports :: [TypeDecl] -> String
showTypeExports types = concatMap (++",") (concatMap exptype types) showTypeExports types = concatMap (++",") (concatMap exptype types)
...@@ -223,11 +234,10 @@ showCurryDataDecl :: (QName -> String) -> TypeDecl -> String ...@@ -223,11 +234,10 @@ showCurryDataDecl :: (QName -> String) -> TypeDecl -> String
showCurryDataDecl tt (Type tcons _ tvars constrs) = showCurryDataDecl tt (Type tcons _ tvars constrs) =
"data " ++ snd tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++ "data " ++ snd tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++
(if null constxt then "" else " = " ++ constxt) (if null constxt then "" else " = " ++ constxt)
++ "\n"
where constxt = intercalate " | " (map (showCurryConsDecl tt) constrs) where constxt = intercalate " | " (map (showCurryConsDecl tt) constrs)
showCurryDataDecl tt (TypeSyn tcons _ tvars texp) = showCurryDataDecl tt (TypeSyn tcons _ tvars texp) =
"type " ++ snd tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++ "type " ++ snd tcons ++ concatMap (\i->[' ',chr (97+i)]) tvars ++
" = " ++ showCurryType tt True texp ++ "\n" " = " ++ showCurryType tt True texp
showCurryConsDecl :: (QName -> String) -> ConsDecl -> String showCurryConsDecl :: (QName -> String) -> ConsDecl -> String
showCurryConsDecl tt (Cons cname _ _ argtypes) = showCurryConsDecl tt (Cons cname _ _ argtypes) =
...@@ -242,11 +252,10 @@ showCurryFuncDecl tt tf (Func fname _ _ ftype frule) = ...@@ -242,11 +252,10 @@ showCurryFuncDecl tt tf (Func fname _ _ ftype frule) =
-- format rule as set of pattern matching rules: -- format rule as set of pattern matching rules:
showCurryRule :: (QName -> String) -> QName -> Rule -> String showCurryRule :: (QName -> String) -> QName -> Rule -> String
showCurryRule _ fname (External _) = showCurryId (snd fname) ++ " external\n\n" showCurryRule _ fname (External _) = showCurryId (snd fname) ++ " external\n"
showCurryRule tf fname (Rule lhs rhs) = showCurryRule tf fname (Rule lhs rhs) =
concatMap (\ (l,r) -> showCurryPatternRule tf l r) concatMap (\ (l,r) -> showCurryPatternRule tf l r)
(rule2equations (shallowPattern2Expr fname lhs) rhs) (rule2equations (shallowPattern2Expr fname lhs) rhs)
++ "\n"
splitFreeVars :: Expr -> ([Int],Expr) splitFreeVars :: Expr -> ([Int],Expr)
splitFreeVars exp = case exp of splitFreeVars exp = case exp of
...@@ -346,3 +355,21 @@ leqFunc :: FuncDecl -> FuncDecl -> Bool ...@@ -346,3 +355,21 @@ leqFunc :: FuncDecl -> FuncDecl -> Bool
leqFunc (Func (_,f1) _ _ _ _) (Func (_,f2) _ _ _ _) = f1 <= f2 leqFunc (Func (_,f1) _ _ _ _) (Func (_,f2) _ _ _ _) = f1 <= f2
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
--- Show FlatCurry module in pretty-printed form
showFlatCurry :: Prog -> String
showFlatCurry = pPrint . ppProg defaultOptions
-- Show individual functions:
showFuncDeclAsCurry :: FuncDecl -> String
showFuncDeclAsCurry fd =
showCurryFuncDecl (showQNameInModule (funcModule fd))
(showQNameInModule (funcModule fd)) fd
showFuncDeclAsFlatCurry :: FuncDecl -> String
showFuncDeclAsFlatCurry fd = pPrint (ppFuncDecl opts fd)
where opts = defaultOptions { currentModule = funcModule fd }
funcModule :: FuncDecl -> String
funcModule fd = fst (funcName fd)
-----------------------------------------------------------------------------
# Makefile for generating GenInt tool
TOOL = GenInt
.PHONY: all compile install clean uninstall
all: install
compile: GenInt
install: compile # no further installation required
clean:
$(CLEANCURRY)
rm -f GenInt
uninstall: clean
# generate executable for currydoc program:
GenInt: GenInt.curry $(LIBDIR)/FlatCurry/*.curry $(LIBDIR)/List.curry
$(REPL) $(REPL_OPTS) :load GenInt :save :quit
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment