Resolve #92: generic locations in icl

Resolve #92: generic locations in icl

module builddb

// Project libraries
import qualified TypeDB as DB
from TypeDB import ::TypeExtras{..}, ::Macro{..}, ::ModuleInfo{..},
	instance zero TypeExtras, instance zero ModuleInfo

// StdEnv
from StdFunc import const, flip, o
import StdFile, StdList, StdMisc, StdArray, StdBool, StdString, StdTuple

// CleanPlatform
import Data.Maybe, Data.Either, Data.Error, Data.Func, Data.Tuple, Data.Functor
import Control.Applicative, Control.Monad
from Text import class Text(concat,replaceSubString,indexOf,startsWith),
	instance Text String
import System.Directory, System.CommandLine

// CleanTypeUnifier
import qualified Type as T
from Type import class print(print), instance print [a], instance print String,
	instance print Type, instance print Priority
from Type import qualified ::TypeDef{..}, ::Constructor{..}
import CoclUtils

// CleanPrettyPrint
import CleanPrettyPrint

// frontend
import Heap
from hashtable import ::HashTable, ::QualifiedIdents(NoQualifiedIdents),
	::IdentClass(IC_Module), ::BoxedIdent{..}, putIdentInHashTable
from predef import init_identifiers
from compile import empty_cache, ::DclCache{hash_table}
from general import ::Optional(..)
from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr,
	::Position(..), ::LineNr, ::FileName, ::FunctName,
	::Module{mod_ident,mod_defs},
	::ParsedDefinition(PD_TypeSpec,PD_Instance,PD_Class,PD_Type,PD_Generic,PD_Derive,PD_Function),
	::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType,
	::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_pos,pi_types},
	::Type, ::ClassDef{class_ident,class_pos,class_args,class_context},
	::TypeVar, ::ParsedTypeDef, ::TypeDef{td_pos,td_ident},
	::GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
	::GenericCaseDef{gc_type,gc_pos,gc_gcf}, ::GenericCaseFunctions(GCF), ::GCF,
	::FunKind(FK_Macro),
	::Rhs, ::ParsedExpr
from scanner import ::Priority(..), ::Assoc(..)
from parse import wantModule

:: CLI = { help    :: Bool
         , version :: Bool
         , root    :: String
         , libs    :: [(String, String -> Bool)]
         , exclude :: [String]
         }

instance zero CLI where
	zero = { version = False
	       , help    = False
	       , root    = "/opt/clean/lib/"
	       , libs    = [ ("ArgEnv", const False)
	                   , ("CleanSerial", const False)
	                   , ("Directory", const False)
	                   , ("Dynamics", const False)
	                   , ("Gast", const False)
	                   , ("Generics", const False)
	                   , ("GraphCopy", const False)
	                   , ("MersenneTwister", const False)
	                   , ("ObjectIO", not o startsWith "Std")
	                   , ("Platform", const False)
	                   , ("Sapl", const False)
	                   , ("SoccerFun", const False)
	                   , ("StdEnv", const False)
	                   , ("StdLib", const False)
	                   , ("TCPIP", const False)
	                   , ("iTasks", const False)
	                   ]
	       , exclude = [ "StdEnv/_startup"
	                   , "StdEnv/_system"
	                   , "SoccerFun/RefereeCoach_"
	                   , "SoccerFun/Team_"
	                   ]
	       }

VERSION :== "Cloogle's builddb version 0.1\n"
USAGE :== concat [
	VERSION, "\n",
	"Usage: ./builddb [opts] > types.json\n\n",
	"\t-h, --help Show this help\n",
	"\t-r PATH    Change the library root to PATH\n",
	"\t-l PATH    Add PATH to the librarypaths relative to the root\n"]

Start w
# (args, w) = getCommandLine w
# (f, w) = stdio w
# (ok, w) = case parseCLI (tl args) of
	(Left e) = fclose (f <<< e) w
	(Right cli)
	| cli.help    = fclose (f <<< USAGE) w
	| cli.version = fclose (f <<< VERSION) w
	# (modss, w)  = mapSt (flip (uncurry $ findModules cli.exclude cli.root) "") cli.libs w
	# mods        = flatten modss
	# (st, w)     = init_identifiers newHeap w
	# cache       = empty_cache st
	# (db, w)     = loop cli.root mods 'DB'.newDb cache w
	# db          = 'DB'.putFunctions predefFunctions db
	# db          = 'DB'.putClasses predefClasses db
	# db          = 'DB'.putTypes predefTypes db
	# db          = 'DB'.putFunctions (flatten $ map constructor_functions predefTypes) db
	# db          = 'DB'.putFunctions (flatten $ map record_functions predefTypes) db
	# io          = stderr
	# io          = printStats db io
	# (ok1,w)     = fclose io w
	# f           = 'DB'.saveDb db f
	# (ok2,w)     = fclose f w
	= (ok1 && ok2,w)
| not ok = abort "Couldn't close stdio"
= w
where
	loop :: String [(String,String,Bool)] 'DB'.TypeDB
		*DclCache *World -> *('DB'.TypeDB, *World)
	loop _ [] db _ w = (db,w)
	loop root [(lib,mod,iscore):list] db cache w
	# (db, cache, w) = getModuleTypes root mod lib iscore cache db w
	# w = snd (fclose (stderr <<< lib <<< ": " <<< mod <<< "\n") w)
	= loop root list db cache w

	parseCLI :: [String] -> Either String CLI
	parseCLI [] = Right zero
	parseCLI [x:a] = case (x,a) of
		("--help", xs) = (\c->{c & help=True}) <$> parseCLI xs
		("--version", xs) = (\c->{c & version=True}) <$> parseCLI xs
		("-l", []) = Left "'-l' requires an argument"
		("-r", []) = Left "'-r' requires an argument"
		("-r", [x:xs]) = (\c->{c & root=x}) <$> parseCLI xs
		("-l", [x:xs]) = (\c->{c & libs=[(x,const False):c.libs]}) <$> parseCLI xs
		(x, _) = Left $ "Unknown option '" +++ x +++ "'"

	printStats :: !'DB'.TypeDB !*File -> *File
	printStats db f = f
		<<< "+-------------+------+\n"
		<<< "| Modules     | " <<< modules <<< " |\n"
		<<< "| Functions   | " <<< funs    <<< " |\n"
		<<< "| Types       | " <<< types   <<< " |\n"
		<<< "| Macros      | " <<< macros  <<< " |\n"
		<<< "| Classes     | " <<< classes <<< " |\n"
		<<< "| Instances   | " <<< insts   <<< " |\n"
		<<< "| Derivations | " <<< derives <<< " |\n"
		<<< "+-------------+------+\n"
	where
		[modules,funs,macros,types,classes,insts,derives:_]
			= map (pad 4)
				[ 'DB'.moduleCount db
				, 'DB'.functionCount db
				, 'DB'.macroCount db
				, 'DB'.typeCount db
				, 'DB'.classCount db
				, 'DB'.instanceCount db
				, 'DB'.deriveCount db
				]
		pad n i = {' ' \\ _ <- [0..n-size (toString i)-1]} +++ toString i

predefFunctions :: [('DB'.Location, 'DB'.ExtendedType)]
predefFunctions
	= [ ( 'DB'.Builtin "if"
	    , 'DB'.ET ('T'.Func ['T'.Type "Bool" [], 'T'.Var "a", 'T'.Var "a"] ('T'.Var "a") []) zero
	    )
	  , ( 'DB'.Builtin "dynamic"
	    , 'DB'.ET ('T'.Func ['T'.Var "a"] ('T'.Type "Dynamic" []) []) zero
	    )
	  ]

predefClasses :: [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext, [('DB'.Name, 'DB'.ExtendedType)])]
predefClasses
	= [ ( 'DB'.Builtin "TC", ["v"], [], [])
	  ]

