Commit 1165829a authored by Camil Staps's avatar Camil Staps 🚀

Use CleanTypeUnifier for unification; move backend largely to Clean

parent b16c505f
......@@ -12,3 +12,4 @@ clean-platform
Clean System Files/
search
builddb
CloogleServer
Subproject commit 92f6540f151b346744ad4fed37e66e7a0b50315b
Subproject commit d477cee1eef4b24ff2ad4be74b3a2f8d11ed06bf
module CloogleServer
import StdString, StdArray, StdList, StdFile, StdTuple, StdMisc, StdOrdList, StdBool
from StdFunc import o
import TCPIP
from Data.Func import $
import Data.Maybe
import System.CommandLine
import Text
import Text.JSON
import Data.Functor
import Control.Applicative
from Control.Monad import class Monad(..)
import SimpleTCPServer
import TypeDB
import Type
import Levenshtein
:: Command = { unify :: String
, name :: String
}
:: Response = { return :: Int
, data :: [Result]
, msg :: String
}
:: Result = { library :: String
, filename :: String
, func :: String
, modul :: String
, distance :: Int
}
derive JSONEncode Command, Response, Result
derive JSONDecode Command, Response, Result
instance toString Response where toString r = toString $ toJSON r
instance toString Command where toString r = toString $ toJSON r
instance fromString (Maybe Command) where fromString s = fromJSON $ fromString s
instance < Result where (<) r1 r2 = r1.distance < r2.distance
err :: Int String -> Response
err c m = {return=c, data=[], msg=m}
Start w
# (io, w) = stdio w
# (cmdline, w) = getCommandLine w
| length cmdline <> 2 = help io w
# [_,port:_] = cmdline
# port = toInt port
# (db, io) = openDb io
# (_, w) = fclose io w
| isNothing db = abort "stdin does not have a TypeDB\n"
# db = fromJust db
= serve (handle db) (Just log) port w
where
help :: *File *World -> *World
help io w
# io = io <<< "Usage: ./CloogleServer <port>\n"
= snd $ fclose io w
handle :: TypeDB (Maybe Command) *World -> *(Response, *World)
handle _ Nothing w = (err 1 "Couldn't parse input", w)
handle db (Just {unify,name}) w
# mbType = parseType (fromString unify)
# filters = catMaybes $ [ isUnifiable <$> mbType
, pure $ isNameMatch (size name - 2) name
]
# results = map (makeResult name mbType) $ findType`` filters db
= ({return=0,msg="Success",data=sort results}, w)
makeResult :: String (Maybe Type) (FunctionLocation, Type) -> Result
makeResult orgsearch orgsearchtype (FL lib mod fname, type)
= { library = lib
, filename = (toString $ reverse $ takeWhile ((<>)'.') $ reverse $ fromString mod) +++ ".dcl"
, modul = mod
, func = fname +++ " :: " +++ concat (print type)
, distance = distance
}
where
distance
| orgsearch == ""
| isNothing orgsearchtype = 0
# orgsearchtype = fromJust orgsearchtype
# (Just (ass1, ass2)) = unify [] orgsearchtype type
= length $ filter (not o isVar o snd) $ ass1 ++ ass2
# levdist = levenshtein fname orgsearch
= if (indexOf orgsearch fname == -1) 0 -100 + levdist
isUnifiable :: Type FunctionLocation Type -> Bool
isUnifiable t1 _ t2 = isJust (unify [] t1 t2)
isNameMatch :: Int String FunctionLocation Type -> Bool
isNameMatch maxdist n1 (FL _ _ n2) _
# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: n2})
= n1 == "" || indexOf n1 n2 <> -1 || levenshtein n1 n2 <= maxdist
log :: (LogMessage (Maybe Command) Response) IPAddress *World -> *(IPAddress, *World)
log msg s w
# (io,w) = stdio w
# io = fwrites (msgToString msg s) io
= (newS msg s, snd (fclose io w))
newS :: (LogMessage (Maybe Command) Response) IPAddress -> IPAddress
newS m s = case m of (Connected ip) = ip; _ = s
msgToString :: (LogMessage (Maybe Command) Response) IPAddress -> String
msgToString (Received Nothing) ip
= toString ip +++ " <-- Nothing\n"
msgToString (Received (Just a)) ip
= toString ip +++ " <-- " +++ toString a +++ "\n"
msgToString (Sent b) ip
= toString ip +++ " --> " +++ toString b +++ "\n"
msgToString _ _ = ""
This diff is collapsed.
definition module SimpleTCPServer
from StdOverloaded import class zero, class fromString, class toString
from Data.Maybe import ::Maybe
from TCPIP import ::IPAddress, ::Port
:: LogMessage a b = Connected IPAddress
| Received a
| Sent b
| Disconnected
:: Logger a b s :== (LogMessage a b) s *World -> *(s, *World)
serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World
-> *World | fromString a & toString b
implementation module SimpleTCPServer
import TCPIP
import StdEnv
import StdMaybe
instance zero (Logger a b s) where zero = \_ _ w -> (undef, w)
serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World
-> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
| not ok = abort ("Couldn't open port " +++ toString port)
# listener = fromJust mbListener
# log = if (isNothing log) zero (fromJust log)
# (listener, w) = handle f log listener w
= closeRChannel listener w
where
handle :: (a *World -> *(b,*World)) (Logger a b s) TCP_Listener *World
-> (TCP_Listener, *World) | fromString a & toString b
handle f log li w
# ((ip, dupChan),li,w) = receive li w
# (s, w) = log (Connected ip) undef w
# (msg, rChan, w) = receive dupChan.rChannel w
dupChan = {dupChan & rChannel=rChan}
# msg = fromString (toString msg)
# (s, w) = log (Received msg) s w
# (resp, w) = f msg w
# (sChan, w) = send (toByteSeq (toString resp)) dupChan.sChannel w
dupChan = {dupChan & sChannel=sChan}
# (s, w) = log (Sent resp) s w
# w = closeRChannel dupChan.rChannel w
# w = closeChannel dupChan.sChannel w
# (s, w) = log Disconnected s w
= handle f log li w
......@@ -78,7 +78,7 @@ function formsubmit(){
sresults.innerHTML += '<hr /><table>' +
'<tr><th>Library: </th><td>' + c['library'] + '</td></tr>' +
'<tr><th>Filename: </th><td>' + c['filename'] + '</td></tr>' +
'<tr><th>Module: </th><td>' + c['module'] + '</td>' +
'<tr><th>Module: </th><td>' + c['modul'] + '</td>' +
'<td>' + c['distance'] + '</td></tr>' +
'</table>' +
'<code>' + highlight(c['func']) + '</code>';
......
......@@ -2,55 +2,8 @@
error_reporting(E_ALL);
ini_set('display_errors', '1');
define('PRE_IDENT', '[\w~@#$%^?!+\-*<>\/|&=:`]+');
define('PRE_MODULE',
"/\s*(?:definition\s*|system\s*|implementation\s*)module\s+([\w.]+)\s*[\n;]/");
define('PRE_FUNC',
'/^(?:\\/\\/)?\s*(?:instance|class)?\s*\(?(' . PRE_IDENT . ')\)?\s*(?:infix[lr]?\s+\d\s*(?:\\/\\/)?)?(?:\s+a\s+)?::.*$/mi');
function search_doc(&$r, $name, $libraries, $searchmodules){
foreach($libraries as $library => $librarypath){
$files = glob($librarypath . "*.dcl", GLOB_NOSORT | GLOB_MARK);
foreach($files as $filepath) {
if(mb_substr($filepath, -1) !== DIRECTORY_SEPARATOR){
$path_segments = explode(DIRECTORY_SEPARATOR, $filepath);
$filename = end($path_segments);
$contents = file_get_contents($filepath);
$module = preg_match(PRE_MODULE, $contents, $modules) == 1 ?
$modules[1] : NULL;
if(count($searchmodules) > 0 && !in_array($module, $searchmodules)){
continue;
}
if(preg_match_all(PRE_FUNC, $contents, $funcs) !== false){
for($i=0; $i<count($funcs[1]); $i++){
$funcname = $funcs[1][$i];
$funcsig = $funcs[0][$i];
$lowername = strtolower($name);
$lowerfuncname = strtolower($funcname);
if(strstr($lowerfuncname, $lowername) !== FALSE){
$score = -100+levenshtein($lowername, $lowerfuncname);
} else {
$score = levenshtein($lowername, $lowerfuncname);
}
if($score < 3){
array_push($r, array(
"library" => $library,
"filename" => $filename,
"func" => str_replace("\n", "", $funcsig),
"module" => $module,
"distance" => $score));
}
}
}
}
}
}
return "Success";
}
function sort_results(&$r, $by='distance'){
usort($r, function($a, $b) use ($by) { return $a[$by] > $b[$by]; });
}
define('SERVER_HOSTNAME', 'localhost');
define('SERVER_PORT', 31215);
if($_SERVER['REQUEST_METHOD'] !== 'GET'){
echo json_encode(array(
......@@ -63,88 +16,23 @@ if($_SERVER['REQUEST_METHOD'] !== 'GET'){
"data" => array(),
"msg" => "GET variable 'str' should be set"));
} else {
$libraries = array(
'ArgEnv' => './ArgEnv/',
'Directory' => './Directory/',
'Dynamics' => './Dynamics/',
'Generics' => './Generics/',
'MersenneTwister' => './MersenneTwister/',
'StdEnv' => './StdEnv/',
'StdLib' => './StdLib/',
'TCPIP' => './TCPIP/',
'cleanplatform:OS-Linux-64' =>'./clean-platform/OS-Linux-64/',
'cleanplatform:OS-Linux-64/System' =>'./clean-platform/OS-Linux-64/System/',
'cleanplatform:OS-Linux-64/Database' =>'./clean-platform/OS-Linux-64/Database/',
'cleanplatform:OS-Linux-64/Database/SQL' =>'./clean-platform/OS-Linux-64/Database/SQL/',
'cleanplatform:OS-Mac' =>'./clean-platform/OS-Mac/',
'cleanplatform:OS-Mac/System' =>'./clean-platform/OS-Mac/System/',
'cleanplatform:OS-Mac/Database' =>'./clean-platform/OS-Mac/Database/',
'cleanplatform:OS-Mac/Database/SQL' =>'./clean-platform/OS-Mac/Database/SQL/',
'cleanplatform:OS-Mac/Network' =>'./clean-platform/OS-Mac/Network/',
'cleanplatform:OS-Linux-32' =>'./clean-platform/OS-Linux-32/',
'cleanplatform:OS-Linux-32/System' =>'./clean-platform/OS-Linux-32/System/',
'cleanplatform:OS-Windows-64' =>'./clean-platform/OS-Windows-64/',
'cleanplatform:OS-Windows-64/System' =>'./clean-platform/OS-Windows-64/System/',
'cleanplatform:OS-Linux' =>'./clean-platform/OS-Linux/',
'cleanplatform:OS-Linux/System' =>'./clean-platform/OS-Linux/System/',
'cleanplatform:OS-Linux/Network' =>'./clean-platform/OS-Linux/Network/',
'cleanplatform:OS-Posix' =>'./clean-platform/OS-Posix/',
'cleanplatform:OS-Posix/System' =>'./clean-platform/OS-Posix/System/',
'cleanplatform:OS-Posix/Network' =>'./clean-platform/OS-Posix/Network/',
'cleanplatform:OS-Posix/DataSources' =>'./clean-platform/OS-Posix/DataSources/',
'cleanplatform:OS-Windows-32' =>'./clean-platform/OS-Windows-32/',
'cleanplatform:OS-Windows-32/System' =>'./clean-platform/OS-Windows-32/System/',
'cleanplatform:OS-Windows' =>'./clean-platform/OS-Windows/',
'cleanplatform:OS-Windows/System' =>'./clean-platform/OS-Windows/System/',
'cleanplatform:OS-Windows/Database' =>'./clean-platform/OS-Windows/Database/',
'cleanplatform:OS-Windows/Database/SQL' =>'./clean-platform/OS-Windows/Database/SQL/',
'cleanplatform:OS-Windows/Network' =>'./clean-platform/OS-Windows/Network/',
'cleanplatform:OS-Windows/DataSources' =>'./clean-platform/OS-Windows/DataSources/',
'cleanplatform:OS-Windows/Data' =>'./clean-platform/OS-Windows/Data/',
'cleanplatform:OS-Independent' =>'./clean-platform/OS-Independent/',
'cleanplatform:OS-Independent/Math' =>'./clean-platform/OS-Independent/Math/',
'cleanplatform:OS-Independent/System' =>'./clean-platform/OS-Independent/System/',
'cleanplatform:OS-Independent/Crypto' =>'./clean-platform/OS-Independent/Crypto/',
'cleanplatform:OS-Independent/Crypto/Hash' =>'./clean-platform/OS-Independent/Crypto/Hash/',
'cleanplatform:OS-Independent/Control' =>'./clean-platform/OS-Independent/Control/',
'cleanplatform:OS-Independent/Control/Monad' =>'./clean-platform/OS-Independent/Control/Monad/',
'cleanplatform:OS-Independent/GUI' =>'./clean-platform/OS-Independent/GUI/',
'cleanplatform:OS-Independent/Deprecated' =>'./clean-platform/OS-Independent/Deprecated/',
'cleanplatform:OS-Independent/Deprecated/StdLib' =>'./clean-platform/OS-Independent/Deprecated/StdLib/',
'cleanplatform:OS-Independent/Database' =>'./clean-platform/OS-Independent/Database/',
'cleanplatform:OS-Independent/Database/SQL' =>'./clean-platform/OS-Independent/Database/SQL/',
'cleanplatform:OS-Independent/Text' =>'./clean-platform/OS-Independent/Text/',
'cleanplatform:OS-Independent/Text/Unicode' =>'./clean-platform/OS-Independent/Text/Unicode/',
'cleanplatform:OS-Independent/Text/Unicode/Encodings' =>'./clean-platform/OS-Independent/Text/Unicode/Encodings/',
'cleanplatform:OS-Independent/Text/Encodings' =>'./clean-platform/OS-Independent/Text/Encodings/',
'cleanplatform:OS-Independent/Text/Parsers' =>'./clean-platform/OS-Independent/Text/Parsers/',
'cleanplatform:OS-Independent/Text/Parsers/Test' =>'./clean-platform/OS-Independent/Text/Parsers/Test/',
'cleanplatform:OS-Independent/Text/Parsers/MetarDemo' =>'./clean-platform/OS-Independent/Text/Parsers/MetarDemo/',
'cleanplatform:OS-Independent/Internet' =>'./clean-platform/OS-Independent/Internet/',
'cleanplatform:OS-Independent/Internet/HTTP' =>'./clean-platform/OS-Independent/Internet/HTTP/',
'cleanplatform:OS-Independent/Network' =>'./clean-platform/OS-Independent/Network/',
'cleanplatform:OS-Independent/Test' =>'./clean-platform/OS-Independent/Test/',
'cleanplatform:OS-Independent/Data' =>'./clean-platform/OS-Independent/Data/',
'cleanplatform:OS-Independent/Data/Functor' =>'./clean-platform/OS-Independent/Data/Functor/',
'cleanplatform:OS-Independent/Data/IntMap' =>'./clean-platform/OS-Independent/Data/IntMap/',
'cleanplatform:OS-Independent/Data/Encoding' =>'./clean-platform/OS-Independent/Data/Encoding/',
'cleanplatform:OS-Independent/Graphics' =>'./clean-platform/OS-Independent/Graphics/',
'cleanplatform:OS-Independent/Graphics/Scalable' =>'./clean-platform/OS-Independent/Graphics/Scalable/');
$str = array_map('trim', explode('::', $_GET['str']));
$name = $str[0];
$unify = isset($str[1]) ? $str[1] : '';
$command = ['name' => $name, 'unify' => $unify];
$res = array();
$modules = isset($_GET['mod']) ? explode(',', $_GET['mod']) : array();
$msg = search_doc($res, $_GET['str'], $libraries, $modules);
sort_results($res);
if(!$res){
$skt = fsockopen(SERVER_HOSTNAME, SERVER_PORT);
if (!$skt) {
echo json_encode(array(
"return" => 127,
"return" => 3,
"data" => array(),
"msg" => "Nothing found..."));
"msg" => "Internal server error"));
} else {
echo json_encode(array(
"return" => 0,
"data" => $res,
"msg" => $msg));
fwrite($skt, json_encode($command));
while (!feof($skt)) {
echo fgets($skt, 128);
}
fclose($skt);
}
}
?>
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