mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 11:17:45 +02:00
* Regexp support
This commit is contained in:
Michaël Van Canneyt
parent
f07765b895
commit
cc6810e6e6
1
demo/wasienv/regexp/bulma.min.css
vendored
Normal file
1
demo/wasienv/regexp/bulma.min.css
vendored
Normal file
File diff suppressed because one or more lines are too long
39
demo/wasienv/regexp/index.html
Normal file
39
demo/wasienv/regexp/index.html
Normal file
@ -0,0 +1,39 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
|
||||
<title>Project1</title>
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<link href="bulma.min.css" rel="stylesheet">
|
||||
<script src="hostconfig.js"></script>
|
||||
<script src="regexphost.js"></script>
|
||||
<style>
|
||||
#pasjsconsole {
|
||||
border-style: solid;
|
||||
border-width: 1px;
|
||||
margin-left: 64px;
|
||||
margin-right: 64px;
|
||||
min-height: 75vh;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<div class="container">
|
||||
<h3 class="title is-3">Webassembly program output</h3>
|
||||
<hr>
|
||||
<div class="box">
|
||||
<div id="pasjsconsole"></div>
|
||||
</div>
|
||||
<div>
|
||||
<label for="cbLog">
|
||||
<input id="cbLog" type="checkbox" checked autocomplete="off">
|
||||
Show API log
|
||||
</label>
|
||||
</div>
|
||||
</div>
|
||||
<script>
|
||||
rtl.showUncaughtExceptions=true;
|
||||
window.addEventListener("load", rtl.run);
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
95
demo/wasienv/regexp/regexphost.lpi
Normal file
95
demo/wasienv/regexp/regexphost.lpi
Normal file
@ -0,0 +1,95 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="regexphost"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="6">
|
||||
<Item0 Name="BrowserConsole" Value="1"/>
|
||||
<Item1 Name="MaintainHTML" Value="1"/>
|
||||
<Item2 Name="Pas2JSProject" Value="1"/>
|
||||
<Item3 Name="PasJSLocation" Value="$NameOnly($(ProjFile))"/>
|
||||
<Item4 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
<Item5 Name="RunAtReady" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="regexphost.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="index.html"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CustomData Count="1">
|
||||
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
|
||||
</CustomData>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="../../../packages/wasm-utils/src/wasm.pas2js.regexp.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="regexphost"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
<CPPInline Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="browser"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
65
demo/wasienv/regexp/regexphost.lpr
Normal file
65
demo/wasienv/regexp/regexphost.lpr
Normal file
@ -0,0 +1,65 @@
|
||||
program regexphost;
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch externalclass}
|
||||
|
||||
uses
|
||||
BrowserConsole, BrowserApp, WASIHostApp, JS, Classes, SysUtils, Web, wasm.pas2js.regexp;
|
||||
|
||||
type
|
||||
THostConfig = class external name 'Object' (TJSObject)
|
||||
wasmFilename : String;
|
||||
logRegExpAPI : Boolean;
|
||||
logWasiAPI : Boolean;
|
||||
end;
|
||||
|
||||
var
|
||||
HostConfig : THostConfig; external name 'hostConfig';
|
||||
|
||||
Type
|
||||
{ TMyApplication }
|
||||
|
||||
TMyApplication = class(TWASIHostApplication)
|
||||
cbLog:TJSHTMLInputElement;
|
||||
FRegexp : TWasmRegExpAPI;
|
||||
private
|
||||
procedure HandleLogClick(Event: TJSEvent);
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
end;
|
||||
|
||||
procedure TMyApplication.DoRun;
|
||||
begin
|
||||
StartWebAssembly('wasmregexpdemo.wasm');
|
||||
end;
|
||||
|
||||
procedure TMyApplication.HandleLogClick(Event : TJSEvent);
|
||||
|
||||
begin
|
||||
FRegexp.LogAPICalls:=cbLog.Checked;
|
||||
end;
|
||||
|
||||
constructor TMyApplication.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FRegexp:=TWasmRegExpAPI.Create(WasiEnvironment);
|
||||
if isDefined(hostConfig) and Assigned(hostConfig) then
|
||||
begin
|
||||
WasiEnvironment.LogAPI:=HostConfig.logWasiAPi;
|
||||
FRegexp.LogAPICalls:=HostConfig.logRegExpAPI;
|
||||
end;
|
||||
cbLog:=TJSHTMLInputElement(GetHTMLElement('cbLog'));
|
||||
cbLog.Checked:=FRegexp.LogAPICalls;
|
||||
cbLog.addEventListener('click',@HandleLogClick);
|
||||
end;
|
||||
|
||||
var
|
||||
Application : TMyApplication;
|
||||
|
||||
begin
|
||||
Application:=TMyApplication.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
end.
|
||||
628
packages/wasm-utils/src/wasm.pas2js.regexp.pas
Normal file
628
packages/wasm-utils/src/wasm.pas2js.regexp.pas
Normal file
@ -0,0 +1,628 @@
|
||||
unit wasm.pas2js.regexp;
|
||||
|
||||
{$mode ObjFPC}
|
||||
{ $define NOLOGAPICALLS}
|
||||
interface
|
||||
|
||||
uses
|
||||
sysutils, js, wasienv, weborworker, wasm.regexp.shared, types;
|
||||
|
||||
Type
|
||||
PByte = TWasmPointer;
|
||||
PLongint = TWasmPointer;
|
||||
TIndexArray = Array[0..1] of Longint;
|
||||
|
||||
{ TWasmRegexp }
|
||||
|
||||
TWasmRegexp = Class(TObject)
|
||||
private
|
||||
FID: TWasmRegexpID;
|
||||
FRegExp: TJSRegExp;
|
||||
FRes: TJSObject;
|
||||
FGroupNames : TStringDynArray;
|
||||
procedure GetGroupNames;
|
||||
Public
|
||||
Constructor Create(aRegex : TJSRegexp; aID : TWasmRegexpID);
|
||||
Procedure Exec(S : String);
|
||||
Function Test(S : String) : Boolean;
|
||||
Function HaveResult : Boolean;
|
||||
Function ResultIndex : Integer;
|
||||
Function ResultMatchCount : Integer;
|
||||
Function GetMatch(aIndex: Integer) : String;
|
||||
Function GetMatchIndexes(aIndex: Integer) : TIndexArray;
|
||||
Function GetGroupIndexes(aName: String) : TIndexArray;
|
||||
Function GetGroupCount : Integer;
|
||||
Function GetGroupName(aIndex : Integer) : String;
|
||||
Function GetGroupValue(const aName : String) : String;
|
||||
Property RegExp : TJSRegExp Read FRegExp;
|
||||
Property Res : TJSObject Read FRes;
|
||||
Property ID : TWasmRegexpID Read FID;
|
||||
end;
|
||||
{ TWasmRegExpAPI }
|
||||
|
||||
TWasmRegExpAPI = class(TImportExtension)
|
||||
Private
|
||||
FLogAPICalls: Boolean;
|
||||
FNextID : TWasmRegexpID;
|
||||
FRegExps : TJSObject;
|
||||
protected
|
||||
procedure DoError(const Msg : String);
|
||||
Procedure DoError(Const Fmt : String; const Args : Array of const);
|
||||
Procedure LogCall(const Msg : String);
|
||||
Procedure LogCall(Const Fmt : String; const Args : Array of const);
|
||||
Function GetNextID : TWasmRegExpID;
|
||||
Function FindRegExp(aID : TWasmRegExpID) : TWasmRegExp;
|
||||
function RegExpAllocate(aExpr : PByte; aExprLen : longint; aFlags : Longint; aID : PWasmRegExpID) : TWasmRegexpResult;
|
||||
function RegExpDeallocate(aExprID : TWasmRegExpID) : TWasmRegexpResult;
|
||||
function RegExpExec(aExprID : TWasmRegExpID; aString : PByte; aStringLen :Longint; aIndex : PLongint; aResultCount : PLongint) : TWasmRegexpResult;
|
||||
function RegExpTest(aExprID : TWasmRegExpID; aString : PByte; aStringLen :Longint; aResult : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetFlags(aExprID : TWasmRegExpID; aFlags : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetExpression(aExprID : TWasmRegExpID; aExp : PByte; aExpLen : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetLastIndex(aExprID : TWasmRegExpID; aLastIndex : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetResultMatch(aExprID : TWasmRegExpID; aIndex : Longint; Res : PByte; ResLen : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetGroupCount(aExprID : TWasmRegExpID; aCount: PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetGroupName(aExprID : TWasmRegExpID; aIndex : Longint; aName : PByte; aNameLen : PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetNamedGroup(aExprID : TWasmRegExpID; aName : PByte; aNameLen : Longint; aValue : PByte; aValueLen: PLongint) : TWasmRegexpResult;
|
||||
function RegExpGetIndexes(aExprID : TWasmRegExpID; aIndex : Longint; aStartIndex : PLongint; aStopIndex: PLongint) : TWasmRegexpResult; ;
|
||||
function RegExpGetNamedGroupIndexes(aExprID : TWasmRegExpID; aName : PByte; aNameLen : Integer; aStartIndex : PLongint; aStopIndex: PLongint) : TWasmRegexpResult;
|
||||
Public
|
||||
constructor Create(aEnv: TPas2JSWASIEnvironment); override;
|
||||
procedure FillImportObject(aObject: TJSObject); override;
|
||||
function ImportName: String; override;
|
||||
Property LogAPICalls : Boolean Read FLogAPICalls Write FLogAPICalls;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TWasmRegexp }
|
||||
|
||||
constructor TWasmRegexp.Create(aRegex: TJSRegexp; aID: TWasmRegexpID);
|
||||
begin
|
||||
FRegExp:=aRegex;
|
||||
FID:=aID;
|
||||
end;
|
||||
|
||||
procedure TWasmRegexp.Exec(S: String);
|
||||
begin
|
||||
FRes:=FRegExp.ExecFull(S);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.Test(S: String): Boolean;
|
||||
begin
|
||||
Result:=FRegexp.test(S);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.HaveResult: Boolean;
|
||||
begin
|
||||
Result:=Assigned(FRes);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.ResultIndex: Integer;
|
||||
|
||||
var
|
||||
Tmp : JSValue;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
if Not HaveResult then
|
||||
exit;
|
||||
Tmp:=FRes['index'];
|
||||
If isNumber(Tmp) then
|
||||
Result:=Integer(Tmp);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.ResultMatchCount: Integer;
|
||||
|
||||
var
|
||||
Tmp : JSValue;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
if Not HaveResult then
|
||||
exit;
|
||||
Tmp:=FRes['length'];
|
||||
If isNumber(Tmp) then
|
||||
Result:=Integer(Tmp);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetMatch(aIndex: Integer): String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
if Not HaveResult then
|
||||
exit;
|
||||
if (aIndex>=0) and (aIndex<ResultMatchCount) then
|
||||
Result:=String(FRes[IntToStr(aIndex)])
|
||||
else
|
||||
Raise Exception.CreateFmt('Index %d out of bounds [0..%d[',[aIndex,ResultMatchCount]);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetMatchIndexes(aIndex: Integer): TIndexArray;
|
||||
|
||||
var
|
||||
Tmp : JSValue;
|
||||
Arr : TJSArray absolute tmp;
|
||||
Tmp2 : JSValue;
|
||||
Arr2 : TJSArray absolute tmp2;
|
||||
|
||||
|
||||
begin
|
||||
Result[0]:=-1;
|
||||
Result[1]:=-1;
|
||||
if Not HaveResult then
|
||||
Exit;
|
||||
if pos('d',RegExp.Flags)=0 then
|
||||
Exit;
|
||||
if (aIndex<0) or (aIndex>=ResultMatchCount) then
|
||||
Exit;
|
||||
Tmp:=FRes['indices'];
|
||||
if not isArray(Tmp) then
|
||||
exit;
|
||||
if (aIndex<0) or (aIndex>=Arr.length) then
|
||||
Raise Exception.CreateFmt('Index %d out of bounds [0..%d[',[aIndex,ResultMatchCount]);
|
||||
Tmp2:=Arr[aIndex];
|
||||
if not isArray(Tmp2) then
|
||||
exit;
|
||||
Result[0]:=Integer(Arr2[0]);
|
||||
Result[1]:=Integer(Arr2[1]);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetGroupIndexes(aName: String): TIndexArray;
|
||||
|
||||
var
|
||||
Tmp : JSValue;
|
||||
Obj : TJSObject absolute tmp;
|
||||
Tmp2 : JSValue;
|
||||
lGroups : TJSObject absolute tmp2;
|
||||
Res: JSValue;
|
||||
Arr2 : TJSArray absolute Res;
|
||||
|
||||
begin
|
||||
Result[0]:=-1;
|
||||
Result[1]:=-1;
|
||||
if Not HaveResult then
|
||||
Exit;
|
||||
if pos('d',RegExp.Flags)=0 then
|
||||
Exit;
|
||||
Tmp:=FRes['indices'];
|
||||
if not isArray(Tmp) then
|
||||
exit;
|
||||
Tmp2:=Obj['groups'];
|
||||
if Not isObject(Tmp) then
|
||||
exit;
|
||||
Res:=lGroups[aName];
|
||||
if Not isArray(Res) then
|
||||
exit;
|
||||
Result[0]:=Integer(Arr2[0]);
|
||||
Result[1]:=Integer(Arr2[1]);
|
||||
end;
|
||||
|
||||
procedure TWasmRegexp.GetGroupNames;
|
||||
|
||||
|
||||
var
|
||||
Tmp : JSValue;
|
||||
|
||||
begin
|
||||
if Not HaveResult then
|
||||
Exit;
|
||||
Tmp:=FRes['groups'];
|
||||
if Not isObject(Tmp) then
|
||||
exit;
|
||||
FGroupNames:=TJSObject.getOwnPropertyNames(TJSObject(Tmp));
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetGroupCount : Integer;
|
||||
begin
|
||||
Result:=0;
|
||||
if Not HaveResult then
|
||||
Exit;
|
||||
If Length(FGroupNames)=0 then
|
||||
GetGroupNames;
|
||||
Result:=Length(FGroupNames);
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetGroupName(aIndex: Integer): String;
|
||||
begin
|
||||
if (aIndex>=0) and (aIndex<Length(FGroupNames)) then
|
||||
Result:=FGroupNames[aIndex]
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
function TWasmRegexp.GetGroupValue(const aName: String): String;
|
||||
var
|
||||
Tmp : JSValue;
|
||||
lGroups : TJSObject absolute Tmp;
|
||||
Res : JSValue;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
Tmp:=FRes['groups'];
|
||||
if isObject(Tmp) then
|
||||
begin
|
||||
Res:=lGroups[aName];
|
||||
if isString(Res) then
|
||||
Result:=String(Res);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TWasmRegExpAPI }
|
||||
|
||||
function TWasmRegExpAPI.RegExpAllocate(aExpr: PByte; aExprLen: longint; aFlags: Longint; aID: PWasmRegExpID): TWasmRegexpResult;
|
||||
var
|
||||
lRegexp,lFlags : String;
|
||||
Regex : TJSRegexp;
|
||||
lID : TWasmRegexpID;
|
||||
|
||||
begin
|
||||
lRegExp:=env.GetUTF8StringFromMem(aExpr,aExprLen);
|
||||
lFlags:=FlagsToString(aFlags);
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Allocate("%s","%s",[%x])',[lRegExp,lFlags,aID]);
|
||||
{$ENDIF}
|
||||
if (lRegexp='') then
|
||||
Exit(WASMRE_RESULT_NO_REGEXP);
|
||||
lID:=GetNextID;
|
||||
try
|
||||
Regex:=TJSRegExp.New(lRegExp,lFlags);
|
||||
except
|
||||
Exit(WASMRE_RESULT_ERROR);
|
||||
end;
|
||||
FRegexps[IntToStr(lID)]:=TWasmRegexp.Create(Regex,lID);
|
||||
env.SetMemInfoInt32(aID,lID);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Allocate("%s","%s",[%x]) => %d',[lRegexp,lFlags,aID,lID]);
|
||||
{$ENDIF}
|
||||
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpDeallocate(aExprID: TWasmRegExpID): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Deallocate(%d)',[aExprID]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID)
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpExec(aExprID: TWasmRegExpID; aString: PByte; aStringLen: Longint; aIndex: PLongint;
|
||||
aResultCount: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
S:=Env.GetUTF8StringFromMem(aString,aStringLen);
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Exec(%d,"%s",[%x],[%x])',[aExprID,S,aIndex,aResultCount]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
try
|
||||
lRegExp.Exec(S);
|
||||
except
|
||||
Exit(WASMRE_RESULT_ERROR);
|
||||
end;
|
||||
Env.SetMemInfoInt32(aIndex,lRegexp.ResultIndex);
|
||||
Env.SetMemInfoInt32(aResultCount,lRegexp.ResultMatchCount);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpTest(aExprID: TWasmRegExpID; aString: PByte; aStringLen: Longint; aResult: PLongint
|
||||
): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
B : Boolean;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
S:=Env.GetUTF8StringFromMem(aString,aStringLen);
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Exec(%d,"%s",[%x])',[aExprID,S,aResult]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
try
|
||||
B:=lRegExp.Test(S);
|
||||
except
|
||||
Exit(WASMRE_RESULT_ERROR);
|
||||
end;
|
||||
Env.SetMemInfoInt32(aResult,Ord(B));
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetFlags(aExprID: TWasmRegExpID; aFlags: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
lFlags : Longint;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetFlags(%d,[%x])',[aExprID,aFlags]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
lFlags:=StringToFlags(lRegexp.RegExp.Flags);
|
||||
Env.SetMemInfoInt32(aFlags,lFLags);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetExpression(aExprID: TWasmRegExpID; aExp: PByte; aExpLen: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
lOldLen,lLen : Integer;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetExpression(%d,[%x],[%x])',[aExprID,aExp,aExpLen]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
lOldLen:=Env.GetMemInfoInt32(aExpLen);
|
||||
lLen:=Env.SetUTF8StringInMem(aExp,lOldLen,lRegexp.RegExp.Source);
|
||||
Env.SetMemInfoInt32(aExpLen,abs(lLen));
|
||||
if lLen<0 then
|
||||
Exit(WASMRE_RESULT_NO_MEM);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetLastIndex(aExprID: TWasmRegExpID; aLastIndex: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.Deallocate(%d)',[aExprID]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
Env.SetMemInfoInt32(aLastIndex,lRegexp.RegExp.lastIndex);
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetResultMatch(aExprID: TWasmRegExpID; aIndex: Longint; Res: PByte; ResLen: PLongint
|
||||
): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
S : String;
|
||||
lOldLen,lLen : Integer;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetResultMatch(%d,%d,[%x],[%x])',[aExprID,aIndex,Res,ResLen]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
if (aIndex<0) or (aIndex>=lRegExp.ResultMatchCount) then
|
||||
Exit(WASMRE_RESULT_INVALIDIDX);
|
||||
S:=lRegExp.GetMatch(aIndex);
|
||||
lOldLen:=Env.GetMemInfoInt32(ResLen);
|
||||
lLen:=Env.SetUTF8StringInMem(Res,lOldLen,S);
|
||||
Env.SetMemInfoInt32(ResLen,abs(lLen));
|
||||
if lLen<0 then
|
||||
Exit(WASMRE_RESULT_NO_MEM);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetGroupCount(aExprID: TWasmRegExpID; aCount: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetGroupCount(%d,[%x])',[aExprID,aCount]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
Env.SetMemInfoInt32(aCount,lRegexp.GetGroupCount);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetGroupName(aExprID: TWasmRegExpID; aIndex: Longint; aName: PByte; aNameLen: PLongint
|
||||
): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
S : String;
|
||||
lOldLen,lLen : Integer;
|
||||
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetGroupName(%d,%d,[%x],[%x])',[aExprID,aIndex,aName,aNameLen]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
if (aIndex<0) or (aIndex>=lRegExp.GetGroupCount) then
|
||||
Exit(WASMRE_RESULT_INVALIDIDX);
|
||||
S:=lRegExp.GetGroupName(aIndex);
|
||||
lOldLen:=Env.GetMemInfoInt32(aNameLen);
|
||||
lLen:=Env.SetUTF8StringInMem(aName,lOldLen,S);
|
||||
Env.SetMemInfoInt32(aNameLen,abs(lLen));
|
||||
if lLen<0 then
|
||||
Exit(WASMRE_RESULT_NO_MEM);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetNamedGroup(aExprID: TWasmRegExpID; aName: PByte; aNameLen: Longint; aValue: PByte;
|
||||
aValueLen: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
lName,S : String;
|
||||
lOldLen,lLen : Integer;
|
||||
|
||||
begin
|
||||
lName:=Env.GetUTF8StringFromMem(aName,aNameLen);
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetNamedGroup(%d,"%s",[%x],[%x])',[aExprID,lName,aValue,aValueLen]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
S:=lRegExp.GetGroupValue(lName);
|
||||
lOldLen:=Env.GetMemInfoInt32(aValueLen);
|
||||
lLen:=Env.SetUTF8StringInMem(aValue,lOldLen,S);
|
||||
Env.SetMemInfoInt32(aValueLen,abs(lLen));
|
||||
if lLen<0 then
|
||||
Exit(WASMRE_RESULT_NO_MEM);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetIndexes(aExprID: TWasmRegExpID; aIndex: Longint; aStartIndex: PLongint; aStopIndex: PLongint
|
||||
): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
Indexes : TIndexArray;
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.GetIndexes(%d,%d,[%x],[%x])',[aExprID,aIndex,aStartIndex,AStopIndex]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
if pos('d',lRegExp.RegExp.Flags)=0 then
|
||||
Exit(WASMRE_RESULT_NOINDEXES);
|
||||
if (aIndex<0) or (aIndex>=lRegExp.ResultMatchCount) then
|
||||
Exit(WASMRE_RESULT_INVALIDIDX);
|
||||
Indexes:=lRegExp.GetMatchIndexes(aIndex);
|
||||
Env.SetMemInfoInt32(aStartIndex,Indexes[0]);
|
||||
Env.SetMemInfoInt32(aStopIndex,Indexes[1]);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.RegExpGetNamedGroupIndexes(aExprID: TWasmRegExpID; aName: PByte; aNameLen: Integer; aStartIndex: PLongint;
|
||||
aStopIndex: PLongint): TWasmRegexpResult;
|
||||
|
||||
var
|
||||
lRegExp : TWasmRegExp;
|
||||
Indexes : TIndexArray;
|
||||
lName : String;
|
||||
|
||||
begin
|
||||
lName:=Env.GetUTF8StringFromMem(aName,aNameLen);
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If LogAPICalls then
|
||||
LogCall('RegExp.RegExp.GetIndexes(%d,"%s",[%x],[%x])',[aExprID,lName,aStartIndex,AStopIndex]);
|
||||
{$ENDIF}
|
||||
lRegExp:=FindRegExp(aExprID);
|
||||
if lRegExp=Nil then
|
||||
Exit(WASMRE_RESULT_INVALIDID);
|
||||
Indexes:=lRegExp.GetGroupIndexes(lName);
|
||||
Env.SetMemInfoInt32(aStartIndex,Indexes[0]);
|
||||
Env.SetMemInfoInt32(aStopIndex,Indexes[1]);
|
||||
Result:=WASMRE_RESULT_SUCCESS;
|
||||
end;
|
||||
|
||||
constructor TWasmRegExpAPI.Create(aEnv: TPas2JSWASIEnvironment);
|
||||
begin
|
||||
inherited Create(aEnv);
|
||||
FRegExps:=TJSObject.new;
|
||||
end;
|
||||
|
||||
procedure TWasmRegExpAPI.DoError(const Msg: String);
|
||||
begin
|
||||
Console.Error(Msg);
|
||||
end;
|
||||
|
||||
procedure TWasmRegExpAPI.DoError(const Fmt: String; const Args: array of const);
|
||||
begin
|
||||
Console.Error(Format(Fmt,Args));
|
||||
end;
|
||||
|
||||
procedure TWasmRegExpAPI.LogCall(const Msg: String);
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If not LogAPICalls then exit;
|
||||
Writeln(Msg);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TWasmRegExpAPI.LogCall(const Fmt: String; const Args: array of const);
|
||||
begin
|
||||
{$IFNDEF NOLOGAPICALLS}
|
||||
If not LogAPICalls then exit;
|
||||
Writeln(Format(Fmt,Args));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.GetNextID: TWasmRegExpID;
|
||||
begin
|
||||
Inc(FNextID);
|
||||
Result:=FNextID;
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.FindRegExp(aID: TWasmRegExpID): TWasmRegexp;
|
||||
var
|
||||
Value : JSValue;
|
||||
|
||||
begin
|
||||
Value:=FRegExps[IntToStr(aID)];
|
||||
if isObject(Value) then
|
||||
Result:=TWasmRegexp(Value)
|
||||
else
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
procedure TWasmRegExpAPI.FillImportObject(aObject: TJSObject);
|
||||
begin
|
||||
AObject[regexpFN_Allocate]:=@RegExpAllocate;
|
||||
AObject[regexpFN_DeAllocate]:=@RegExpDeallocate;
|
||||
AObject[regexpFN_Exec]:=@RegExpExec;
|
||||
AObject[regexpFN_Test]:=@RegExpTest;
|
||||
AObject[regexpFN_GetFlags]:=@RegExpGetFlags;
|
||||
AObject[regexpFN_GetExpression]:=@RegExpGetExpression;
|
||||
AObject[regexpFN_GetLastIndex]:=@RegExpGetLastIndex;
|
||||
AObject[regexpFN_GetResultMatch]:=@RegExpGetResultMatch;
|
||||
AObject[regexpFN_GetGroupCount]:=@RegExpGetGroupCount;
|
||||
AObject[regexpFN_GetGroupName]:=@RegExpGetGroupName;
|
||||
AObject[regexpFN_GetNamedGroup]:=@RegExpGetNamedGroup;
|
||||
AObject[regexpFN_GetIndexes]:=@RegExpGetIndexes;
|
||||
AObject[regexpFN_GetNamedGroupIndexes]:=@RegExpGetNamedGroupIndexes;
|
||||
|
||||
end;
|
||||
|
||||
function TWasmRegExpAPI.ImportName: String;
|
||||
begin
|
||||
Result:=regexpExportName;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
133
packages/wasm-utils/src/wasm.regexp.shared.pp
Normal file
133
packages/wasm-utils/src/wasm.regexp.shared.pp
Normal file
@ -0,0 +1,133 @@
|
||||
unit wasm.regexp.shared;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
Type
|
||||
TWasmRegexpID = Longint;
|
||||
TWasmRegexpResult = Longint;
|
||||
{$IFNDEF PAS2JS}
|
||||
TWasmPointer = Pointer;
|
||||
PWasmRegexpID = ^TWasmRegexpID;
|
||||
{$ELSE}
|
||||
TWasmPointer = Longint;
|
||||
PWasmRegexpID = TWasmPointer;
|
||||
{$ENDIF}
|
||||
|
||||
Const
|
||||
|
||||
WASMRE_RESULT_SUCCESS = 0;
|
||||
WASMRE_RESULT_ERROR = -1;
|
||||
WASMRE_RESULT_INVALIDID = -2;
|
||||
WASMRE_RESULT_NO_MEM = -3;
|
||||
WASMRE_RESULT_NO_REGEXP = -4;
|
||||
WASMRE_RESULT_INVALIDIDX = -5;
|
||||
WASMRE_RESULT_NOINDEXES = -6;
|
||||
|
||||
WASMRE_FLAG_DOTALL = 1;
|
||||
WASMRE_FLAG_GLOBAL = 2;
|
||||
WASMRE_FLAG_INDICES = 4;
|
||||
WASMRE_FLAG_IGNORECASE = 8;
|
||||
WASMRE_FLAG_MULTILINE = 16;
|
||||
WASMRE_FLAG_STICKY = 32;
|
||||
WASMRE_FLAG_UNICODE = 64;
|
||||
WASMRE_FLAG_UNICODESETS = 128;
|
||||
|
||||
// Aliases that correspond to the letters used when creating a regexp
|
||||
WASMRE_FLAG_S = WASMRE_FLAG_DOTALL;
|
||||
WASMRE_FLAG_G = WASMRE_FLAG_GLOBAL;
|
||||
WASMRE_FLAG_D = WASMRE_FLAG_INDICES;
|
||||
WASMRE_FLAG_I = WASMRE_FLAG_IGNORECASE;
|
||||
WASMRE_FLAG_M = WASMRE_FLAG_MULTILINE;
|
||||
WASMRE_FLAG_Y = WASMRE_FLAG_STICKY;
|
||||
WASMRE_FLAG_U = WASMRE_FLAG_UNICODE;
|
||||
WASMRE_FLAG_V = WASMRE_FLAG_UNICODESETS;
|
||||
|
||||
regexpExportName = 'regexp';
|
||||
regexpFN_Allocate = 'allocate';
|
||||
regexpFN_DeAllocate = 'deallocate';
|
||||
regexpFN_Exec = 'exec';
|
||||
regexpFN_Test = 'test';
|
||||
regexpFN_GetFlags = 'get_flags';
|
||||
regexpFN_GetExpression = 'get_expression';
|
||||
regexpFN_GetLastIndex = 'get_last_index';
|
||||
regexpFN_GetResultMatch = 'get_result_match';
|
||||
regexpFN_GetGroupCount = 'get_group_count';
|
||||
regexpFN_GetGroupName = 'get_group_name';
|
||||
regexpFN_GetNamedGroup = 'get_named_group';
|
||||
regexpFN_GetIndexes = 'get_indexes';
|
||||
regexpFN_GetNamedGroupIndexes = 'get_named_group_indexes';
|
||||
|
||||
Function StringToFlags(S : String; IgnoreUnknown : Boolean = True) : Longint;
|
||||
Function FlagsToString(S : Longint) : String;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{$IFDEF FPC_DOTTEDUNITS}
|
||||
System.SysUtils;
|
||||
{$ELSE}
|
||||
SysUtils;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
Function StringToFlags(S : String; IgnoreUnknown : Boolean = True) : Longint;
|
||||
|
||||
var
|
||||
C : Char;
|
||||
Flag : Longint;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
for C in S do
|
||||
begin
|
||||
case C of
|
||||
's': Flag:=WASMRE_FLAG_S;
|
||||
'g': Flag:=WASMRE_FLAG_G;
|
||||
'd': Flag:=WASMRE_FLAG_D;
|
||||
'i': Flag:=WASMRE_FLAG_I;
|
||||
'm': Flag:=WASMRE_FLAG_M;
|
||||
'y': Flag:=WASMRE_FLAG_Y;
|
||||
'u': Flag:=WASMRE_FLAG_U;
|
||||
'v': Flag:=WASMRE_FLAG_V;
|
||||
else
|
||||
if not IgnoreUnknown then
|
||||
Raise EConvertError.CreateFmt('Unknown regexp flag: %s',[C]);
|
||||
Flag:=0;
|
||||
end;
|
||||
Result:=Result or Flag;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function FlagsToString(S : Longint) : String;
|
||||
|
||||
var
|
||||
C,I : Longint;
|
||||
Flag : Char;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
for I:=0 to 7 do
|
||||
begin
|
||||
C:=S and (1 shl i);
|
||||
case C of
|
||||
WASMRE_FLAG_S : Flag:='s';
|
||||
WASMRE_FLAG_G : Flag:='g';
|
||||
WASMRE_FLAG_D : Flag:='d';
|
||||
WASMRE_FLAG_I : Flag:='i';
|
||||
WASMRE_FLAG_M : Flag:='m';
|
||||
WASMRE_FLAG_Y : Flag:='y';
|
||||
WASMRE_FLAG_U : Flag:='u';
|
||||
WASMRE_FLAG_V : Flag:='v';
|
||||
else
|
||||
Flag:='0';
|
||||
end;
|
||||
if Flag<>'0' then
|
||||
Result:=Result + Flag;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user