predefTypes :: [('DB'.Location, 'T'.TypeDef)]
predefTypes
	= [ ( 'DB'.Builtin "Bool"
	    , { deft
	      & 'Type'.td_name = "Bool"
	      , 'Type'.td_rhs  = 'T'.TDRCons False
	        [ { defc & 'Type'.cons_name="False" }
	        , { defc & 'Type'.cons_name="True" }
	        ]
	      }
	    )
	  , ( 'DB'.Builtin "Int",     { deft & 'Type'.td_name = "Int"     } )
	  , ( 'DB'.Builtin "Real",    { deft & 'Type'.td_name = "Real"    } )
	  , ( 'DB'.Builtin "Char",    { deft & 'Type'.td_name = "Char"    } )
	  , ( 'DB'.Builtin "String",  { deft & 'Type'.td_name = "String",
	      'Type'.td_rhs = 'T'.TDRSynonym ('T'.Type "_#Array" ['T'.Type "Char" []]) } )
	  , ( 'DB'.Builtin "Dynamic", { deft & 'Type'.td_name = "Dynamic" } )
	  , ( 'DB'.Builtin "File",    { deft & 'Type'.td_name = "File"    } )
	  , ( 'DB'.Builtin "World",   { deft & 'Type'.td_name = "World",
	                                       'Type'.td_uniq = True      } )
	  ]
where
	deft = {'Type'.td_name="", 'Type'.td_uniq=False, 'Type'.td_args=[], 'Type'.td_rhs='T'.TDRAbstract}
	defc = {'Type'.cons_name="", 'Type'.cons_args=[], 'Type'.cons_exi_vars=[], 'Type'.cons_context=[], 'Type'.cons_priority=Nothing}

//             Exclude   Root    Library        Check for core       Base module
findModules :: ![String] !String !'DB'.Library ('DB'.Module -> Bool) !String !*World
	-> *(![('DB'.Library, 'DB'.Module, Bool)], !*World)
findModules ex root lib iscore base w
| any (\e -> indexOf e path <> -1) ex = ([], w)
#! (fps, w)   = readDirectory path w
| isError fps = ([], w)
#! fps        = fromOk fps
#! mods       = map (\s -> let mod = basedot +++ s % (0, size s - 5) in
	(lib, mod, iscore mod)) $ filter included $ filter isDclModule fps
#! (moremodss,w) = mapSt (\d -> findModules ex root lib iscore (basedot +++ d)) (filter isDirectory fps) w
= (removeDup (mods ++ flatten moremodss), w)
where
	path = root +++ "/" +++ lib +++ if (base == "") "" "/" +++ replaceSubString "." "/" base
	basedot = if (base == "") "" (base +++ ".")

	included :: String -> Bool
	included s = not (any (\e -> indexOf e (path +++ "/" +++ s) <> -1) ex)

	isDclModule :: String -> Bool
	isDclModule s = s % (size s - 4, size s - 1) == ".dcl"

	isDirectory :: String -> Bool
	isDirectory s = not $ isMember '.' $ fromString s

getModuleTypes :: String 'DB'.Module 'DB'.Library Bool
	*DclCache 'DB'.TypeDB *World -> *('DB'.TypeDB, *DclCache, *World)
getModuleTypes root mod lib iscore cache db w
# (Right dcl,cache,w) = readModule False cache w
# (icl,cache,w) = readModule True cache w
# icl = case icl of (Left _) = Nothing; (Right x) = Just x
# mod = dcl.mod_ident.id_name
# lib = cleanlib mod lib
# db  = 'DB'.putFunctions (pd_typespecs lib mod dcl.mod_defs icl) db
# db  = 'DB'.putInstances (pd_instances lib mod dcl.mod_defs icl) db
# db  = 'DB'.putClasses (pd_classes lib mod dcl.mod_defs icl) db
# typedefs = pd_types lib mod dcl.mod_defs icl
# db  = 'DB'.putTypes typedefs db
# db  = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
# db  = 'DB'.putFunctions (flatten $ map record_functions typedefs) db
# db  = 'DB'.putFunctions (pd_generics lib mod dcl.mod_defs icl) db
# db  = 'DB'.putDerivationss (pd_derivations lib mod dcl.mod_defs) db
# db  = 'DB'.putMacros (pd_macros lib mod dcl.mod_defs) db
# db  = 'DB'.putModule lib mod {zero & is_core=iscore} db
= (db,cache,w)
where
	mkdir :: String -> String
	mkdir s = { if (c == '.') '/' c \\ c <-: s }

	cleanlib :: !String !String -> String // Remove module dirs from lib
	cleanlib mod lib = toString $ cl` (fromString $ mkdir mod) (fromString lib)
	where
		cl` :: ![Char] ![Char] -> [Char]
		cl` mod lib
			| not (isMember '/' mod) = lib
			# mod = reverse $ tl $ dropWhile ((<>)'/') $ reverse mod
			| drop (length lib - length mod) lib == mod
				= take (length lib - length mod - 1) lib
			= lib

	pd_macros :: String String [ParsedDefinition] -> [('DB'.Location, 'DB'.Macro)]
	pd_macros lib mod dcl
		= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
		   , { macro_as_string = priostring id +++ cpp pd
		     , macro_extras = {zero & te_priority = findPrio id >>= 'T'.toMaybePriority}
		     }
		   ) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
	where
		priostring :: Ident -> String
		priostring id = case findTypeSpec id dcl of
			Nothing    = ""
			(Just pri) = cpp pri +++ "\n"

		findPrio :: Ident -> Maybe Priority
		findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id dcl

		findTypeSpec :: Ident [ParsedDefinition] -> Maybe ParsedDefinition
		findTypeSpec _  []          = Nothing
		findTypeSpec id [pd=:(PD_TypeSpec _ id` prio _ _):dcl]
		| id`.id_name == id.id_name = Just pd
		findTypeSpec id [_:dcl]     = findTypeSpec id dcl

	pd_derivations :: String String [ParsedDefinition]
		-> [('DB'.Name, [('DB'.Type, 'DB'.Location)])]
	pd_derivations lib mod dcl
		= [( id.id_name
		   , [('T'.toType gc_type, 'DB'.Location lib mod (toLine gc_pos) Nothing "")]
		   ) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]

	pd_generics :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, 'DB'.ExtendedType)]
	pd_generics lib mod dcl icl
		= [( 'DB'.Location lib mod (toLine gen_pos) (findIclLine id_name =<< icl) id_name
		   , 'DB'.ET ('T'.toType gen_type)
		       {zero & te_generic_vars=Just $ map 'T'.toTypeVar gen_vars
		             , te_representation=Just $ cpp gen}
		   ) \\ gen=:(PD_Generic {gen_ident={id_name},gen_pos,gen_type,gen_vars}) <- dcl]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [g.gen_pos \\ PD_Generic g <- pms | g.gen_ident.id_name == name] of
				[FunPos _ l _:_] = Just l
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_typespecs :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, 'DB'.ExtendedType)]
	pd_typespecs lib mod dcl icl
		= [( 'DB'.Location lib mod (toLine pos) (findIclLine id_name =<< icl) id_name
		   , 'DB'.ET ('T'.toType t)
		       { zero & te_priority = 'T'.toMaybePriority p
		              , te_representation = Just $ cpp ts}
		   ) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- dcl]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [pos \\ PD_TypeSpec pos id _ _ _ <- pms | id.id_name == name] of
				[FunPos _ l _:_] = Just l
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_instances :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Class, ['DB'.Type], 'DB'.Location)]
	pd_instances lib mod dcl icl
		= [( id_name
		   , map 'T'.toType pi_types
		   , 'DB'.Location lib mod (toLine pi_pos) (findIclLine id_name =<< icl) ""
		   ) \\ PD_Instance {pim_pi={pi_ident={id_name},pi_types,pi_pos}} <- dcl]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [pi_pos \\ PD_Instance {pim_pi={pi_pos,pi_ident}} <- pms | pi_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_classes :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext,
			[('DB'.Name, 'DB'.ExtendedType)])]
	pd_classes lib mod dcl icl
	# dcl = filter (\pd->case pd of (PD_Class _ _)=True; _=False) dcl
	= map (\(PD_Class {class_ident={id_name},class_pos,class_args,class_context} dcl)
		-> let
			typespecs = pd_typespecs lib mod dcl icl
			macros = pd_macros lib mod dcl
			getMacro n = case filter ((==) n o 'DB'.getName o fst) macros of
				[]        = Nothing
				[(_,m):_] = Just m.macro_as_string
			updateRepresentation n ('DB'.ET t te)
				= 'DB'.ET t {te & te_representation = getMacro n <|> te.te_representation}
		in ('DB'.Location lib mod (toLine class_pos) (findIclLine id_name =<< icl) id_name
		   , map 'T'.toTypeVar class_args
		   , flatten $ map 'T'.toClassContext class_context
		   , [(f,updateRepresentation f et) \\ ('DB'.Location _ _ _ _ f, et) <- typespecs])) dcl
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [class_pos \\ PD_Class {class_ident,class_pos} _ <- pms | class_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_types :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, 'DB'.TypeDef)]
	pd_types lib mod dcl icl
		= [let name = 'T'.td_name td in
			('DB'.Location lib mod (toLine ptd.td_pos) (findIclLine name =<< icl) name, td)
		   \\ PD_Type ptd <- dcl, td <- ['T'.toTypeDef ptd]]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [td_pos \\ PD_Type {td_ident,td_pos} <- pms | td_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	toLine :: Position -> 'DB'.LineNr
	toLine (FunPos _ l _) = Just l
	toLine (LinePos _ l)  = Just l
	toLine _              = Nothing

	readModule :: Bool *DclCache *World -> *(Either String ParsedModule, *DclCache, *World)
	readModule icl cache w
	# filename = root +++ "/" +++ lib +++ "/" +++ mkdir mod +++ if icl ".icl" ".dcl"
	# (ok,f,w) = fopen filename FReadText w
	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
	# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) cache.hash_table
	  cache = {cache & hash_table=ht}
	# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True cache.hash_table stderr) w
	  cache = {cache & hash_table=ht}
	# (ok,w) = fclose f w
	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
	= (Right pm, cache, w)

constructor_functions :: ('DB'.Location, 'DB'.TypeDef)
	-> [('DB'.Location, 'DB'.ExtendedType)]
constructor_functions ('DB'.Builtin _, td)
	= [('DB'.Builtin c, 'DB'.ET f
		{zero & te_isconstructor=True
		      , te_representation=Just $ concat $
		          [c] ++ print_prio p ++ [" :: "] ++ print False f
		      , te_priority=p})
	   \\ (c,f,p) <- 'T'.constructorsToFunctions td]
constructor_functions ('DB'.Location lib mod line iclline _, td)
	= [('DB'.Location lib mod line iclline c, 'DB'.ET f
		{zero & te_isconstructor=True
		      , te_representation=Just $ concat $
		          [c] ++ print_prio p ++ [" :: "] ++ print False f
		      , te_priority=p})
	   \\ (c,f,p) <- 'T'.constructorsToFunctions td]

print_prio :: (Maybe 'T'.Priority) -> [String]
print_prio Nothing  = []
print_prio (Just p) = [" "] ++ print False p

record_functions :: ('DB'.Location, 'DB'.TypeDef)
	-> [('DB'.Location, 'DB'.ExtendedType)]
record_functions ('DB'.Builtin _, td)
	= [('DB'.Builtin f, 'DB'.ET t
		{zero & te_isrecordfield=True
		      , te_representation=Just $ concat $ [".", f, " :: " : print False t]})
		\\ (f,t) <- 'T'.recordsToFunctions td]
record_functions ('DB'.Location lib mod line iclline _, td)
	= [('DB'.Location lib mod line iclline f, 'DB'.ET t
		{zero & te_isrecordfield=True
		      , te_representation=Just $ concat $ [".", f, " :: " : print False t]})
		\\ (f,t) <- 'T'.recordsToFunctions td]

wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
	-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)
wantModule` f s b1 i p b2 ht io fs
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)

