Примеры использования PL-объектов

Материал из GedeminWiki
Перейти к: навигация, поиск

см. Система логического программирования на встроенном SWI‑Prolog

Содержание


Установка


Выполнение

  • Меню Сервис ⇒ Редактор скрипт объектов...
  • Проводник Глобальные макросы ⇒ Примеры использования PL-объектов
Gd_Examples.png

Результат выполнения отражается в диалоговом окне в виде протокола

Gd_Examples_Msg.png


Описание

Макрос Примеры использования PL-объектов представлен главной процедурой pl_Examples и сопутствующими функциями вида pl_ExampleN, предназначенными для изучения материала из раздела PL-классы. Функции pl_ExampleN выполняются в цикле с записью результата, как части выходного протокола.

В главной процедуре pl_Examples производится создание объекта PL класса TgsPLClient и инициализация встроенного SWI-Prolog.

  1.   Dim PL
  2.   Set PL = Designer.CreateObject(nil, "TgsPLClient", "")
  3.   If Not PL.IsInitialised Then
  4.     If Not PL.Initialise("") Then
  5.       Msg = "Ошибка инициализации SWI-Prolog!"
  6.       Call MsgBox(Msg, vbCritical + vbOkOnly, Title)
  7.       PL.DestroyObject
  8.       Exit Sub
  9.     End If
  10.   End If

Далее объект PL передается ссылочным параметром в каждую из функций примеров.

  1.   Dim FuncIndex, FuncName, FuncBegin, FuncEnd
  2.   FuncName = "pl_Example"
  3.   FuncBegin = 1
  4.   FuncEnd = 8
  5.   For FuncIndex = FuncBegin To FuncEnd
  6.     PL.Debug = False
  7.     Msg = Msg & vbCrLf & _
  8.           Eval(FuncName & FuncIndex & "(PL)")
  9.   Next

При необходимости, можно модифицировать часть кода для изучения меньшего количества примеров, либо отдельно взятого примера.

Контекст использования функций pl_ExampleN
 N  PL-класс Методы, свойства Примечание
1 TgsPLClient Call  
TgsPLTermv PutAtom, ToString  
2 TgsPLClient Call2, Call  
TgsPLTermv PutAtom, ToString  
3 TgsPLClient Compound, Term, Call  
TgsPLTermv PutAtom, ToString  
4 TgsPLClient LoadScriptByName, Call используется Пролог-скрипт pl_Examples_Script
TgsPLTermv ToString  
5 TgsPLClient Debug, LoadScriptByName используется Пролог-скрипт pl_Examples_Script
TgsPLTermv ToString  
TgsPLQuery OpenQuery, Eof, NextSolution, Close, Cut  
6 TgsPLClient LoadScriptByName используется Пролог-скрипт pl_Examples_Script
TgsPLTermv DataType, ReadInteger, ReadAtom, ReadDate, ToString  
TgsPLQuery OpenQuery, Eof, NextSolution, Close  
7 TgsPLClient LoadScriptByName, Debug, MakePredicatesOfSQLSelect используется Пролог-скрипт pl_Examples_Script;
используются данные справочника "Адм.-терр. единицы"
TgsPLTermv PutAtom, ReadString, PutString  
TgsPLQuery OpenQuery, Eof, NextSolution, Close  
8 TgsPLClient LoadScriptByName, ExtractData, MakePredicatesOfDataSet используется Пролог-скрипт pl_Examples_Script
TgsPLTermv PutInteger, ReadInteger, ReadString  
TgsPLQuery OpenQuery, Eof, NextSolution, Close  


Приложение

pl_Examples

