From: Ina C. <in...@st...> - 2001-01-30 23:53:52
|
Hi Tyson, As I've mentioned there are 2 bugs in the program. The first one is with dynamic linking, all the procedure calls have to be predicates but not functions (see GetStockPrice for example in the code). The error is: Uncaught exception: Software Error: dl__mercury_sym: result type is not a higher-order type The second one is I can't change HelloPred to accept any arguments. The error is: *** Mercury runtime: caught segmentation violation *** PC at signal: 1074572806 (400cae06) address involved: 0x40017de8 This may have been caused by a stack overflow, due to unbounded recursion. exiting from signal handler Can you please take a look at it? To reproduce the error, please check out the modules from quicksilver, and combine with the following diff. Then under the /webserver directory, run mmake GRADE=hlc.par.gc depend mmake GRADE=hlc.par.gc I've attached 2 files to test the program. The first one is for testing hello pred and the other one is for testing GetStockPrice. Thanks in advance. Ina <in...@st...> ==================================================================== ? data ? temp ? server ? data3 ? test ? data1 ? data2 ? schema ? soap_test_methods.init ? Jan30-web_methods.m Index: server.m =================================================================== RCS file: /cvsroot/quicksilver/webserver/server/server.m,v retrieving revision 1.5 diff -u -r1.5 server.m --- server.m 2001/01/25 06:54:42 1.5 +++ server.m 2001/01/30 23:36:12 @@ -1,5 +1,5 @@ %---------------------------------------------------------------------------% -% Copyright (C) 2000 Peter Ross +% Copyright (C) 2000, 2001 Peter Ross % This file may only be copied under the terms of the GNU General Public % License - see the file COPYING %-----------------------------------------------------------------------------% @@ -82,7 +82,16 @@ { RequestOrResponse = left(Request) }, ( { Request^cmd = post }, - get_soapmessage(TCP, Request, Request1) + { check_headers(Request^headers, MayBeError) }, + ( + { MayBeError = yes(ErrorResponse) } + -> + send_response(TCP, ErrorResponse), + tcp__shutdown(TCP), + { error("Invalid HTTP headers in request.\n") } + ; + get_soapmessage(TCP, Request, Request1) + ) ; { Request^cmd = get }, { Request1 = Request } @@ -226,6 +235,67 @@ %---------------------------------------------------------------------------% + % Section 6 Using SOAP in HTTP + % " HTTP applications MUST use the media type "text/xml" + % according to RFC 2376 when including SOAP entity bodies + % in HTTP messages. + % + % Section 6.1.1. The SOAPAction HTTP Header Field + % " An HTTP client MUST use this header field when issuing a + % SOAP HTTP Request. " + + +:- pred check_headers(list(header)::in, maybe(response)::out) is det. + +check_headers(Headers, Response) :- + check_each_header(Headers, soapaction_header, + "SOAPAction header not found.\n", MayBeResponse0), + ( + MayBeResponse0 = no + -> + check_each_header(Headers, content_type_header, + "Incorrect Content-Type value.\n", MayBeResponse1), + ( + MayBeResponse1 = no + -> + Response = no + ; + Response = MayBeResponse1 + ) + ; + Response = MayBeResponse0 + ). + +:- pred check_each_header(list(header), pred(header), string, maybe(response)). +:- mode check_each_header(in, pred(in) is semidet, in, out) is det. + +check_each_header(Headers, Pred, ErrorMessage, Response) :- + list__filter(Pred, Headers, Result), + ( + Result \= [] + -> + Response = no + ; + Response = yes(response( + 400, + [], + string_body(ErrorMessage), + yes ) + ) + + ). + +:- pred soapaction_header(header::in) is semidet. +soapaction_header(header("SOAPAction:", _, _)). + +:- pred content_type_header(header::in) is semidet. +content_type_header(header("Content-Type:", "text/xml", _)). +content_type_header(header("Content-type:", "text/xml", _)). +content_type_header(header("Content-Type:", "text/xml;", _)). +content_type_header(header("Content-type:", "text/xml;", _)). + +%---------------------------------------------------------------------------% + :- pred get_soapmessage(S, request, request, io__state, io__state) <= stream__duplex(S). :- mode get_soapmessage(in, in, out, di, uo) is det. @@ -243,7 +313,17 @@ yes(string__from_char_list(SoapMessage)) ) } ; - { error("No content-length supplied. Program Terminated.") } + { ErrorResponse = response( + 411, + [], + string_body("Content-Length not supplied.\n"), + yes) }, + send_response(S, ErrorResponse), + + % XXX how to convert S back to tcp such that + % tcp__shutdown(S) can be called ? + + { error("Content-Length not supplied in request.") } ). :- pred get_content_length(list(header)::in, int::out) is semidet. @@ -268,13 +348,12 @@ is_content_type("Content-type:"). :- pred get_body(S, int, list(char), io__state, io__state) - <= stream__duplex(S). + <= stream__input(S). :- mode get_body(in, in, out, di, uo) is det. -% XXX if there are still characters when length = 0 -% the rest will not be obtained and consequently parsing -% an incomplete message will throw an exception. - + % If there are still characters when length = 0, + % the rest will not be obtained and consequently parsing + % an incomplete message will throw an exception. get_body(S, Length, RequestLines) --> stream__read_char(S, CharResult), { Length0 = Length - 1 }, @@ -334,9 +413,14 @@ ) ; { Request^cmd = post }, + write(uri_to_filename(Request^uri)), nl, ( { Request^body = yes(Body) } , parse_soapmessage(Body, NsBody), + + % parse_soapmessage calls error/1 when failed + % should change to response with http code = 415 + write(NsBody), nl, nl, { get_procedure_call(NsBody, Proc) }, @@ -345,12 +429,12 @@ { make_web_request(NsBody, Proc, WebRequest) }, write(WebRequest), nl, nl, - load_dynamic_library("./libsoap_test_methods.so", + load_dynamic_library(uri_to_filename(Request^uri), WebRequest, Result, HttpCode), ( - { Result = yes(Output) }, + { Result = yes(OutputString) }, { generate_response_body(NsBody, Proc, - Output, ResBody0) }, + OutputString, ResBody0) }, { ResBody = string_body(ResBody0) } ; { Result = no }, @@ -363,7 +447,7 @@ { ResBody = no_body }, { HttpCode = 400 } ), - { list__filter(filter, Request^headers, Headers) }, + { generate_headers(Request^headers, ResBody, Headers) }, { Response = response(HttpCode, Headers, ResBody, yes) } ). @@ -380,9 +464,24 @@ last_char(Str) = string__unsafe_index(Str, string__length(Str) - 1). +:- pred generate_headers(list(header)::in, response_body::in, + list(header)::out) is det. +generate_headers(RequestHeaders, ResBody, Headers) :- + list__filter(filter, RequestHeaders, Headers0), + ( + ResBody = string_body(Body), + string__length(Body, BodyLength), + string__int_to_string(BodyLength, StringLength), + ConLen = [header("Content-Length:", StringLength, no)], + list__append(ConLen, Headers0, Headers) + ; + ResBody = no_body, + Headers = Headers0 + ). + :- pred filter(header::in) is semidet. -filter(header("Content-Length:", _, _)). filter(header("Content-Type:", _, _)). +filter(header("Content-type:", _, _)). %-----------------------------------------------------------------------------% Index: soap.m =================================================================== RCS file: /cvsroot/quicksilver/webserver/server/soap.m,v retrieving revision 1.1 diff -u -r1.1 soap.m --- soap.m 2001/01/25 06:54:42 1.1 +++ soap.m 2001/01/30 23:36:12 @@ -78,6 +78,9 @@ { Res = ok((_, Doc)) }, { nsTranslate(Doc, NsDoc) } ; + % instead of error, should change to response + % with http code 415 Unsupported Media Type + { Res = error(Err) }, { string__append("parse_soapmessage failed: ", Err, ErrMsg) }, { error(ErrMsg) } @@ -130,12 +133,13 @@ % Gets method name. get_procedure_call(NsDoc, Procedure) :- get_procedure(NsDoc, [], Procedurelist), - get_first_element(Procedurelist, Procedure). - -:- pred get_first_element(list(T)::in, T::out) is det. + list__index1_det(Procedurelist, 1, Procedure). + % get_first_element(Procedurelist, Procedure). -get_first_element([], _) :- error("Procedure not found."). -get_first_element([H|_], H). +% :- pred get_first_element(list(T)::in, T::out) is det. +% +% get_first_element([], _) :- error("Procedure not found."). +% get_first_element([H|_], H). :- pred get_procedure(nsDocument, list(nsElement), list(nsElement)). :- mode get_procedure(in, in, out) is det. @@ -411,10 +415,6 @@ Acc0, Acc1), call(Pred, ContentArray, Ref, Method, Result, URIs, Acc1, Acc). - -% :- pred insert_last(list(T)::in, T::in, list(T)::out) is det. -% insert_last([], T, [T]). -% insert_last([ :- pred my_delete(list(T)::in, list(T)::out) is det. my_delete([], []). Index: soap_test_methods.m =================================================================== RCS file: /cvsroot/quicksilver/webserver/server/soap_test_methods.m,v retrieving revision 1.1 diff -u -r1.1 soap_test_methods.m --- soap_test_methods.m 2001/01/25 06:54:42 1.1 +++ soap_test_methods.m 2001/01/30 23:36:12 @@ -23,14 +23,30 @@ :- interface. :- import_module io, int, list, std_util. -:- pred hello(state::di, state::uo) is det. +%:- pred hello(list(univ)::in, univ::out) is det. +%:- pred hello(univ::out) is det. +:- pred hello(io__state::di, io__state::uo) is det. :- pred get_sp(list(univ)::in, univ::out) is det. :- func get_stockprice(list(univ)) = univ. -:- pred get_bookprice(list(univ)::in, univ::out) is det. +:- pred get_bookprice(list(univ)::in, univ::out, io__state::di, + io__state::uo) is det. +:- type book + ---> book( + title :: string, + author :: author, + intro :: string + ). + +:- type author + ---> author( + surname :: string, + firstname :: string + ). + %---------------------------------------------------------------------% :- implementation. @@ -50,8 +66,11 @@ %---------------------------------------------------------------------% % Hello %---------------------------------------------------------------------% + +hello --> print("Hello, world"). -hello --> print("Hello, world\n"). +% hello(_List, ResultAsUniv) :- +% ResultAsUniv = univ("<output>Hello, world</output>"). %---------------------------------------------------------------------% % GetStockPrice @@ -88,7 +107,9 @@ % GetBookPrice %---------------------------------------------------------------------% -get_bookprice(ParamList, ResultAsUniv) :- - ResultAsUniv = univ(100). +get_bookprice(ParamList, ResultAsUniv) --> + { list__index1_det(ParamList, 1, Param) }, + write(Param), + { ResultAsUniv = univ(100) }. Index: web_methods.m =================================================================== RCS file: /cvsroot/quicksilver/webserver/server/web_methods.m,v retrieving revision 1.1 diff -u -r1.1 web_methods.m --- web_methods.m 2001/01/25 06:54:42 1.1 +++ web_methods.m 2001/01/30 23:36:12 @@ -42,14 +42,7 @@ pFields :: maybe(list(parameter)) % Struct or Array ). -/* Ignore this - % Converts method name and parameters in xml.ns format to - % a web request. -:- pred make_web_request(nsElement, list(parameter), web_method_request). -:- mode make_web_request(in, in, out) is det. -*/ - % Loads library, invokes method call and generates corresponding % response. :- pred load_dynamic_library(string::in, web_method_request::in, @@ -63,71 +56,11 @@ :- implementation. :- import_module bool, int, require. :- import_module dl, name_mangle, soap_test_methods. - - % XXX change that to command line argument -:- func soap_library_file = string. -soap_library_file = "soap_test_methods". - -/* Ignore this. Not used anymore - - % Generates a web request using method and parameters -make_web_request(Proc, Params, Request) :- - Request^name = Proc^eName^localName, - Request^uri = Proc^eName^nsURI, - Request^params = Params. - -make_web_request(Proc, Params, Request) :- - Request^name = Proc^eName^localName, - Request^uri = Proc^eName^nsURI, - form_pair(Params, ParamsPair), - list__map(retrieve_params, ParamsPair, Request^params). - - % Transform parameter list from [parameter, data, parameter, data ..] - % to [(parameter - data)] to distinguish elements -:- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))). -:- mode form_pair(in, out) is det. -form_pair(ParamList , PairList) :- - ( - ParamList = [] - -> - PairList = [] - ; - ParamList = [Param, Data | Tail] - % list__split_list(2, ParamList, Start, End), - % Start = [Param, Data] - -> - PairList = [(Param - Data) | PairList0], - form_pair(Tail, PairList0) - ; - error("Incorrect Data Format") - ). +% :- func soap_library_file = string. +% soap_library_file = "soap_test_methods". - % Retrieve parameter name, uri, type if defined and data value. -:- pred retrieve_params(pair(nsContent, nsContent), parameter). -:- mode retrieve_params(in, out) is det. - -retrieve_params((Param0 - Data), Parameter) :- - ( - Param0 = nsElement(Param), - Data = data(Value) - -> - Name = Param^eName^localName, - URI = Param^eName^nsURI, - ( - search_attributes(Param^eAttrs, Type0) - -> - Type = yes(Type0) - ; - Type = no - ), - Parameter = parameter(Name, Type, Value, URI) - ; - error("Incorrect Data Format") - ). -*/ - % Types in XML can be defined either by using xsi:type attribute % or by using schema. This predicate is used to search if % any attribute contains `xsi:type'. @@ -172,8 +105,12 @@ % Opens library file, invokes desire function, and gets back % corresponding response and http code. -load_dynamic_library(L, Request, Response, HttpCode) --> - dl__open(L, lazy, local, MaybeHandle), + % + % LibFile format = "./libfilename.so" + % +load_dynamic_library(LibFile, Request, Response, HttpCode) --> + dl__open(LibFile, lazy, local, MaybeHandle), + { get_filename(LibFile, Filename) }, ( { MaybeHandle = error(OpenMsg) }, { string__append("dlopen failed: ", OpenMsg, OpenErrorMsg) }, @@ -185,17 +122,20 @@ % Hello has no parameter { Request^name = "Hello" } -> - call_Hello_pred(Handle, Request, Response0, HttpCode0) + call_Hello_pred(Handle, Filename, Request, + Response0, HttpCode0) ; % GetStockPrice has 1 parameter { Request^name = "GetStockPrice" } -> - call_SP_func(Handle, Request, Response0, HttpCode0) + call_SP_func(Handle, Filename, Request, + Response0, HttpCode0) ; % GetBookPrice takes in a struct { Request^name = "GetBookPrice" } -> - call_BP_pred(Handle, Request, Response0, HttpCode0) + call_BP_pred(Handle, Filename, Request, + Response0, HttpCode0) ; { Response0 = yes("Method requested not implemented.") }, @@ -232,12 +172,12 @@ % Hello %-----------------------------------------------------------------------% -:- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code, - io__state, io__state). -:- mode call_Hello_pred(in, in, out, out, di, uo) is det. +:- pred call_Hello_pred(handle, string, web_method_request, maybe(string), + http_code, io__state, io__state). +:- mode call_Hello_pred(in, in, in, out, out, di, uo) is det. -call_Hello_pred(Handle, _Request, Response, HttpCode) --> - { HelloProc = mercury_proc(predicate, unqualified(soap_library_file), +call_Hello_pred(Handle, Filename, _Request, Response, HttpCode) --> + { HelloProc = mercury_proc(predicate, unqualified(Filename), "hello", 2, 0) }, dl__mercury_sym(Handle, HelloProc, MaybeHello), ( @@ -256,7 +196,25 @@ % we just obtained. HelloPred, - { Response = yes("<output>Hello World</output>") }, + % XXX error occurs + % if change hello(io__state::di, io__state::uo) is det + % to hello(univ::out) is det or + % hello(list(univ)::in, univ::out) is det ???? + +/* +This is the same error that I have for the MLDS closure problem + +*** Mercury runtime: caught segmentation violation *** +PC at signal: 1074572806 (400cae06) +address involved: 0x40017de8 +This may have been caused by a stack overflow, due to unbounded recursion. +exiting from signal handler +*/ + % { HelloPred([], HelloUniv) }, + % { det_univ_to_type(HelloUniv, HelloString) }, + + { HelloString = "<output>Hello, world</output>" }, + { Response = yes(HelloString) }, { HttpCode = 200 } ). @@ -264,32 +222,43 @@ % We need to cast it to the right higher-order inst, which for the % `hello' procedure is `pred(di, uo) is det', before we can actually % call it. The function inst_cast_hello/1 defined below does that. + +% :- type hello_pred == pred(univ). +% :- inst hello_pred == (pred(out) is det). -:- type io_pred == pred(io__state, io__state). -:- inst io_pred == (pred(di, uo) is det). +:- type hello_pred == pred(io__state, io__state). +:- inst hello_pred == (pred(di, uo) is det). -:- func inst_cast_hello(io_pred) = io_pred. -:- mode inst_cast_hello(in) = out(io_pred) is det. -:- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)), +:- func inst_cast_hello(hello_pred) = hello_pred. +:- mode inst_cast_hello(in) = out(hello_pred) is det. +:- pragma c_code(inst_cast_hello(X::in) = (Y::out(hello_pred)), [will_not_call_mercury, thread_safe], "Y = X"). %-----------------------------------------------------------------------% % GetStockPrice %-----------------------------------------------------------------------% + +:- pred call_SP_func(handle, string, web_method_request, maybe(string), + http_code, io__state, io__state). +:- mode call_SP_func(in, in, in, out, out, di, uo) is det. + + % XXX error occurs for function but not for predicate +/* -:- pred call_SP_func(handle, web_method_request, maybe(string), http_code, - io__state, io__state). -:- mode call_SP_func(in, in, out, out, di, uo) is det. +Uncaught exception: +Software Error: dl__mercury_sym: result type is not a higher-order type -call_SP_func(Handle, Request, Response, HttpCode) --> +*/ + +call_SP_func(Handle, Filename, Request, Response, HttpCode) --> { list__length(Request^params, Arity) }, % XXX test for function - % { GetSPProc = mercury_proc(function, unqualified(soap_library_file), + % { GetSPProc = mercury_proc(function, unqualified(Filename), % "get_stockprice", Arity, 0) }, % XXX test for predicate - { GetSPProc = mercury_proc(predicate, unqualified(soap_library_file), + { GetSPProc = mercury_proc(predicate, unqualified(Filename), "get_sp", 2, 0) }, dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice), @@ -424,19 +393,20 @@ % schema for GetBookPrice: % % <element name="book" type="tns:book"/> + % <element name="author" base="tns:author"/> + % % <complexType name="book"> % <sequence> - % <element name="title" type="mercury:string"/> + % <element name="title" type="xsd:string"/> % <element name="author" type="tns:author"/> - % <element name="intro" type="mercury:string"/> + % <element name="intro" type="xsd:string"/> % </sequence> % </complexType> % - % <element name="author" base="tns:author"/> % <complexType name="author"> % <sequence> - % <element name"surname" type="mercury:string"/> - % <element name"firstname" type="mercury:string"/> + % <element name"surname" type="xsd:string"/> + % <element name"firstname" type="xsd:string"/> % </sequence> % </complexType> % @@ -455,15 +425,15 @@ % firstname :: string % ). -:- pred call_BP_pred(handle, web_method_request, maybe(string), http_code, - io__state, io__state). -:- mode call_BP_pred(in, in, out, out, di, uo) is det. - -call_BP_pred(Handle, Request, Response, HttpCode) --> - { list__length(Request^params, Arity0) }, - { Arity = Arity0 + 1 }, % since it is a predicate - { GetBPProc = mercury_proc(predicate, unqualified(soap_library_file), - "get_bookprice", Arity, 0) }, +:- pred call_BP_pred(handle, string, web_method_request, maybe(string), + http_code, io__state, io__state). +:- mode call_BP_pred(in, in, in, out, out, di, uo) is det. + +call_BP_pred(Handle, Filename, Request, Response, HttpCode) --> + % { list__length(Request^params, Arity0) }, + % { Arity = Arity0 + 1 }, % since it is a predicate + { GetBPProc = mercury_proc(predicate, unqualified(Filename), + "get_bookprice", 4, 0) }, dl__mercury_sym(Handle, GetBPProc, MaybeGetBookPrice), ( { MaybeGetBookPrice = error(Msg) }, @@ -478,11 +448,14 @@ { BPProc = inst_cast_bp(BPProc0) }, % Convert parameters (string) to the corresponding types - % { list__map(lookup_BP_schema, Request^params, UnivList) }, + % XXX cannot call list__map + % need to use foldl ?? + { list__map(lookup_BP_schema, Request^params, UnivList) }, + % { UnivList = [univ(1)] }, + % Call the procedure whose address we just obtained - { UnivList = [univ(1)] }, - { call(BPProc, UnivList, BPUniv) }, + call(BPProc, UnivList, BPUniv), { det_univ_to_type(BPUniv, BPInt) }, { string__int_to_string(BPInt, BPString) }, @@ -493,65 +466,85 @@ ). -/* still working - -:- pred searchBPList(list(parameter), string, maybe(list(parameter)), - maybe(string)). -:- mode searchBPList(in, in, out, out) is semidet. - -searchBPList(ParamList, ElemName, Struct, Value) :- - Elem = parameter(ElemName, _, _, _, _), - ( - list__nth_member_search(ParamList, Elem, Pos), - list__index1(ParamList, Pos, Param) - -> - Struct = Param^pFields, - Value = Param^pValue - ; - fail - ). - :- pred lookup_BP_schema(parameter::in, univ::out) is det. lookup_BP_schema(Param, ValueAsUniv) :- ( Param^pName = "book", - Param^pFields = yes(StructList), - ( - searchBPList(StructList, "title", Child, Value0), - Child = no, - Value0 = yes(Value) - -> - type_cast_parameter("string", Value, ValueAsUniv) - ; - searchBPList(StructList, "author", Child, _), - Child = yes(ChildStructList) - -> - ( - searchBPList(ChildStructList, "author", _, _ ) - ; - require__error( - "Element Structure not defined in schema.") + Param^pFields = yes(FieldList) + -> + get_BP_param(FieldList, "title", Title0), + lookup_BP_schema(Title0, TitleAsUniv), + + det_univ_to_type(TitleAsUniv, Title), + + get_BP_param(FieldList, "author", Author0), + lookup_BP_schema(Author0, AuthorAsUniv), + det_univ_to_type(AuthorAsUniv, Author), + + get_BP_param(FieldList, "intro", Intro0), + lookup_BP_schema(Intro0, IntroAsUniv), + det_univ_to_type(IntroAsUniv, Intro), - ) - ; - searchBPList(StructList, "intro", Child, Value0), - Child = no, - Value0 = yes(Value) - -> - type_cast_parameter("string", Value, ValueAsUniv) - ; - require__error( - "Element Structure not defined in schema.") - ) + ValueAsBook = book(Title, Author, Intro), + ValueAsUniv = univ(ValueAsBook) + ; + Param^pName = "title", + Param^pValue = yes(Value) + -> + type_cast_parameter("string", Value, ValueAsUniv) ; + Param^pName = "author", + Param^pFields = yes(FieldList) + -> + get_BP_param(FieldList, "surname", Surname0), + lookup_BP_schema(Surname0, SurnameAsUniv), + det_univ_to_type(SurnameAsUniv, Surname), + + get_BP_param(FieldList, "firstname", Firstname0), + lookup_BP_schema(Firstname0, FirstnameAsUniv), + det_univ_to_type(FirstnameAsUniv, Firstname), + + ValueAsAuthor = author(Surname, Firstname), + ValueAsUniv = univ(ValueAsAuthor) + ; + Param^pName = "surname", + Param^pValue = yes(Value) + -> + type_cast_parameter("string", Value, ValueAsUniv) + ; + Param^pName = "firstname", + Param^pValue = yes(Value) + -> + type_cast_parameter("string", Value, ValueAsUniv) + ; + Param^pName = "intro", + Param^pValue = yes(Value) + -> + type_cast_parameter("string", Value, ValueAsUniv) + ; require__error("Element Structure not defined in schema.") ). + +/* +[parameter("book", no, "", no, yes( + [parameter("title", no, "", yes("Hello World"), no), + parameter("author", no, "", no, yes( + [parameter("surname", no, "", yes("Foo"), no), + parameter("firstname", no, "", yes("Bar"), no)])), + parameter("intro", no, "", yes("Introduction"), no)]))], "some uri") */ +:- pred get_BP_param(list(parameter)::in, string::in, parameter::out) is det. + +get_BP_param(ParamList, SearchString, Parameter) :- + list__filter((pred(X::in) is semidet :- + X = parameter(SearchString,_,_,_,_)), ParamList, Result), + list__index1_det(ParamList, 1, Parameter). + % inst cast for get_bookprice -:- type bp_pred == pred(list(univ), univ). -:- inst bp_pred == (pred(in, out) is det). +:- type bp_pred == pred(list(univ), univ, io__state, io__state). +:- inst bp_pred == (pred(in, out, di, uo) is det). :- func inst_cast_bp(bp_pred) = bp_pred. :- mode inst_cast_bp(in) = out(bp_pred) is det. @@ -561,6 +554,14 @@ %-----------------------------------------------------------------------% % Shared functions %-----------------------------------------------------------------------% + + % Returns filename from ./libfilename.so +:- pred get_filename(string::in, string::out) is det. + +get_filename(LibFile, Filename) :- + string__split(LibFile, 5, _Left, Filename0), + string__length(Filename0, Length), + string__left(Filename0, Length-3, Filename). % Separates prefix and suffix. :- pred split_on_colon(string::in, string::out, string::out) is det. |