module builddb

// Project libraries
import qualified TypeDB as DB
from TypeDB import ::TypeExtras{..}, ::Macro{..}, ::ModuleInfo{..},
	instance zero TypeExtras, instance zero ModuleInfo

// StdEnv
from StdFunc import const, flip, o
import StdFile, StdList, StdMisc, StdArray, StdBool, StdString, StdTuple

// CleanPlatform
import Data.Maybe, Data.Either, Data.Error, Data.Func, Data.Tuple, Data.Functor
import Control.Applicative, Control.Monad
from Text import class Text(concat,replaceSubString,indexOf,startsWith),
	instance Text String
import System.Directory, System.CommandLine

// CleanTypeUnifier
import qualified Type as T
from Type import class print(print), instance print [a], instance print String,
	instance print Type, instance print Priority
from Type import qualified ::TypeDef{..}, ::Constructor{..}
import CoclUtils

// CleanPrettyPrint
import CleanPrettyPrint

// frontend
import Heap
from hashtable import ::HashTable, ::QualifiedIdents(NoQualifiedIdents),
	::IdentClass(IC_Module), ::BoxedIdent{..}, putIdentInHashTable
from predef import init_identifiers
from compile import empty_cache, ::DclCache{hash_table}
from general import ::Optional(..)
from syntax import ::SymbolTable, ::SymbolTableEntry, ::Ident{..}, ::SymbolPtr,
	::Position(..), ::LineNr, ::FileName, ::FunctName,
	::Module{mod_ident,mod_defs},
	::ParsedDefinition(PD_TypeSpec,PD_Instance,PD_Class,PD_Type,PD_Generic,PD_Derive,PD_Function),
	::FunSpecials, ::Priority, ::ParsedModule, ::SymbolType,
	::ParsedInstanceAndMembers{..}, ::ParsedInstance{pi_ident,pi_pos,pi_types},
	::Type, ::ClassDef{class_ident,class_pos,class_args,class_context},
	::TypeVar, ::ParsedTypeDef, ::TypeDef{td_pos,td_ident},
	::GenericDef{gen_ident,gen_pos,gen_type,gen_vars},
	::GenericCaseDef{gc_type,gc_pos,gc_gcf}, ::GenericCaseFunctions(GCF), ::GCF,
	::FunKind(FK_Macro),
	::Rhs, ::ParsedExpr
from scanner import ::Priority(..), ::Assoc(..)
from parse import wantModule

:: CLI = { help    :: Bool
         , version :: Bool
         , root    :: String
         , libs    :: [(String, String -> Bool)]
         , exclude :: [String]
         }

instance zero CLI where
	zero = { version = False
	       , help    = False
	       , root    = "/opt/clean/lib/"
	       , libs    = [ ("ArgEnv", const False)
	                   , ("CleanSerial", const False)
	                   , ("Directory", const False)
	                   , ("Dynamics", const False)
	                   , ("Gast", const False)
	                   , ("Generics", const False)
	                   , ("GraphCopy", const False)
	                   , ("MersenneTwister", const False)
	                   , ("ObjectIO", not o startsWith "Std")
	                   , ("Platform", const False)
	                   , ("Sapl", const False)
	                   , ("SoccerFun", const False)
	                   , ("StdEnv", const False)
	                   , ("StdLib", const False)
	                   , ("TCPIP", const False)
	                   , ("iTasks", const False)
	                   ]
	       , exclude = [ "StdEnv/_startup"
	                   , "StdEnv/_system"
	                   , "SoccerFun/RefereeCoach_"
	                   , "SoccerFun/Team_"
	                   ]
	       }