см. также pl_Examples_Script, Протокол

  1. Option Explicit
  2.  
  3. Sub pl_Examples()
  4.   Dim Title, Msg, Ret
  5.   Title = "Гедымин - Пролог"
  6.   Msg = _
  7.         "/* Примеры использования PL-объектов */" & vbCrLf & vbCrLf & _
  8.         "%%%%" & vbCrLf & _
  9.         "%    pl_Examples" & vbCrLf & _
  10.         "%      TgsPLClient: Initialise, IsInitialised"
  11.  
  12.   Dim PL
  13.   Set PL = Designer.CreateObject(nil, "TgsPLClient", "")
  14.   If Not PL.IsInitialised Then
  15.     If Not PL.Initialise("") Then
  16.       Msg = "Ошибка инициализации SWI-Prolog!"
  17.       Call MsgBox(Msg, vbCritical + vbOkOnly, Title)
  18.       PL.DestroyObject
  19.       Exit Sub
  20.     End If
  21.   End If
  22.  
  23.   Dim FuncIndex, FuncName, FuncBegin, FuncEnd
  24.   FuncName = "pl_Example"
  25.   FuncBegin = 1
  26.   FuncEnd = 8
  27.   For FuncIndex = FuncBegin To FuncEnd
  28.     PL.Debug = False
  29.     Msg = Msg & vbCrLf & _
  30.           Eval(FuncName & FuncIndex & "(PL)")
  31.   Next
  32.   Msg = Msg & vbCrLf & "%%%%"
  33.   PL.DestroyObject
  34.  
  35.   Dim frmMsg
  36.   Set frmMsg = Designer.CreateObject(nil, "usrf_Msg", "")
  37.  
  38.   frmMsg.Caption = Title
  39.   frmMsg.GetComponent("usrg_Msg").Lines.Text = Msg
  40.   frmMsg.ShowModal
  41.  
  42.   frmMsg.DestroyObject
  43. End Sub
  44.  
  45. Function pl_Example1(ByRef PL)
  46.   Dim Title, Msg
  47.   Title = vbCrLf & _
  48.           "%%" & vbCrLf & _
  49.           "% 1. pl_Example1(PL)" & vbCrLf & _
  50.           "%      TgsPLClient: Call" & vbCrLf & _
  51.           "%      TgsPLTermv: PutAtom, ToString"
  52.  
  53.   pl_Example1 = ""
  54.  
  55.   Dim PredicateName, Params
  56.   PredicateName = "current_prolog_flag"
  57.   Set Params = Designer.CreateObject(2, "TgsPLTermv", "")
  58.   Params.PutAtom 0, "executable"
  59.  
  60.   Msg = _
  61.     "% Запрос" & vbCrLf & _
  62.     "?- " & PredicateName & "(" & Params.ToString(0) & ", AppPath)."
  63.  
  64.   If PL.Call(PredicateName, Params) Then
  65.     Dim AppPath
  66.     AppPath = Params.ToString(1)
  67.     Msg = Msg & vbCrLf & _
  68.       "AppPath = " & AppPath & "."
  69.   Else
  70.     Msg = Msg & vbCrLf & "false."
  71.   End If
  72.  
  73.  
  74.   pl_Example1 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  75.  
  76.   Params.DestroyObject
  77. End Function
  78.  
  79. Function pl_Example2(ByRef PL)
  80.   Dim Title, Msg
  81.   Title = vbCrLf & _
  82.           "%%" & vbCrLf & _
  83.           "% 2. pl_Example2(PL)" & vbCrLf & _
  84.           "%      TgsPLClient: Call2, Call" & vbCrLf & _
  85.           "%      TgsPLTermv: PutAtom, ToString"
  86.  
  87.   pl_Example2 = ""
  88.  
  89.   Dim Code
  90.   Code = "assertz( pl_Example(pl_Example2, 'Пример 2') )"
  91.   Msg = _
  92.     "% Выполнение кода" & vbCrLf & _
  93.     "?- " & Code & "."
  94.  
  95.   If PL.Call2(Code) Then
  96.     Msg = Msg & vbCrLf & "true."
  97.   Else
  98.     Msg = Msg & vbCrLf & "false."
  99.   End If
  100.  
  101.   Dim PredicateName, Params
  102.   PredicateName = "pl_Example"
  103.   Set Params = Designer.CreateObject(2, "TgsPLTermv", "")
  104.   Params.PutAtom 0, "pl_Example2"
  105.  
  106.   Msg = Msg & vbCrLf & _
  107.     "% Запрос" & vbCrLf & _
  108.     "?- " & PredicateName & "(" & Params.ToString(0) & ", Text)."
  109.  
  110.   If PL.Call(PredicateName, Params) Then
  111.     Msg = Msg & vbCrLf & _
  112.       "Text = " & Params.ToString(1) & "."
  113.   Else
  114.     Msg = Msg & vbCrLf & "false."
  115.   End If
  116.  
  117.   pl_Example2 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  118.  
  119.   Params.DestroyObject
  120. End Function
  121.  
  122. Function pl_Example3(ByRef PL)
  123.   Dim Title, Msg
  124.   Title = vbCrLf & _
  125.           "%%" & vbCrLf & _
  126.           "% 3. pl_Example3(PL)" & vbCrLf & _
  127.           "%      TgsPLClient: Compound, Term, Call" & vbCrLf & _
  128.           "%      TgsPLTermv: PutAtom, ToString"
  129.  
  130.   pl_Example3 = ""
  131.  
  132.   Dim Goal, Functor, Termv
  133.   Set Goal = Designer.CreateObject(1, "TgsPLTermv", "")
  134.   Functor = "pl_Example"
  135.   Set Termv = Designer.CreateObject(2, "TgsPLTermv", "")
  136.   Termv.PutAtom 0, "pl_Example3"
  137.   Termv.PutAtom 1, "Пример 3"
  138.   Call PL.Compound(Goal.Term(0), Functor, Termv)
  139.  
  140.   Dim Code
  141.   Code = "assertz"
  142.   Msg = _
  143.     "% Выполнение кода" & vbCrLf & _
  144.     "?- " & Code & "( " & Goal.ToString(0) & " )."
  145.  
  146.   If PL.Call(Code, Goal) Then
  147.     Msg = Msg & vbCrLf & "true."
  148.   Else
  149.     Msg = Msg & vbCrLf & "false."
  150.   End If
  151.  
  152.   Dim PredicateName, Params
  153.   PredicateName = "pl_Example"
  154.   Set Params = Designer.CreateObject(2, "TgsPLTermv", "")
  155.   Params.PutAtom 0, "pl_Example3"
  156.  
  157.   If PL.Call(PredicateName, Params) Then
  158.     Msg = Msg & vbCrLf & _
  159.       "% Запрос" & vbCrLf & _
  160.       "?- " & PredicateName & "(" & Params.ToString(0) & ", Text)." & vbCrLf & _
  161.       "Text = " & Params.ToString(1) & "."
  162.   Else
  163.     Msg = Msg & vbCrLf & "false."
  164.   End If
  165.  
  166.   pl_Example3 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  167.  
  168.   Termv.DestroyObject
  169.   Goal.DestroyObject
  170.   Params.DestroyObject
  171. End Function
  172.  
  173. Function pl_Example4(ByRef PL)
  174.   Dim Title, Msg
  175.   Title = vbCrLf & _
  176.           "%%" & vbCrLf & _
  177.           "% 4. pl_Example4(PL)" & vbCrLf & _
  178.           "%      TgsPLClient: LoadScriptByName, Call" & vbCrLf & _
  179.           "%      TgsPLTermv: ToString"
  180.  
  181.   pl_Example4 = ""
  182.  
  183.   Dim ScriptName
  184.   ScriptName = "pl_Examples_Script"
  185.  
  186.   PL.Debug = True
  187.   If Not PL.LoadScriptByName(ScriptName) Then
  188.     PL.Debug = False
  189.     Exit Function
  190.   End If
  191.   PL.Debug = False
  192.  
  193.   Dim PredicateName, Params
  194.   PredicateName = "hello_world"
  195.   Set Params = Designer.CreateObject(1, "TgsPLTermv", "")
  196.  
  197.   Msg = _
  198.     "% Запрос" & vbCrLf & _
  199.     "?- " & PredicateName & "(Hello)."
  200.  
  201.   If PL.Call(PredicateName, Params) Then
  202.     Msg = Msg & vbCrLf & _
  203.       "Hello = " & Params.ToString(0) & "."
  204.   Else
  205.     Msg = Msg & vbCrLf & "false."
  206.   End If
  207.  
  208.   pl_Example4 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  209.  
  210.   Params.DestroyObject
  211. End Function
  212.  
  213. Function pl_Example5(ByRef PL)
  214.   Dim Title, Msg
  215.   Title = vbCrLf & _
  216.           "%%" & vbCrLf & _
  217.           "% 5. pl_Example5(PL)" & vbCrLf & _
  218.           "%      TgsPLClient: Debug, LoadScriptByName" & vbCrLf & _
  219.           "%      TgsPLTermv: ToString" & vbCrLf & _
  220.           "%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close, Cut"
  221.  
  222.   pl_Example5 = ""
  223.  
  224.   Dim ScriptName
  225.   ScriptName = "pl_Examples_Script"
  226.  
  227.   PL.Debug = True
  228.   If Not PL.LoadScriptByName(ScriptName) Then
  229.     PL.Debug = False
  230.     Exit Function
  231.   End If
  232.   PL.Debug = False
  233.  
  234.   Dim Params
  235.   Set Params = Designer.CreateObject(1, "TgsPLTermv", "")
  236.   Dim PredicateName, Query
  237.   PredicateName = "hello_world"
  238.   Set Query = Designer.CreateObject(nil, "TgsPLQuery", "")
  239.   Query.PredicateName = PredicateName
  240.   Query.Termv = Params
  241.   Query.OpenQuery
  242.  
  243.   Msg = _
  244.     "% Запрос" & vbCrLf & _
  245.     "?- " & PredicateName & "(Hello)."
  246.  
  247.   If Not Query.EOF Then
  248.     Do Until Query.EOF
  249.       Msg = Msg & vbCrLf & _
  250.         "Hello = " & Params.ToString(0)
  251.       Query.NextSolution
  252.       If Query.EOF Then
  253.         Msg = Msg & "."
  254.       Else
  255.         Msg = Msg & " ;"
  256.       End If
  257.     Loop
  258.   Else
  259.     Msg = Msg & vbCrLf & "false."
  260.   End If
  261.   Query.Close
  262.  
  263.   Msg = Msg & vbCrLf & _
  264.     "% Запрос" & vbCrLf & _
  265.     "?- " & PredicateName & "(Hello), !."
  266.  
  267.   Query.OpenQuery
  268.  
  269.   If Not Query.EOF Then
  270.     Do Until Query.EOF
  271.       Msg = Msg & vbCrLf & _
  272.         "Hello = " & Params.ToString(0)
  273.       Query.Cut
  274.       Query.NextSolution
  275.       If Query.EOF Then
  276.         Msg = Msg & "."
  277.       Else
  278.         Msg = Msg & " ;"
  279.       End If
  280.     Loop
  281.   Else
  282.     Msg = Msg & vbCrLf & "false."
  283.   End If
  284.   Query.Close
  285.  
  286.   pl_Example5 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  287.  
  288.   Query.DestroyObject
  289.   Params.DestroyObject
  290. End Function
  291.  
  292. Function pl_Example6(ByRef PL)
  293.   Dim Title, Msg
  294.   Title = vbCrLf & _
  295.           "%%" & vbCrLf & _
  296.           "% 6. pl_Example6(PL)" & vbCrLf & _
  297.           "%      TgsPLClient: LoadScriptByName" & vbCrLf & _
  298.           "%      TgsPLTermv: DataType, ReadInteger, ReadAtom, ReadDate, ReadString" & vbCrLf & _
  299.           "%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close"
  300.  
  301.   pl_Example6 = ""
  302.  
  303.   Const PL_VARIABLE = 1
  304.   Const PL_ATOM = 2
  305.   Const PL_INTEGER = 3
  306.   Const PL_FLOAT = 4
  307.   Const PL_STRING = 5
  308.   Const PL_TERM = 6
  309.  
  310.   Dim ScriptName
  311.   ScriptName = "pl_Examples_Script"
  312.  
  313.   PL.Debug = True
  314.   If Not PL.LoadScriptByName(ScriptName) Then
  315.     PL.Debug = False
  316.     Exit Function
  317.   End If
  318.   PL.Debug = False
  319.  
  320.   Dim Params
  321.   Set Params = Designer.CreateObject(2, "TgsPLTermv", "")
  322.  
  323.   Dim PredicateName, Query
  324.   Dim Arg1, Arg2
  325.   PredicateName = "some_fact"
  326.   Set Query = Designer.CreateObject(nil, "TgsPLQuery", "")
  327.   Query.PredicateName = PredicateName
  328.   Query.Termv = Params
  329.   Query.OpenQuery
  330.  
  331.   Msg = _
  332.     "% Запрос" & vbCrLf & _
  333.     "?- " & PredicateName & "(Arg1, Arg2)."
  334.  
  335.   Msg = Msg & vbCrLf & _
  336.     "% Обработка фактов"
  337.   If Not Query.EOF Then
  338.     Do Until Query.EOF
  339.       Select Case Params.DataType(0)
  340.         Case PL_INTEGER
  341.           Arg1 = Params.ReadInteger(0) & ": "
  342.         Case PL_ATOM
  343.           If IsDate(Params.ReadAtom(0)) Then
  344.             Arg1 = Year(Params.ReadDate(0)) & " - "
  345.           Else
  346.             Arg1 = ""
  347.           End If
  348.         Case Else
  349.           Arg1 = ""
  350.       End Select
  351.       If Not Arg1 = "" Then
  352.         Select Case Params.DataType(1)
  353.           Case PL_ATOM
  354.             Arg2 = Params.ReadAtom(1)
  355.           Case PL_STRING
  356.             Arg2 = Params.ReadString(1)
  357.           Case Else
  358.             Arg2 = ""
  359.         End Select
  360.         Msg = Msg & vbCrLf & _
  361.           "%   " & Arg1 & Arg2
  362.       End If
  363.       Query.NextSolution
  364.     Loop
  365.   Else
  366.     Msg = Msg & vbCrLf & "false."
  367.   End If
  368.   Query.Close
  369.  
  370.   pl_Example6 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  371.  
  372.   Query.DestroyObject
  373.   Params.DestroyObject
  374. End Function
  375.  
  376. Function pl_Example7(ByRef PL)
  377.   Dim Title, Msg
  378.   Title = vbCrLf & _
  379.           "%%" & vbCrLf & _
  380.           "% 7. pl_Example7(PL)" & vbCrLf & _
  381.           "%      TgsPLClient: LoadScriptByName, Debug, MakePredicatesOfSQLSelect" & vbCrLf & _
  382.           "%      TgsPLTermv: PutAtom, ReadString, PutString" & vbCrLf & _
  383.           "%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close"
  384.  
  385.   pl_Example7 = ""
  386.  
  387.   Dim ScriptName
  388.   ScriptName = "pl_Examples_Script"
  389.  
  390.   PL.Debug = True
  391.   If Not PL.LoadScriptByName(ScriptName) Then
  392.     PL.Debug = False
  393.     Exit Function
  394.   End If
  395.   PL.Debug = False
  396.  
  397.   Dim P_sql, Tv_sql, Q_sql
  398.   Dim FactName, SQL
  399.   P_sql = "gd_sql"
  400.   Set Tv_sql = Designer.CreateObject(2, "TgsPLTermv", "")
  401.   Set Q_sql = Designer.CreateObject(nil, "TgsPLQuery", "")
  402.   Q_sql.PredicateName = P_sql
  403.   Q_sql.Termv = Tv_sql
  404.   FactName = "gd_place"
  405.   Tv_sql.PutAtom 0, FactName
  406.   Q_sql.OpenQuery
  407.  
  408.   Msg = _
  409.     "% Запрос" & vbCrLf & _
  410.     "?- " & P_sql & "(" & FactName & ", SQL)."
  411.  
  412.   Dim Ret
  413.  
  414.   Msg = Msg & vbCrLf & _
  415.     "% Обработка фактов, наполнение базы знаний"
  416.   If Not Q_sql.EOF Then
  417.     Do Until Q_sql.EOF
  418.       SQL = Tv_sql.ReadString(1)
  419.       Msg = Msg & vbCrLf & _
  420.             "/*" & SQL & "*/" & vbCrLf
  421.  
  422.       PL.Debug = True
  423.       Ret = PL.MakePredicatesOfSQLSelect( _
  424.               SQL, _
  425.               gdcBaseManager.ReadTransaction, _
  426.               FactName, FactName, False)
  427.       PL.Debug = False
  428.  
  429.       Msg = Msg & _
  430.             "% Добавлено " & Ret & " фактов " & FactName
  431.       Q_sql.NextSolution
  432.     Loop
  433.   Else
  434.     Msg = Msg & vbCrLf & "false."
  435.   End If
  436.   Q_sql.Close
  437.   Q_sql.DestroyObject
  438.   Tv_sql.DestroyObject
  439.  
  440.   Dim P_info, Tv_info, Q_info
  441.   Dim PlaceNameIn, PlaceNameOut, PlaceTypeOut
  442.   P_info = "place_info"
  443.   Set Tv_info = Designer.CreateObject(3, "TgsPLTermv", "")
  444.   Set Q_info = Designer.CreateObject(nil, "TgsPLQuery", "")
  445.   Q_info.PredicateName = P_info
  446.   Q_info.Termv = Tv_info
  447.   PlaceNameIn = "Минск"
  448.   Tv_info.PutString 0, PlaceNameIn
  449.   Q_info.OpenQuery
  450.  
  451.   Msg = Msg & vbCrLf & _
  452.     "% Запрос" & vbCrLf & _
  453.     "?- " & P_info & "(""" & PlaceNameIn & """, PlaceNameOut, PlaceTypeOut)."
  454.   Msg = Msg & vbCrLf & _
  455.     "% Поиск решений"
  456.   If Not Q_info.EOF Then
  457.     Do Until Q_info.EOF
  458.       Msg = Msg & vbCrLf & _
  459.             "%   " & Tv_info.ReadString(1) & " (" & Tv_info.ReadString(2) & ")"
  460.       Q_info.NextSolution
  461.     Loop
  462.   Else
  463.     Msg = Msg & vbCrLf & "false."
  464.   End If
  465.   Q_info.Close
  466.   Q_info.DestroyObject
  467.   Tv_info.DestroyObject
  468.  
  469.   pl_Example7 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  470. End Function
  471.  
  472. Function pl_Example8(ByRef PL)
  473.   Dim Title, Msg
  474.   Title = vbCrLf & _
  475.           "%%" & vbCrLf & _
  476.           "% 8. pl_Example8(PL)" & vbCrLf & _
  477.           "%      TgsPLClient: LoadScriptByName, ExtractData, MakePredicatesOfDataSet" & vbCrLf & _
  478.           "%      TgsPLTermv: PutInteger, ReadInteger, ReadString" & vbCrLf & _
  479.           "%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close"
  480.  
  481.   pl_Example8 = ""
  482.  
  483.   Const ftString = 1
  484.   Const ftInteger = 3
  485.  
  486.   Dim ScriptName
  487.   ScriptName = "pl_Examples_Script"
  488.   If Not PL.LoadScriptByName(ScriptName) Then
  489.     Exit Function
  490.   End If
  491.  
  492.   Dim P_rec, Tv_rec, RecNum
  493.   P_rec = "generate_some_rec"
  494.   Set Tv_rec = Designer.CreateObject(3, "TgsPLTermv", "")
  495.   RecNum = 8
  496.   Tv_rec.PutInteger 2, RecNum
  497.  
  498.   Msg = _
  499.     "% Запрос" & vbCrLf & _
  500.     "?- " & P_rec & "(ID, Name, " & RecNum & ")."
  501.  
  502.   Dim CDS
  503.   Set CDS = Designer.CreateObject(nil, "TClientDataset", "")
  504.   CDS.FieldDefs.Add "ID", ftInteger, 0, True
  505.   CDS.FieldDefs.Add "Name", ftString, 20, True
  506.   CDS.CreateDataSet
  507.   CDS.Open
  508.  
  509.   Msg = Msg & vbCrLf & _
  510.     "% Заполнение клиентского набора данных из Пролог-запроса"
  511.   Call PL.ExtractData(CDS, P_rec, Tv_rec)
  512.   Msg = Msg & vbCrLf & _
  513.     "% Добавлено записей: " & CDS.RecordCount
  514.  
  515.   If Not CDS.RecordCount = 0 Then
  516.     Msg = Msg & vbCrLf & _
  517.       "% Считывание клиентского набора данных"
  518.       Msg = Msg & vbCrLf & _
  519.             "%   ID   Name"
  520.     CDS.First
  521.     Do Until CDS.Eof
  522.       Msg = Msg & vbCrLf & _
  523.             "%   " & CDS.FieldByName("ID").AsInteger & _
  524.             "    " & CDS.FieldByName("Name").AsString
  525.       CDS.Next
  526.     Loop
  527.   End If
  528.   Tv_rec.DestroyObject
  529.  
  530.   Dim P_cds, Tv_cds, Q_cds
  531.   P_cds = "gd_some_rec"
  532.   Set Tv_cds = Designer.CreateObject(2, "TgsPLTermv", "")
  533.   Set Q_cds = Designer.CreateObject(nil, "TgsPLQuery", "")
  534.   Q_cds.PredicateName = P_cds
  535.   Q_cds.Termv = Tv_cds
  536.  
  537.   Dim I, DelCount
  538.   DelCount = 3
  539.   CDS.First
  540.   For I = 1 To DelCount
  541.     CDS.Delete
  542.   Next
  543.   Msg = Msg & vbCrLf & _
  544.     "% Удалено первых записей: " & DelCount
  545.  
  546.   Msg = Msg & vbCrLf & _
  547.     "% Наполнение базы знаний из клиентского набора данных"
  548.   Dim Ret
  549.  
  550.   PL.Debug = True
  551.   Ret = PL.MakePredicatesOfDataSet(CDS, "ID,Name", P_cds, P_cds, False)
  552.   PL.Debug = False
  553.    
  554.   Msg = Msg & vbCrLf & _
  555.     "% Добавлено фактов " & P_cds & ": " & Ret
  556.  
  557.   CDS.Close
  558.   CDS.DestroyObject
  559.  
  560.   Msg = Msg & vbCrLf & _
  561.     "% Запрос" & vbCrLf & _
  562.     "?- " & P_cds & "(ID, Name)"
  563.   Q_cds.OpenQuery
  564.  
  565.   Msg = Msg & vbCrLf & _
  566.     "% Обработка фактов"
  567.   If Not Q_cds.EOF Then
  568.     While Not Q_cds.EOF
  569.       Msg = Msg & vbCrLf & _
  570.             "%   " & Tv_cds.ReadInteger(0) & ": " & Tv_cds.ReadString(1)
  571.       Q_cds.NextSolution
  572.     Wend
  573.   Else
  574.     Msg = Msg & vbCrLf & "false."
  575.   End If
  576.   Q_cds.Close
  577.   Q_cds.DestroyObject
  578.   Tv_cds.DestroyObject
  579.  
  580.   pl_Example8 = Title & vbCrLf & Msg & vbCrLf & "%" & vbCrLf & "%%"
  581. End Function

pl_Examples_Script

см. также pl_Examples, Протокол

  1. % Примеры использования PL-объектов
  2.  
  3. hello_world(Msg) :-
  4.     format(atom(Msg), '~w~w~w', ['Hello', ' ', 'World']).
  5. hello_world(Msg) :-
  6.     findall(X, some_fact(X), Xs),
  7.     atomic_list_concat(Xs, Msg).
  8. hello_world("Hello last World").
  9.  
  10. some_fact(hello).
  11. some_fact('Next').
  12. some_fact("World").
  13.  
  14. some_fact(1, 'Delphi').
  15. some_fact(2, 'VBScript').
  16. some_fact(3, 'Firebird').
  17. some_fact(4, 'FastReport').
  18. some_fact(5, 'SWI-Prolog').
  19. some_fact(none, 0).
  20. some_fact('1995-01-01', "Анжелика").
  21. some_fact('2003-01-01', "Гедымин").
  22. some_fact('2015-01-01', 2.6).
  23.  
  24. :- dynamic([gd_place/4]).
  25.  
  26. % gd_place(ID, Parent, Name, PlaceType)
  27.  
  28. place_info(Name, PlaceName, PlaceType) :-
  29.     place_name_type(_, Name, PlaceName, PlaceType).
  30.  
  31. place_name_type(ID, Name, Name, PlaceType) :-
  32.     gd_place(ID, _, Name, PlaceType).
  33. place_name_type(ID, Name, PlaceName, PlaceType) :-
  34.     gd_place(ID, Parent, Name, _),
  35.     place_name_type(Parent, _, PlaceName, PlaceType).
  36.  
  37. :-  style_check(-atom).
  38.  
  39. gd_sql(gd_place,
  40. "
  41. SELECT
  42.  p.ID, p.PARENT, p.NAME, p.PLACETYPE
  43. FROM
  44.  GD_PLACE p
  45. "
  46. ).
  47.  
  48. generate_some_rec(ID, Name, Number) :-
  49.     integer(Number),
  50.     between(1, Number, ID),
  51.     atomic_list_concat(["Record", ID], Name).

Протокол

см. также pl_Examples, pl_Examples_Script

/* Примеры использования PL-объектов */

%%%%
%    pl_Examples
%      TgsPLClient: Initialise, IsInitialised

%%
% 1. pl_Example1(PL)
%      TgsPLClient: Call
%      TgsPLTermv: PutAtom, ToString
% Запрос
?- current_prolog_flag(executable, AppPath).
AppPath = 'C:\\Golden Software\\Gedemin\\gedemin.exe'.
%
%%

%%
% 2. pl_Example2(PL)
%      TgsPLClient: Call2, Call
%      TgsPLTermv: PutAtom, ToString
% Выполнение кода
?- assertz( pl_Example(pl_Example2, 'Пример 2') ).
true.
% Запрос
?- pl_Example(pl_Example2, Text).
Text = 'Пример 2'.
%
%%

%%
% 3. pl_Example3(PL)
%      TgsPLClient: Compound, Term, Call
%      TgsPLTermv: PutAtom, ToString
% Выполнение кода
?- assertz( pl_Example(pl_Example3,'Пример 3') ).
true.
% Запрос
?- pl_Example(pl_Example3, Text).
Text = 'Пример 3'.
%
%%

%%
% 4. pl_Example4(PL)
%      TgsPLClient: LoadScriptByName, Call
%      TgsPLTermv: ToString
% Запрос
?- hello_world(Hello).
Hello = 'Hello World'.
%
%%

%%
% 5. pl_Example5(PL)
%      TgsPLClient: Debug, LoadScriptByName
%      TgsPLTermv: ToString
%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close, Cut
% Запрос
?- hello_world(Hello).
Hello = 'Hello World' ;
Hello = helloNextWorld ;
Hello = "Hello last World".
% Запрос
?- hello_world(Hello), !.
Hello = 'Hello World'.
%
%%

%%
% 6. pl_Example6(PL)
%      TgsPLClient: LoadScriptByName
%      TgsPLTermv: DataType, ReadInteger, ReadAtom, ReadDate, ReadString
%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close
% Запрос
?- some_fact(Arg1, Arg2).
% Обработка фактов
%   1: Delphi
%   2: VBScript
%   3: Firebird
%   4: FastReport
%   5: SWI-Prolog
%   1995 - Анжелика
%   2003 - Гедымин
%   2015 -
%
%%

%%
% 7. pl_Example7(PL)
%      TgsPLClient: LoadScriptByName, Debug, MakePredicatesOfSQLSelect
%      TgsPLTermv: PutAtom, ReadString, PutString
%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close
% Запрос
?- gd_sql(gd_place, SQL).
% Обработка фактов, наполнение базы знаний
/*
SELECT
  p.ID, p.PARENT, p.NAME, p.PLACETYPE
FROM
  GD_PLACE p
*/
% Добавлено 265 фактов gd_place
% Запрос
?- place_info("Минск", PlaceNameOut, PlaceTypeOut).
% Поиск решений
%   Минск (Нас. пункт)
%   Минский (Район)
%   Минская (Область)
%   Беларусь (Страна)
%
%%

%%
% 8. pl_Example8(PL)
%      TgsPLClient: LoadScriptByName, ExtractData, MakePredicatesOfDataSet
%      TgsPLTermv: PutInteger, ReadInteger, ReadString
%      TgsPLQuery: OpenQuery, EOF, NextSolution, Close
% Запрос
?- generate_some_rec(ID, Name, 8).
% Заполнение клиентского набора данных из Пролог-запроса
% Добавлено записей: 8
% Считывание клиентского набора данных
%   ID   Name
%   1    Record1
%   2    Record2
%   3    Record3
%   4    Record4
%   5    Record5
%   6    Record6
%   7    Record7
%   8    Record8
% Удалено первых записей: 3
% Наполнение базы знаний из клиентского набора данных
% Добавлено фактов gd_some_rec: 5
% Запрос
?- gd_some_rec(ID, Name)
% Обработка фактов
%   4: Record4
%   5: Record5
%   6: Record6
%   7: Record7
%   8: Record8
%
%%
%%%%
Источник — «https://gsbelarus.com/gs/wiki/index.php?title=%D0%9F%D1%80%D0%B8%D0%BC%D0%B5%D1%80%D1%8B_%D0%B8%D1%81%D0%BF%D0%BE%D0%BB%D1%8C%D0%B7%D0%BE%D0%B2%D0%B0%D0%BD%D0%B8%D1%8F_PL-%D0%BE%D0%B1%D1%8A%D0%B5%D0%BA%D1%82%D0%BE%D0%B2&oldid=6962»
Персональные инструменты
Пространства имён

Варианты
Действия
Навигация
Инструменты