home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 1.ddi / REFLEX.PRO < prev    next >
Encoding:
Prolog Source  |  1987-03-23  |  7.7 KB  |  237 lines
  1. /************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.       Access a Reflex(R) compatible data base file
  7.       from Prolog
  8.  
  9. *************************************************************/
  10.  
  11. Domains
  12. /*************************************************************
  13.       Prolog data base
  14. *************************************************************/
  15.  
  16.   ReflexBase    = reflex(FldNames,ReflexRecL)
  17.   FldNames    = String*        /* Field names */
  18.   ReflexRecL    = ReflexRec*        /* Record list */
  19.   ReflexRec    = ReflexElem*        /* A record is a list of elements */
  20.   ReflexElem    = date(Integer);    /* 16-bit int. representing number of
  21.                          days since December 31, 1899 */
  22.             real(Real);        /* 64-bit IEEE floating point */
  23.             int(Integer);        /* 16-bit signed integer */
  24.             text(String);        /* A string representing a text */
  25.             untyped;        /* No data stored */
  26.             error
  27.  
  28.   ReflexTypeL    = ReflexType*
  29.   ReflexType    = u; t; rt; d; r; i
  30.   TxtPools    = Txtpool*
  31.   TxtPool    = RepTxt*
  32.   RepTxt    = txt(Integer,String)
  33.   IntegerL    = Integer*
  34.   FilePos    = Real
  35.  
  36. PREDICATES
  37. /* Initialize access */
  38.   Init_Reflex(Integer,FldNames,ReflexTypeL,TxtPools)
  39.  
  40. /* Header of reflex file */
  41.   rd_ReflexHeader
  42.  
  43. /* Global sort declaration */
  44.   rd_GlobalSort
  45.  
  46. /* Read Field Directory Table */
  47.   rd_FldDirTable(FldNames,ReflexTypeL,TxtPools)
  48.   rd_FldNames(FldNames,Integer)
  49.   rd_FldNames2(Integer,FldNames).
  50.   rd_indxL(Integer,IntegerL)
  51.  
  52.   rd_fldTypes(Integer,ReflexTypeL,Integer)
  53.   rd_fldDesc(Integer,ReflexTypeL,Integer,Integer)
  54.   convert_type(Char,ReflexType)
  55.   chk_RepTxt(CHAR,Integer,Integer)
  56.  
  57.   rd_RepTxt(Integer,TxtPools)
  58.   rd_TxtPools(Integer,TxtPools)
  59.   rd_TxtPool(Integer,Integer,Integer,IntegerL,TxtPool)
  60.  
  61. /* Read Data record sections */
  62.   rd_ReflexFile(Integer,ReflexTypeL,TxtPools,ReflexRecL)
  63.   rd_ReflexRecs2(Integer,ReflexTypeL,TxtPools,ReflexRecL)
  64.   rd_ReflexRec1(ReflexTypeL,TxtPools,FilePos,ReflexRec)
  65.   rd_Reflexelem(ReflexType,TxtPools,TxtPools,FilePos,ReflexElem)
  66.   lookup_indx(Integer,TxtPool,String)
  67.   get_newindx(Integer,Integer,Integer,IntegerL)
  68.  
  69. /* Sequential access */
  70.   rd_ReflexRec(Integer,ReflexTypeL,TxtPools,ReflexRec)
  71.   reverse(TxtPools,TxtPools,TxtPools)
  72.  
  73. CLAUSES
  74.   Init_Reflex(TotRecs,FldNames,TypeL,TxtPools) :-
  75.       rd_ReflexHeader, Rd_GlobalSort,
  76.         rd_FldDirTable(FldNames,TypeL,TxtPools),
  77.         read_int(TotRecs),ignore(4).
  78.       
  79.  
  80. /*************************************************************
  81.       Read header of a Reflex(R) file
  82.        (We actually ignore it)
  83. *************************************************************/
  84.  
  85.   rd_ReflexHeader :-
  86.       read_int(HdrSz), Size=HdrSz-2,
  87.       ignore(Size).
  88.  
  89. /*************************************************************
  90.       Read Global Sort Declarations
  91.        (We actually ignore it)
  92. *************************************************************/
  93.  
  94.   rd_GlobalSort :- ignore(12).
  95.  
  96. /*************************************************************
  97.       Read Field Directory Table
  98. *************************************************************/
  99.  
  100.   rd_FldDirTable(FldNames,TypeL,Reptxt) :-
  101.       rd_FldNames(FldNames,NoofFld),
  102.       rd_FldTypes(NoofFld,TypeL,NoofRepTxt),
  103.       rd_RepTxt(NoofReptxt,RepTxt).
  104.  
  105.   rd_FldNames(FldNames,NoofIndx) :-
  106.       read_int(IndxLen), NoofIndx=IndxLen/2,
  107.       rd_indxL(NoofIndx,_/*IndxL*/),
  108.       ignore(2),    /* Field Name pool length */
  109.       rd_FldNames2(NoofIndx,FldNames).
  110.  
  111.   rd_FldNames2(0,[]) :- !.
  112.   rd_FldNames2(Indx,[FldName|Tail]) :-
  113.       read_str(FldName), Indx2=Indx-1,
  114.       rd_FldNames2(Indx2,Tail).
  115.  
  116.   rd_fldTypes(NoofFld,TypeL,NoofRepTxt) :-
  117.       ignore(2), /* Filed descriptor table len */
  118.       rd_fldDesc(NoofFld,TypeL, 0,NoofRepTxt).
  119.  
  120.   rd_fldDesc(0,[],NoofRepTxt,NoofRepTxt) :-!.
  121.   rd_fldDesc(N,[Type|TypeL],CurNoofRepTxt,NoofRepTxt) :-
  122.       ignore(2),    /* Name indx */
  123.       read_char(T), chk_RepTxt(T,CurNoofRepTxt,RepTxt2),
  124.       convert_Type(T,Type),
  125.       ignore(13), /* Format,FldOffset, ETREC, Sort position */
  126.       N2 = N-1,
  127.       rd_fldDesc(N2,TypeL,RepTxt2,NoofRepTxt).
  128.  
  129.   chk_RepTxt('\002',N,N2) :- !,N2=N+1.
  130.   chk_RepTxt(_,N,N).
  131.  
  132.   convert_type('\000',u).
  133.   convert_type('\001',t).
  134.   convert_type('\002',rt).
  135.   convert_type('\003',d).
  136.   convert_type('\004',r).
  137.   convert_type('\005',i).
  138.  
  139.   rd_RepTxt(NoofReptxt,RepTxt) :-
  140.       ignore(6),    /* Default formats */
  141.       rd_TxtPools(NoofReptxt,RepTxt1),
  142.       reverse(RepTxt1,[],RepTxt).
  143.  
  144.   rd_TxtPools(0,[]) :-!.
  145.   rd_TxtPools(N,[TxtPool|Tail]) :-
  146.       read_int(IndxLen), NoofIndx=IndxLen/2,
  147.       rd_indxL(NoofIndx,IndxL),
  148.       read_int(TxtPoolLen), PoolLen=TxtPoolLen-3,
  149.       ignore(3),    /* freelist hdr */
  150.       rd_TxtPool(PoolLen,ToSkip, 5, IndxL,TxtPool),
  151.       ignore(ToSkip), N2=N-1,
  152.       rd_TxtPools(N2,Tail).
  153.  
  154.   rd_TxtPool(PoolLen,ToSkip,CurIndx,IndxL,[txt(Indx,Txt)|TxtPool]) :-
  155.       get_newindx(CurIndx,32767,Indx,IndxL),!,
  156.       IndxDiff=Indx-CurIndx, ignore(IndxDiff),
  157.       ignore(2),    /* Reference count */
  158.       read_str(Txt),
  159.       str_len(Txt,Slen), ToSkip2=PoolLen-IndxDiff-Slen-3,
  160.       Indx2 = Indx + 2 + Slen+1,
  161.       rd_TxtPool(ToSkip2,ToSkip,Indx2,IndxL,TxtPool).
  162.  
  163.   rd_TxtPool(ToSkip,ToSkip,_,_,[]) :-!.
  164.  
  165.   get_newindx(_,Newindx,NewIndx,[]) :- NewIndx<>32767.
  166.   get_newindx(CurIndx,CurNewindx,NewIndx,[CI2|Tail]) :-
  167.       CI2<CurNewIndx, CI2>=CurIndx,!,
  168.       get_newIndx(CurIndx,CI2,NewIndx,Tail).
  169.  
  170.   get_newindx(CurIndx,CurNewindx,NewIndx,[_|Tail]) :-
  171.       get_newIndx(CurIndx,CurNewindx,NewIndx,Tail).
  172.       
  173.  
  174. /*************************************************************
  175.       Read Data record sections
  176. *************************************************************/
  177.  
  178.   rd_ReflexFile(TotRecs,TypeL,TxtPools,ReflexRecs):-
  179.       /* Master Record section */
  180.       rd_ReflexRecs2(TotRecs,TypeL,TxtPools,ReflexRecs).
  181.  
  182.   rd_ReflexRecs2(0,_,_,[]) :-!.
  183.   rd_ReflexRecs2(N,TypeL,TxtPools,[ReflexRec|Tail]) :-
  184.       read_int(RecLen),
  185.       readdevice(FP),
  186.       filepos(FP,StartPos,0),
  187.       ignore(4),    /* Skip Record hdr. */
  188.       rd_ReflexRec1(TypeL,TxtPools,StartPos,ReflexRec),
  189.       N2 = N-1, FilePos2=StartPos+RecLen,
  190.       filepos(FP,FilePos2,0),
  191.       rd_ReflexRecs2(N2,TypeL,TxtPools,Tail).
  192.  
  193.   rd_ReflexRec1([],_,_,[]) :-!.
  194.   rd_ReflexRec1([Type|TypeL],TxtPools,StartPos,[Elem|ElemL]) :-
  195.       rd_Reflexelem(Type,TxtPools,TxtPools2,StartPos,Elem),
  196.       rd_ReflexRec1(TypeL,TxtPools2,StartPos,ElemL).
  197.  
  198.   rd_Reflexelem(u,TxtPools,TxtPools,_,untyped).
  199.   rd_Reflexelem(t,Txtpools,TxtPools,StartPos,text(Str)) :-
  200.       readdevice(FP),
  201.       read_int(TxtIndx),
  202.       filepos(FP,CurPos,0), 
  203.       NewPos=StartPos+TxtIndx, filepos(Fp,NewPos,0),
  204.       read_str(Str), filepos(Fp,CurPos,0).
  205.  
  206.   rd_Reflexelem(rt,[TxtPool|Txtpools],TxtPools,_,text(Str)) :-
  207.       read_int(TxtIndx), lookup_indx(TxtIndx,TxtPool,Str).
  208.  
  209.   rd_Reflexelem(d,Txtpools,TxtPools,_,date(Date)) :- read_int(Date).
  210.   rd_Reflexelem(r,Txtpools,TxtPools,_,real(Real)) :- read_real(Real).
  211.   rd_Reflexelem(i,Txtpools,TxtPools,_,int(Int))   :- read_int(Int).
  212.  
  213.   lookup_indx(Indx,[txt(Indx,Str)|_],Str) :- !.
  214.   lookup_indx(Indx,[_|Txts],Str) :- lookup_indx(Indx,Txts,Str).
  215.  
  216. /*************************************************************
  217.       Read data record sequentially
  218. *************************************************************/
  219.  
  220.   rd_ReflexRec(0,_,_,_) :-!,fail.
  221.   rd_ReflexRec(_,TypeL,TxtPools,ReflexRec) :-
  222.       read_int(RecLen),
  223.       readdevice(FP),
  224.       filepos(FP,StartPos,0),
  225.       ignore(4),    /* Skip Record hdr. */
  226.       rd_ReflexRec1(TypeL,TxtPools,StartPos,ReflexRec),
  227.       FilePos2=StartPos+RecLen,
  228.       filepos(FP,FilePos2,0).
  229.   rd_ReflexRec(N,TypeL,TxtPools,ReflexRec) :-
  230.       N2 = N-1, rd_ReflexRec(N2,TypeL,TxtPools,ReflexRec).
  231.  
  232.   reverse([],L,L) :- !.
  233.   reverse([H|T],OldL,NewL) :-    reverse(T,[H|OldL],NewL).
  234.  
  235.   rd_indxL(0,[]) :- !.
  236.   rd_indxL(N,[V|Tail]) :-    read_int(V), N2=N-1, rd_indxL(N2,Tail).
  237.