VERSION :== "Cloogle's builddb version 0.1\n"
USAGE :== concat [
	VERSION, "\n",
	"Usage: ./builddb [opts] > types.json\n\n",
	"\t-h, --help Show this help\n",
	"\t-r PATH    Change the library root to PATH\n",
	"\t-l PATH    Add PATH to the librarypaths relative to the root\n"]

Start w
# (args, w) = getCommandLine w
# (f, w) = stdio w
# (ok, w) = case parseCLI (tl args) of
	(Left e) = fclose (f <<< e) w
	(Right cli)
	| cli.help    = fclose (f <<< USAGE) w
	| cli.version = fclose (f <<< VERSION) w
	# (modss, w)  = mapSt (flip (uncurry $ findModules cli.exclude cli.root) "") cli.libs w
	# mods        = flatten modss
	# (st, w)     = init_identifiers newHeap w
	# cache       = empty_cache st
	# (db, w)     = loop cli.root mods 'DB'.newDb cache w
	# db          = 'DB'.putFunctions predefFunctions db
	# db          = 'DB'.putClasses predefClasses db
	# db          = 'DB'.putTypes predefTypes db
	# db          = 'DB'.putFunctions (flatten $ map constructor_functions predefTypes) db
	# db          = 'DB'.putFunctions (flatten $ map record_functions predefTypes) db
	# io          = stderr
	# io          = printStats db io
	# (ok1,w)     = fclose io w
	# f           = 'DB'.saveDb db f
	# (ok2,w)     = fclose f w
	= (ok1 && ok2,w)
| not ok = abort "Couldn't close stdio"
= w
where
	loop :: String [(String,String,Bool)] 'DB'.TypeDB
		*DclCache *World -> *('DB'.TypeDB, *World)
	loop _ [] db _ w = (db,w)
	loop root [(lib,mod,iscore):list] db cache w
	# (db, cache, w) = getModuleTypes root mod lib iscore cache db w
	# w = snd (fclose (stderr <<< lib <<< ": " <<< mod <<< "\n") w)
	= loop root list db cache w

	parseCLI :: [String] -> Either String CLI
	parseCLI [] = Right zero
	parseCLI [x:a] = case (x,a) of
		("--help", xs) = (\c->{c & help=True}) <$> parseCLI xs
		("--version", xs) = (\c->{c & version=True}) <$> parseCLI xs
		("-l", []) = Left "'-l' requires an argument"
		("-r", []) = Left "'-r' requires an argument"
		("-r", [x:xs]) = (\c->{c & root=x}) <$> parseCLI xs
		("-l", [x:xs]) = (\c->{c & libs=[(x,const False):c.libs]}) <$> parseCLI xs
		(x, _) = Left $ "Unknown option '" +++ x +++ "'"

	printStats :: !'DB'.TypeDB !*File -> *File
	printStats db f = f
		<<< "+-------------+------+\n"
		<<< "| Modules     | " <<< modules <<< " |\n"
		<<< "| Functions   | " <<< funs    <<< " |\n"
		<<< "| Types       | " <<< types   <<< " |\n"
		<<< "| Macros      | " <<< macros  <<< " |\n"
		<<< "| Classes     | " <<< classes <<< " |\n"
		<<< "| Instances   | " <<< insts   <<< " |\n"
		<<< "| Derivations | " <<< derives <<< " |\n"
		<<< "+-------------+------+\n"
	where
		[modules,funs,macros,types,classes,insts,derives:_]
			= map (pad 4)
				[ 'DB'.moduleCount db
				, 'DB'.functionCount db
				, 'DB'.macroCount db
				, 'DB'.typeCount db
				, 'DB'.classCount db
				, 'DB'.instanceCount db
				, 'DB'.deriveCount db
				]
		pad n i = {' ' \\ _ <- [0..n-size (toString i)-1]} +++ toString i

predefFunctions :: [('DB'.Location, 'DB'.ExtendedType)]
predefFunctions
	= [ ( 'DB'.Builtin "if"
	    , 'DB'.ET ('T'.Func ['T'.Type "Bool" [], 'T'.Var "a", 'T'.Var "a"] ('T'.Var "a") []) zero
	    )
	  , ( 'DB'.Builtin "dynamic"
	    , 'DB'.ET ('T'.Func ['T'.Var "a"] ('T'.Type "Dynamic" []) []) zero
	    )
	  ]

predefClasses :: [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext, [('DB'.Name, 'DB'.ExtendedType)])]
predefClasses
	= [ ( 'DB'.Builtin "TC", ["v"], [], [])
	  ]

predefTypes :: [('DB'.Location, 'T'.TypeDef)]
predefTypes
	= [ ( 'DB'.Builtin "Bool"
	    , { deft
	      & 'Type'.td_name = "Bool"
	      , 'Type'.td_rhs  = 'T'.TDRCons False
	        [ { defc & 'Type'.cons_name="False" }
	        , { defc & 'Type'.cons_name="True" }
	        ]
	      }
	    )
	  , ( 'DB'.Builtin "Int",     { deft & 'Type'.td_name = "Int"     } )
	  , ( 'DB'.Builtin "Real",    { deft & 'Type'.td_name = "Real"    } )
	  , ( 'DB'.Builtin "Char",    { deft & 'Type'.td_name = "Char"    } )
	  , ( 'DB'.Builtin "String",  { deft & 'Type'.td_name = "String",
	      'Type'.td_rhs = 'T'.TDRSynonym ('T'.Type "_#Array" ['T'.Type "Char" []]) } )
	  , ( 'DB'.Builtin "Dynamic", { deft & 'Type'.td_name = "Dynamic" } )
	  , ( 'DB'.Builtin "File",    { deft & 'Type'.td_name = "File"    } )
	  , ( 'DB'.Builtin "World",   { deft & 'Type'.td_name = "World",
	                                       'Type'.td_uniq = True      } )
	  ]
where
	deft = {'Type'.td_name="", 'Type'.td_uniq=False, 'Type'.td_args=[], 'Type'.td_rhs='T'.TDRAbstract}
	defc = {'Type'.cons_name="", 'Type'.cons_args=[], 'Type'.cons_exi_vars=[], 'Type'.cons_context=[], 'Type'.cons_priority=Nothing}

//             Exclude   Root    Library        Check for core       Base module
findModules :: ![String] !String !'DB'.Library ('DB'.Module -> Bool) !String !*World
	-> *(![('DB'.Library, 'DB'.Module, Bool)], !*World)
findModules ex root lib iscore base w
| any (\e -> indexOf e path <> -1) ex = ([], w)
#! (fps, w)   = readDirectory path w
| isError fps = ([], w)
#! fps        = fromOk fps
#! mods       = map (\s -> let mod = basedot +++ s % (0, size s - 5) in
	(lib, mod, iscore mod)) $ filter included $ filter isDclModule fps
#! (moremodss,w) = mapSt (\d -> findModules ex root lib iscore (basedot +++ d)) (filter isDirectory fps) w
= (removeDup (mods ++ flatten moremodss), w)
where
	path = root +++ "/" +++ lib +++ if (base == "") "" "/" +++ replaceSubString "." "/" base
	basedot = if (base == "") "" (base +++ ".")

	included :: String -> Bool
	included s = not (any (\e -> indexOf e (path +++ "/" +++ s) <> -1) ex)

	isDclModule :: String -> Bool
	isDclModule s = s % (size s - 4, size s - 1) == ".dcl"

	isDirectory :: String -> Bool
	isDirectory s = not $ isMember '.' $ fromString s

getModuleTypes :: String 'DB'.Module 'DB'.Library Bool
	*DclCache 'DB'.TypeDB *World -> *('DB'.TypeDB, *DclCache, *World)
getModuleTypes root mod lib iscore cache db w
# (Right dcl,cache,w) = readModule False cache w
# (icl,cache,w) = readModule True cache w
# icl = case icl of (Left _) = Nothing; (Right x) = Just x
# mod = dcl.mod_ident.id_name
# lib = cleanlib mod lib
# db  = 'DB'.putFunctions (pd_typespecs lib mod dcl.mod_defs icl) db
# db  = 'DB'.putInstances (pd_instances lib mod dcl.mod_defs icl) db
# db  = 'DB'.putClasses (pd_classes lib mod dcl.mod_defs icl) db
# typedefs = pd_types lib mod dcl.mod_defs icl
# db  = 'DB'.putTypes typedefs db
# db  = 'DB'.putFunctions (flatten $ map constructor_functions typedefs) db
# db  = 'DB'.putFunctions (flatten $ map record_functions typedefs) db
# db  = 'DB'.putFunctions (pd_generics lib mod dcl.mod_defs) db
# db  = 'DB'.putDerivationss (pd_derivations lib mod dcl.mod_defs) db
# db  = 'DB'.putMacros (pd_macros lib mod dcl.mod_defs) db
# db  = 'DB'.putModule lib mod {zero & is_core=iscore} db
= (db,cache,w)
where
	mkdir :: String -> String
	mkdir s = { if (c == '.') '/' c \\ c <-: s }

	cleanlib :: !String !String -> String // Remove module dirs from lib
	cleanlib mod lib = toString $ cl` (fromString $ mkdir mod) (fromString lib)
	where
		cl` :: ![Char] ![Char] -> [Char]
		cl` mod lib
			| not (isMember '/' mod) = lib
			# mod = reverse $ tl $ dropWhile ((<>)'/') $ reverse mod
			| drop (length lib - length mod) lib == mod
				= take (length lib - length mod - 1) lib
			= lib

	pd_macros :: String String [ParsedDefinition] -> [('DB'.Location, 'DB'.Macro)]
	pd_macros lib mod dcl
		= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
		   , { macro_as_string = priostring id +++ cpp pd
		     , macro_extras = {zero & te_priority = findPrio id >>= 'T'.toMaybePriority}
		     }
		   ) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
	where
		priostring :: Ident -> String
		priostring id = case findTypeSpec id dcl of
			Nothing    = ""
			(Just pri) = cpp pri +++ "\n"

		findPrio :: Ident -> Maybe Priority
		findPrio id = (\(PD_TypeSpec _ _ p _ _) -> p) <$> findTypeSpec id dcl

		findTypeSpec :: Ident [ParsedDefinition] -> Maybe ParsedDefinition
		findTypeSpec _  []          = Nothing
		findTypeSpec id [pd=:(PD_TypeSpec _ id` prio _ _):dcl]
		| id`.id_name == id.id_name = Just pd
		findTypeSpec id [_:dcl]     = findTypeSpec id dcl

	pd_derivations :: String String [ParsedDefinition]
		-> [('DB'.Name, [('DB'.Type, 'DB'.Location)])]
	pd_derivations lib mod dcl
		= [( id.id_name
		   , [('T'.toType gc_type, 'DB'.Location lib mod (toLine gc_pos) Nothing "")]
		   ) \\ PD_Derive gcdefs <- dcl, {gc_type,gc_pos,gc_gcf=GCF id _} <- gcdefs]

	pd_generics :: String String [ParsedDefinition]
		-> [('DB'.Location, 'DB'.ExtendedType)]
	pd_generics lib mod dcl
		= [( 'DB'.Location lib mod (toLine gen_pos) Nothing id_name
		   , 'DB'.ET ('T'.toType gen_type)
		       {zero & te_generic_vars=Just $ map 'T'.toTypeVar gen_vars
		             , te_representation=Just $ cpp gen}
		   ) \\ gen=:(PD_Generic {gen_ident={id_name},gen_pos,gen_type,gen_vars}) <- dcl]

	pd_typespecs :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, 'DB'.ExtendedType)]
	pd_typespecs lib mod dcl icl
		= [( 'DB'.Location lib mod (toLine pos) (findIclLine id_name =<< icl) id_name
		   , 'DB'.ET ('T'.toType t)
		       { zero & te_priority = 'T'.toMaybePriority p
		              , te_representation = Just $ cpp ts}
		   ) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- dcl]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [pos \\ PD_TypeSpec pos id _ _ _ <- pms | id.id_name == name] of
				[FunPos _ l _:_] = Just l
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_instances :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Class, ['DB'.Type], 'DB'.Location)]
	pd_instances lib mod dcl icl
		= [( id_name
		   , map 'T'.toType pi_types
		   , 'DB'.Location lib mod (toLine pi_pos) (findIclLine id_name =<< icl) ""
		   ) \\ PD_Instance {pim_pi={pi_ident={id_name},pi_types,pi_pos}} <- dcl]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [pi_pos \\ PD_Instance {pim_pi={pi_pos,pi_ident}} <- pms | pi_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_classes :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, ['T'.TypeVar], 'T'.ClassContext,
			[('DB'.Name, 'DB'.ExtendedType)])]
	pd_classes lib mod dcl icl
	# dcl = filter (\pd->case pd of (PD_Class _ _)=True; _=False) dcl
	= map (\(PD_Class {class_ident={id_name},class_pos,class_args,class_context} dcl)
		-> let
			typespecs = pd_typespecs lib mod dcl icl
			macros = pd_macros lib mod dcl
			getMacro n = case filter ((==) n o 'DB'.getName o fst) macros of
				[]        = Nothing
				[(_,m):_] = Just m.macro_as_string
			updateRepresentation n ('DB'.ET t te)
				= 'DB'.ET t {te & te_representation = getMacro n <|> te.te_representation}
		in ('DB'.Location lib mod (toLine class_pos) (findIclLine id_name =<< icl) id_name
		   , map 'T'.toTypeVar class_args
		   , flatten $ map 'T'.toClassContext class_context
		   , [(f,updateRepresentation f et) \\ ('DB'.Location _ _ _ _ f, et) <- typespecs])) dcl
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [class_pos \\ PD_Class {class_ident,class_pos} _ <- pms | class_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	pd_types :: String String [ParsedDefinition] (Maybe ParsedModule)
		-> [('DB'.Location, 'DB'.TypeDef)]
	pd_types lib mod dcl icl
		= [let name = 'T'.td_name td in
			('DB'.Location lib mod (toLine ptd.td_pos) (findIclLine name =<< icl) name, td)
		   \\ PD_Type ptd <- dcl, td <- ['T'.toTypeDef ptd]]
	where
		findIclLine :: String ParsedModule -> Maybe Int
		findIclLine name {mod_defs=pms}
			= case [td_pos \\ PD_Type {td_ident,td_pos} <- pms | td_ident.id_name == name] of
				[LinePos _ l:_] = Just l
				_ = Nothing

	toLine :: Position -> 'DB'.LineNr
	toLine (FunPos _ l _) = Just l
	toLine (LinePos _ l)  = Just l
	toLine _              = Nothing

	readModule :: Bool *DclCache *World -> *(Either String ParsedModule, *DclCache, *World)
	readModule icl cache w
	# filename = root +++ "/" +++ lib +++ "/" +++ mkdir mod +++ if icl ".icl" ".dcl"
	# (ok,f,w) = fopen filename FReadText w
	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
	# (mod_id, ht) = putIdentInHashTable mod (IC_Module NoQualifiedIdents) cache.hash_table
	  cache = {cache & hash_table=ht}
	# ((b1,b2,pm,ht,f),w) = accFiles (wantModule` f "" icl mod_id.boxed_ident NoPos True cache.hash_table stderr) w
	  cache = {cache & hash_table=ht}
	# (ok,w) = fclose f w
	| not ok = (Left $ "Couldn't open " +++ filename, cache, w)
	= (Right pm, cache, w)

constructor_functions :: ('DB'.Location, 'DB'.TypeDef)
	-> [('DB'.Location, 'DB'.ExtendedType)]
constructor_functions ('DB'.Builtin _, td)
	= [('DB'.Builtin c, 'DB'.ET f
		{zero & te_isconstructor=True
		      , te_representation=Just $ concat $
		          [c] ++ print_prio p ++ [" :: "] ++ print False f
		      , te_priority=p})
	   \\ (c,f,p) <- 'T'.constructorsToFunctions td]
constructor_functions ('DB'.Location lib mod line iclline _, td)
	= [('DB'.Location lib mod line iclline c, 'DB'.ET f
		{zero & te_isconstructor=True
		      , te_representation=Just $ concat $
		          [c] ++ print_prio p ++ [" :: "] ++ print False f
		      , te_priority=p})
	   \\ (c,f,p) <- 'T'.constructorsToFunctions td]

print_prio :: (Maybe 'T'.Priority) -> [String]
print_prio Nothing  = []
print_prio (Just p) = [" "] ++ print False p

record_functions :: ('DB'.Location, 'DB'.TypeDef)
	-> [('DB'.Location, 'DB'.ExtendedType)]
record_functions ('DB'.Builtin _, td)
	= [('DB'.Builtin f, 'DB'.ET t
		{zero & te_isrecordfield=True
		      , te_representation=Just $ concat $ [".", f, " :: " : print False t]})
		\\ (f,t) <- 'T'.recordsToFunctions td]
record_functions ('DB'.Location lib mod line iclline _, td)
	= [('DB'.Location lib mod line iclline f, 'DB'.ET t
		{zero & te_isrecordfield=True
		      , te_representation=Just $ concat $ [".", f, " :: " : print False t]})
		\\ (f,t) <- 'T'.recordsToFunctions td]

wantModule` :: !*File !{#Char} !Bool !Ident !Position !Bool !*HashTable !*File !*Files
	-> ((!Bool,!Bool,!ParsedModule, !*HashTable, !*File), !*Files)
wantModule` f s b1 i p b2 ht io fs
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)


Use fromMaybe instead of an if in SimpleTCPServer.icl

implementation module SimpleTCPServer

import StdEnv
import Data.Maybe
import System._Posix
import TCPIP

instance zero (Logger a b s t) where zero = \_ _ w -> (undef, w)

serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
serve server w
# (ok, mbListener, w) = openTCP_Listener server.port w
| not ok = abort ("Couldn't open port " +++ toString server.port +++ "\n")
# listener = fromJust mbListener
# (_,w) = signal 17 1 w // SIGCHLD, SIG_IGN: no notification if child ps dies
# (listener, w) = loop listener w
= closeRChannel listener w
where
	logger = fromMaybe zero server.logger

	loop :: TCP_Listener *World -> (TCP_Listener, *World)
	loop li w
	#! (tRep,conn,li,w) = receive_MT server.connect_timeout li w
	| tRep <> TR_Success
		= (li,w)
	#! (ip,dupChan)     = fromJust conn
	#! (pid,w)          = fork w
	| pid < 0
		= abort "fork failed\n"
	| pid > 0 // Parent: handle new requests
		= loop li w
	| pid == 0 // Child: handle current request
		#! (st,w)       = logger (Connected ip) Nothing w
		= handle st dupChan w

	//handle :: !(Maybe s) !TCP_DuplexChannel !*World -> *(!TCP_Listener, !*World)
	handle st dupChannel=:{rChannel,sChannel} w
	#! (tRep,msg,rChannel,w) = receive_MT server.keepalive_timeout rChannel w
	| tRep <> TR_Success
		#! (st,w)            = logger Disconnected st w
		#! w                 = closeChannel sChannel (closeRChannel rChannel w)
		= exit 0 w
	#! msg                   = fromString (toString (fromJust msg))
	#! (st, w)               = logger (Received msg) st w
	#! (resp, hidden, w)     = server.handler msg w
	#! (sChannel, w)         = send (toByteSeq (toString resp)) sChannel w
	#! (st, w)               = logger (Sent resp hidden) st w
	= handle st {dupChannel & rChannel=rChannel, sChannel=sChannel} w

signal :: !Int !Int !*World -> *(!Int, !*World)
signal signum handler w = code {
	ccall signal "II:I:A"
}

implementation module SimpleTCPServer

import StdEnv
import StdMaybe
import System._Posix
import TCPIP

instance zero (Logger a b s t) where zero = \_ _ w -> (undef, w)

serve :: !(Server a b s t) !*World -> *World | fromString a & toString b
serve server w
# (ok, mbListener, w) = openTCP_Listener server.port w
| not ok = abort ("Couldn't open port " +++ toString server.port +++ "\n")
# listener = fromJust mbListener
# (_,w) = signal 17 1 w // SIGCHLD, SIG_IGN: no notification if child ps dies
# (listener, w) = loop listener w
= closeRChannel listener w
where
	logger = if (isNothing server.logger) zero (fromJust server.logger)

	loop :: TCP_Listener *World -> (TCP_Listener, *World)
	loop li w
	#! (tRep,conn,li,w) = receive_MT server.connect_timeout li w
	| tRep <> TR_Success
		= (li,w)
	#! (ip,dupChan)     = fromJust conn
	#! (pid,w)          = fork w
	| pid < 0
		= abort "fork failed\n"
	| pid > 0 // Parent: handle new requests
		= loop li w
	| pid == 0 // Child: handle current request
		#! (st,w)       = logger (Connected ip) Nothing w
		= handle st dupChan w

	//handle :: !(Maybe s) !TCP_DuplexChannel !*World -> *(!TCP_Listener, !*World)
	handle st dupChannel=:{rChannel,sChannel} w
	#! (tRep,msg,rChannel,w) = receive_MT server.keepalive_timeout rChannel w
	| tRep <> TR_Success
		#! (st,w)            = logger Disconnected st w
		#! w                 = closeChannel sChannel (closeRChannel rChannel w)
		= exit 0 w
	#! msg                   = fromString (toString (fromJust msg))
	#! (st, w)               = logger (Received msg) st w
	#! (resp, hidden, w)     = server.handler msg w
	#! (sChannel, w)         = send (toByteSeq (toString resp)) sChannel w
	#! (st, w)               = logger (Sent resp hidden) st w
	= handle st {dupChannel & rChannel=rChannel, sChannel=sChannel} w

signal :: !Int !Int !*World -> *(!Int, !*World)
signal signum handler w = code {
	ccall signal "II:I:A"
}


Close stdOut upon termination of Bot, resolves #5


don't really need chars above 64k

don't really need chars above 64k

<!SGML "ISO 8879:1986 (WWW)"

     -- SGML Declaration for XML 1.0 --

     -- from:
        Final text of revised Web SGML Adaptations Annex (TC2) to ISO 8879:1986
        ISO/IEC JTC1/SC34 N0029: 1998-12-06
        Annex L.2 (informative): SGML Declaration for XML

        changes made to accommodate validation are noted with 'VALID:'
     --

     CHARSET
         BASESET
             "ISO Registration Number 177//CHARSET
              ISO/IEC 10646-1:1993 UCS-4 with implementation
              level 3//ESC 2/5 2/15 4/6"
         DESCSET
                 0        9  UNUSED
                 9        2       9
                11        2  UNUSED
                13        1      13
                14       18  UNUSED
                32       95      32
               127        1  UNUSED
               128       32  UNUSED
               160    55136     160
             55296     2048  UNUSED  -- surrogates --
             57344     8190   57344
             65534        2  UNUSED  -- FFFE and FFFF --

     CAPACITY NONE  -- Capacities are not restricted in XML --

     SCOPE DOCUMENT

     SYNTAX
         SHUNCHAR NONE
         BASESET "ISO Registration Number 177//CHARSET
                  ISO/IEC 10646-1:1993 UCS-4 with implementation
                  level 3//ESC 2/5 2/15 4/6"
         DESCSET
             0 1114112 0
         FUNCTION
             RE    13
             RS    10
             SPACE 32
             TAB   SEPCHAR 9
         NAMING
             LCNMSTRT ""
             UCNMSTRT ""
             NAMESTRT
                 58 95 192-214 216-246 248-305 308-318 321-328
                 330-382 384-451 461-496 500-501 506-535 592-680
                 699-705 902 904-906 908 910-929 931-974 976-982
                 986 988 990 992 994-1011 1025-1036 1038-1103
                 1105-1116 1118-1153 1168-1220 1223-1224
                 1227-1228 1232-1259 1262-1269 1272-1273
                 1329-1366 1369 1377-1414 1488-1514 1520-1522
                 1569-1594 1601-1610 1649-1719 1722-1726
                 1728-1742 1744-1747 1749 1765-1766 2309-2361
                 2365 2392-2401 2437-2444 2447-2448 2451-2472
                 2474-2480 2482 2486-2489 2524-2525 2527-2529
                 2544-2545 2565-2570 2575-2576 2579-2600
                 2602-2608 2610-2611 2613-2614 2616-2617
                 2649-2652 2654 2674-2676 2693-2699 2701
                 2703-2705 2707-2728 2730-2736 2738-2739
                 2741-2745 2749 2784 2821-2828 2831-2832
                 2835-2856 2858-2864 2866-2867 2870-2873 2877
                 2908-2909 2911-2913 2949-2954 2958-2960
                 2962-2965 2969-2970 2972 2974-2975 2979-2980
                 2984-2986 2990-2997 2999-3001 3077-3084
                 3086-3088 3090-3112 3114-3123 3125-3129
                 3168-3169 3205-3212 3214-3216 3218-3240
                 3242-3251 3253-3257 3294 3296-3297 3333-3340
                 3342-3344 3346-3368 3370-3385 3424-3425
                 3585-3630 3632 3634-3635 3648-3653 3713-3714
                 3716 3719-3720 3722 3725 3732-3735 3737-3743
                 3745-3747 3749 3751 3754-3755 3757-3758 3760
                 3762-3763 3773 3776-3780 3904-3911 3913-3945
                 4256-4293 4304-4342 4352 4354-4355 4357-4359
                 4361 4363-4364 4366-4370 4412 4414 4416 4428
                 4430 4432 4436-4437 4441 4447-4449 4451 4453
                 4455 4457 4461-4462 4466-4467 4469 4510 4520
                 4523 4526-4527 4535-4536 4538 4540-4546 4587
                 4592 4601 7680-7835 7840-7929 7936-7957
                 7960-7965 7968-8005 8008-8013 8016-8023 8025
                 8027 8029 8031-8061 8064-8116 8118-8124 8126
                 8130-8132 8134-8140 8144-8147 8150-8155
                 8160-8172 8178-8180 8182-8188 8486 8490-8491
                 8494 8576-8578 12295 12321-12329 12353-12436
                 12449-12538 12549-12588 19968-40869 44032-55203

             LCNMCHAR ""
             UCNMCHAR ""
             NAMECHAR
                 45-46 183 720-721 768-837 864-865 903 1155-1158
                 1425-1441 1443-1465 1467-1469 1471 1473-1474
                 1476 1600 1611-1618 1632-1641 1648 1750-1764
                 1767-1768 1770-1773 1776-1785 2305-2307 2364
                 2366-2381 2385-2388 2402-2403 2406-2415
                 2433-2435 2492 2494-2500 2503-2504 2507-2509
                 2519 2530-2531 2534-2543 2562 2620 2622-2626
                 2631-2632 2635-2637 2662-2673 2689-2691 2748
                 2750-2757 2759-2761 2763-2765 2790-2799
                 2817-2819 2876 2878-2883 2887-2888 2891-2893
                 2902-2903 2918-2927 2946-2947 3006-3010
                 3014-3016 3018-3021 3031 3047-3055 3073-3075
                 3134-3140 3142-3144 3146-3149 3157-3158
                 3174-3183 3202-3203 3262-3268 3270-3272
                 3274-3277 3285-3286 3302-3311 3330-3331
                 3390-3395 3398-3400 3402-3405 3415 3430-3439
                 3633 3636-3642 3654-3662 3664-3673 3761
                 3764-3769 3771-3772 3782 3784-3789 3792-3801
                 3864-3865 3872-3881 3893 3895 3897 3902-3903
                 3953-3972 3974-3979 3984-3989 3991 3993-4013
                 4017-4023 4025 8400-8412 8417 12293 12330-12335
                 12337-12341 12441-12442 12445-12446 12540-12542

             NAMECASE
                 GENERAL NO
                 ENTITY  NO
         DELIM
             GENERAL  SGMLREF
             HCRO     "&#x"
                      -- Ampersand followed by "#x" (without quotes) --
             NESTC    "/"
             NET      ">"
             PIC      "?>"
             SHORTREF NONE

         NAMES
             SGMLREF

         QUANTITY
             NONE -- Quantities are not restricted in XML --

         ENTITIES
             "amp"  38
             "lt"   60
             "gt"   62
             "quot" 34
             "apos" 39

     FEATURES
         MINIMIZE
             DATATAG NO
             OMITTAG YES
             RANK    NO
             SHORTTAG
                 STARTTAG
                     EMPTY    YES
                     UNCLOSED YES
                     NETENABL IMMEDNET
                 ENDTAG
                     EMPTY    YES
                     UNCLOSED YES
                 ATTRIB
                     DEFAULT  YES
                     OMITNAME YES
                     VALUE    YES
             EMPTYNRM  YES
             IMPLYDEF
                 ATTLIST  NO  -- VALID: was YES --
                 DOCTYPE  NO
                 ELEMENT  NO  -- VALID: was YES --
                 ENTITY   NO
                 NOTATION NO  -- VALID: was YES --
         LINK
             SIMPLE   NO
             IMPLICIT NO
             EXPLICIT NO
         OTHER
             CONCUR   NO
             SUBDOC   NO
             FORMAL   NO
             URN      NO
             KEEPRSRE YES
             VALIDITY TYPE -- VALID: was NOASSERT --
             ENTITIES
                 REF      ANY
                 INTEGRAL YES

     APPINFO NONE

     SEEALSO "ISO 8879//NOTATION Extensible Markup Language (XML) 1.0//EN"
>
<!-- $Id: xml.dcl,v 1.2.2.1 2002/07/07 16:42:03 tbe Exp $ -->

<!SGML "ISO 8879:1986 (WWW)"

     -- SGML Declaration for XML 1.0 --

     -- from:
        Final text of revised Web SGML Adaptations Annex (TC2) to ISO 8879:1986
        ISO/IEC JTC1/SC34 N0029: 1998-12-06
        Annex L.2 (informative): SGML Declaration for XML

        changes made to accommodate validation are noted with 'VALID:'
     --

     CHARSET
         BASESET
             "ISO Registration Number 177//CHARSET
              ISO/IEC 10646-1:1993 UCS-4 with implementation
              level 3//ESC 2/5 2/15 4/6"
         DESCSET
                 0        9  UNUSED
                 9        2       9
                11        2  UNUSED
                13        1      13
                14       18  UNUSED
                32       95      32
               127        1  UNUSED
               128       32  UNUSED
               160    55136     160
             55296     2048  UNUSED  -- surrogates --
             57344     8190   57344
             65534        2  UNUSED  -- FFFE and FFFF --
             65536  1048576   65536

     CAPACITY NONE  -- Capacities are not restricted in XML --

     SCOPE DOCUMENT

     SYNTAX
         SHUNCHAR NONE
         BASESET "ISO Registration Number 177//CHARSET
                  ISO/IEC 10646-1:1993 UCS-4 with implementation
                  level 3//ESC 2/5 2/15 4/6"
         DESCSET
             0 1114112 0
         FUNCTION
             RE    13
             RS    10
             SPACE 32
             TAB   SEPCHAR 9
         NAMING
             LCNMSTRT ""
             UCNMSTRT ""
             NAMESTRT
                 58 95 192-214 216-246 248-305 308-318 321-328
                 330-382 384-451 461-496 500-501 506-535 592-680
                 699-705 902 904-906 908 910-929 931-974 976-982
                 986 988 990 992 994-1011 1025-1036 1038-1103
                 1105-1116 1118-1153 1168-1220 1223-1224
                 1227-1228 1232-1259 1262-1269 1272-1273
                 1329-1366 1369 1377-1414 1488-1514 1520-1522
                 1569-1594 1601-1610 1649-1719 1722-1726
                 1728-1742 1744-1747 1749 1765-1766 2309-2361
                 2365 2392-2401 2437-2444 2447-2448 2451-2472
                 2474-2480 2482 2486-2489 2524-2525 2527-2529
                 2544-2545 2565-2570 2575-2576 2579-2600
                 2602-2608 2610-2611 2613-2614 2616-2617
                 2649-2652 2654 2674-2676 2693-2699 2701
                 2703-2705 2707-2728 2730-2736 2738-2739
                 2741-2745 2749 2784 2821-2828 2831-2832
                 2835-2856 2858-2864 2866-2867 2870-2873 2877
                 2908-2909 2911-2913 2949-2954 2958-2960
                 2962-2965 2969-2970 2972 2974-2975 2979-2980
                 2984-2986 2990-2997 2999-3001 3077-3084
                 3086-3088 3090-3112 3114-3123 3125-3129
                 3168-3169 3205-3212 3214-3216 3218-3240
                 3242-3251 3253-3257 3294 3296-3297 3333-3340
                 3342-3344 3346-3368 3370-3385 3424-3425
                 3585-3630 3632 3634-3635 3648-3653 3713-3714
                 3716 3719-3720 3722 3725 3732-3735 3737-3743
                 3745-3747 3749 3751 3754-3755 3757-3758 3760
                 3762-3763 3773 3776-3780 3904-3911 3913-3945
                 4256-4293 4304-4342 4352 4354-4355 4357-4359
                 4361 4363-4364 4366-4370 4412 4414 4416 4428
                 4430 4432 4436-4437 4441 4447-4449 4451 4453
                 4455 4457 4461-4462 4466-4467 4469 4510 4520
                 4523 4526-4527 4535-4536 4538 4540-4546 4587
                 4592 4601 7680-7835 7840-7929 7936-7957
                 7960-7965 7968-8005 8008-8013 8016-8023 8025
                 8027 8029 8031-8061 8064-8116 8118-8124 8126
                 8130-8132 8134-8140 8144-8147 8150-8155
                 8160-8172 8178-8180 8182-8188 8486 8490-8491
                 8494 8576-8578 12295 12321-12329 12353-12436
                 12449-12538 12549-12588 19968-40869 44032-55203

             LCNMCHAR ""
             UCNMCHAR ""
             NAMECHAR
                 45-46 183 720-721 768-837 864-865 903 1155-1158
                 1425-1441 1443-1465 1467-1469 1471 1473-1474
                 1476 1600 1611-1618 1632-1641 1648 1750-1764
                 1767-1768 1770-1773 1776-1785 2305-2307 2364
                 2366-2381 2385-2388 2402-2403 2406-2415
                 2433-2435 2492 2494-2500 2503-2504 2507-2509
                 2519 2530-2531 2534-2543 2562 2620 2622-2626
                 2631-2632 2635-2637 2662-2673 2689-2691 2748
                 2750-2757 2759-2761 2763-2765 2790-2799
                 2817-2819 2876 2878-2883 2887-2888 2891-2893
                 2902-2903 2918-2927 2946-2947 3006-3010
                 3014-3016 3018-3021 3031 3047-3055 3073-3075
                 3134-3140 3142-3144 3146-3149 3157-3158
                 3174-3183 3202-3203 3262-3268 3270-3272
                 3274-3277 3285-3286 3302-3311 3330-3331
                 3390-3395 3398-3400 3402-3405 3415 3430-3439
                 3633 3636-3642 3654-3662 3664-3673 3761
                 3764-3769 3771-3772 3782 3784-3789 3792-3801
                 3864-3865 3872-3881 3893 3895 3897 3902-3903
                 3953-3972 3974-3979 3984-3989 3991 3993-4013
                 4017-4023 4025 8400-8412 8417 12293 12330-12335
                 12337-12341 12441-12442 12445-12446 12540-12542

             NAMECASE
                 GENERAL NO
                 ENTITY  NO
         DELIM
             GENERAL  SGMLREF
             HCRO     "&#x"
                      -- Ampersand followed by "#x" (without quotes) --
             NESTC    "/"
             NET      ">"
             PIC      "?>"
             SHORTREF NONE

         NAMES
             SGMLREF

         QUANTITY
             NONE -- Quantities are not restricted in XML --

         ENTITIES
             "amp"  38
             "lt"   60
             "gt"   62
             "quot" 34
             "apos" 39

     FEATURES
         MINIMIZE
             DATATAG NO
             OMITTAG YES
             RANK    NO
             SHORTTAG
                 STARTTAG
                     EMPTY    YES
                     UNCLOSED YES
                     NETENABL IMMEDNET
                 ENDTAG
                     EMPTY    YES
                     UNCLOSED YES
                 ATTRIB
                     DEFAULT  YES
                     OMITNAME YES
                     VALUE    YES
             EMPTYNRM  YES
             IMPLYDEF
                 ATTLIST  NO  -- VALID: was YES --
                 DOCTYPE  NO
                 ELEMENT  NO  -- VALID: was YES --
                 ENTITY   NO
                 NOTATION NO  -- VALID: was YES --
         LINK
             SIMPLE   NO
             IMPLICIT NO
             EXPLICIT NO
         OTHER
             CONCUR   NO
             SUBDOC   NO
             FORMAL   NO
             URN      NO
             KEEPRSRE YES
             VALIDITY TYPE -- VALID: was NOASSERT --
             ENTITIES
                 REF      ANY
                 INTEGRAL YES

     APPINFO NONE

     SEEALSO "ISO 8879//NOTATION Extensible Markup Language (XML) 1.0//EN"
>
<!-- $Id: xml.dcl,v 1.2.2.1 2002/07/07 16:42:03 tbe Exp $ -->


Test script for VMS
(eol=CR; not sure if that is necessary; native might be better)

git-svn-id: a20303ca0449e3ef575223833049c5e6a53b9062@646882 13f79535-47bb-0310-9956-ffa450edef68

$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$!
$! Licensed to the Apache Software Foundation (ASF) under one or more
$! contributor license agreements.  See the NOTICE file distributed with
$! this work for additional information regarding copyright ownership.
$! The ASF licenses this file to You under the Apache License, Version 2.0
$! (the "License"); you may not use this file except in compliance with
$! the License.  You may obtain a copy of the License at
$!
$!      http://www.apache.org/licenses/LICENSE-2.0
$!
$! Unless required by applicable law or agreed to in writing, software
$! distributed under the License is distributed on an "AS IS" BASIS,
$! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
$! See the License for the specific language governing permissions and
$! limitations under the License.
$!
$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$!
$! Run the test suite
$!
$ create/directory [.target]
$ java "-Dorg.apache.commons.exec.lenient=false" "-Dorg.apache.commons.exec.debug=false" -
  -cp "./lib/junit-3.8.1.jar:./lib/exec-test-1.0-SNAPSHOT.jar:./lib/exec-1.0-SNAPSHOT.jar" -
  "org.apache.commons.exec.TestRunner"

error: pathspec 'src/test/bin/testme.dcl' did not match any file(s) known to git