;---------- Contrato "NBDC-SONAE" Fev.96 ---------------------------------------
;  Copyright INESC / SONAE, 1996
;  Autor: jno
;-------------------------------------------------------------------------------
; atomic

( deftype Id STR )
;---------------------

( deftype Key STR )
;---------------------

( deftype At STR )
;---------------------

( deftype Val STR )
;---------------------

( deftype ClId STR )
;---------------------

( deftype Db FF Id X )
;---------------------

( deftype X ALT Ent Rel )
;---------------------

( deftype Ent TUP
  ( F FF Key Tuple )
)
;---------------------

( deftype Tuple FF At Val )
;---------------------

( deftype Rel TUP
  ( R SET XTuple )
)
;---------------------

( deftype XTuple TUP
  ( K FKTuple )
  ( A Tuple )
)
;---------------------

( deftype FKTuple FF Id Key )
;---------------------
; temporal stuff

( deftype TDb FF Id TX )
;---------------------

( deftype TX ALT TEnt TRel )
;---------------------

( deftype TEnt TUP
  ( F FF Key TTuple )
)
;---------------------

( deftype TTuple FF Dat Tuple )
;---------------------

( deftype TRel TUP
  ( R SET TXTuple )
)
;---------------------

( deftype TXTuple TUP
  ( T Dat )
  ( K FF Id Key )
  ( A FF At Val )
)
;---------------------
; temporal and atemporal stuff

( deftype XTX ALT Ent Rel TEnt TRel )
;---------------------

( deftype SONAE TUP
  ( BDC TDb )
  ( D Db )
  ( C FF ClId Cliente )
  ( T Dat )
)
;---------------------

( deftype Cliente TUP
  ( LD Dat )
  ( B Db )
)
;---------------------
;------- but~oes -----------------------------------------------

( def vv lambda
  ( )
  ( sh "vi x.cam" )
)
;---------------------

( def v lambda
  ( )
  ( vi "x.cam" )
)
;---------------------
;------- ac,~oes -----------------------------------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote HELP )
        ( quote
          (
            ( )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def HELP lambda
  ( )
  ( dumpTupSet
    ( makeset
      ( makeff
        ( "Comando" "HELP" )
        ( "Descricao" "Funcionalidade" )
      )
      ( makeff
        ( "Comando" "INIT" )
        ( "Descricao" "Arranque" )
      )
      ( makeff
        ( "Comando" "BDCSCHEMA" )
        ( "Descricao" "Esquema da BDC" )
      )
      ( makeff
        ( "Comando" "BDCSETDATE" )
        ( "P1" "Dat" )
        ( "Descricao" "Actualiza data" )
      )
      ( makeff
        ( "Comando" "BDCSCHEMA" )
        ( "Descricao" "Esquema da BDC" )
      )
      ( makeff
        ( "Comando" "BDCADDENT" )
        ( "P1" "Id" )
        ( "P2" "Key" )
        ( "P3" "Dat" )
        ( "P4" "Tuple" )
        ( "Descricao" "Acrescenta entidade `a BDC" )
      )
      ( makeff
        ( "Comando" "BDCADDREL" )
        ( "P1" "Id" )
        ( "P2" "Dat" )
        ( "P3" "Id->Key" )
        ( "P4" "Tuple" )
        ( "Descricao" "Acrescenta relacionamento `a BDC" )
      )
      ( makeff
        ( "Comando" "BDCRULES" )
        ( "Descricao" "*** experiemental ***" )
      )
      ( makeff
        ( "Comando" "BDCDELENT" )
        ( "P1" "Id" )
        ( "P2" "Key" )
        ( "P3" "Dat" )
        ( "Descricao" "*** experiemental ***" )
      )
      ( makeff
        ( "Comando" "BDCHIST" )
        ( "P1" "Id" )
        ( "Descricao" "Historico de" )
      )
      ( makeff
        ( "Comando" "BDCSNAP" )
        ( "P1" "Id" )
        ( "P2" "Dat" )
        ( "Descricao" "'Snapshot' na BDC de" )
      )
      ( makeff
        ( "Comando" "DUMP" )
        ( "P1" "STR" )
        ( "Descricao" "'Dump' da BDC ou Cliente" )
      )
      ( makeff
        ( "Comando" "CLISTAT" )
        ( "Descricao" "Estado dos Clientes" )
      )
      ( makeff
        ( "Comando" "CLIBACKLOG" )
        ( "P1" "ClId" )
        ( "Descricao" "Desfazamento de Cliente" )
      )
      ( makeff
        ( "Comando" "CLIUPDATE" )
        ( "P1" "ClId" )
        ( "Descricao" "Difusao para Cliente" )
      )
      ( makeff
        ( "Comando" "CLISNAP" )
        ( "P2" "Id" )
        ( "P1" "ClId" )
        ( "Descricao" "Consulta de E/R em Cliente" )
      )
      ( makeff )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote CLISTAT )
        ( quote
          (
            ( )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def CLISTAT lambda
  ( )
  ( let
    (
      ( cf
        ( C sonae )
      )
      ( r
        ( set
          ( makeff
            ( "Cliente" i )
            ( "Ultima Difusao"
              ( Dat2str
                ( LD
                  ( ap cf i )
                )
              )
            )
          )
          ( from i
            ( dom cf )
          )
        )
      )
    )
    ( dumpTupSet
      ( union r
        ( makeset
          ( makeff
            ( "Data actual"
              ( Dat2str
                ( T sonae )
              )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCRULES )
        ( quote
          (
            ( )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCRULES lambda
  ( )
  ( dumpTupSet
    ( makeset
      ( makeff
        ( "Operacao" "ACTIVAARTIGO" )
        ( "Parametro" "a" )
        ( "Ocorre" ">=1" )
        ( "FK" "#ARTIGO" )
        ( "Rel" "GAMA LOJA" )
      )
      ( makeff
        ( "Operacao" "ACTIVAARTIGO" )
        ( "Parametro" "a" )
        ( "Ocorre" ">=1" )
        ( "FK" "#ARTIGO" )
        ( "Rel" "UNIDADE FORNECIMENTO" )
      )
      ( makeff
        ( "Operacao" "ELIMINAARTIGO" )
        ( "Parametro" "a" )
        ( "Ocorre" "0" )
        ( "FK" "#ARTIGO" )
        ( "Rel" "GAMA LOJA" )
      )
      ( makeff
        ( "Operacao" "ELIMINAARTIGO" )
        ( "Parametro" "a" )
        ( "Ocorre" "0" )
        ( "FK" "#ARTIGO" )
        ( "Rel" "UNIDADE FORNECIMENTO" )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCSCHEMA )
        ( quote
          (
            ( )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCSCHEMA lambda
  ( )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( re
        ( set
          ( XTXschema i
            ( ap nbdc i )
          )
          ( from i
            ( dom nbdc )
            ( is TEnt
              ( ap nbdc i )
            )
          )
        )
      )
      ( rr
        ( set
          ( XTXschema i
            ( ap nbdc i )
          )
          ( from i
            ( dom nbdc )
            ( is TRel
              ( ap nbdc i )
            )
          )
        )
      )
    )
    ( progn
      ( dumpTupSet re )
      ( dumpTupSet rr )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCSETDATE )
        ( quote
          (
            (
              ( Dat )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCSETDATE lambda
  ( d )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( db
        ( D sonae )
      )
      ( cs
        ( C sonae )
      )
      ( t
        ( T sonae )
      )
    )
    ( if
      ( ltDat d t )
      ( error "" "N~ao se pode modificar o passado" )
      ( def sonae
        ( SONAE nbdc db cs d )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote CLIUPDATE )
        ( quote
          (
            (
              ( ClId )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def CLIUPDATE lambda
  ( i )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( db
        ( D sonae )
      )
      ( cs
        ( C sonae )
      )
      ( t
        ( T sonae )
      )
    )
    ( if
      ( not
        ( member i
          ( dom cs )
        )
      )
      ( error i "Cliente desconhecido" )
      ( let
        (
          ( c
            ( ap cs i )
          )
          ( ld
            ( LD c )
          )
          ( bd
            ( B c )
          )
          ( f
            ( TDbInterval nbdc ld t )
          )
        )
        ( if
          ( equal f
            ( makeff )
          )
          ( warning i "Cliente est'a actualizado" )
          ( let
            (
              ( nbd
                ( DbPlus bd f )
              )
              ( ncs
                ( plus cs
                  ( makeff
                    ( i
                      ( Cliente t nbd )
                    )
                  )
                )
              )
            )
            ( def sonae
              ( SONAE nbdc db ncs t )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote CLIBACKLOG )
        ( quote
          (
            (
              ( ClId )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def CLIBACKLOG lambda
  ( i )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( db
        ( D sonae )
      )
      ( cs
        ( C sonae )
      )
      ( t
        ( T sonae )
      )
    )
    ( if
      ( not
        ( member i
          ( dom cs )
        )
      )
      ( error i "Cliente desconhecido" )
      ( let
        (
          ( c
            ( ap cs i )
          )
          ( ld
            ( LD c )
          )
          ( f
            ( TDbInterval nbdc ld t )
          )
        )
        ( if
          ( equal f
            ( makeff )
          )
          ( warning i "Cliente est'a actualizado" )
          ( let
            (
              ( l
                ( seq
                  ( append
                    ( makeseq
                      ( strcat i ":\n" )
                    )
                    ( relBrowse
                      ( XTX2TupleSet i
                        ( ap f i )
                      )
                    )
                  )
                  ( from i
                    ( dom f )
                  )
                )
              )
            )
            ( foreach x l
              ( stdDump x )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DUMP )
        ( quote
          (
            (
              ( STR )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def DUMP lambda
  ( o )
  ( let
    (
      ( f
        ( if
          ( equal o "BDC" )
          ( BDC sonae )
          ( if
            ( member o
              ( dom
                ( C sonae )
              )
            )
            ( B
              ( ap
                ( C sonae ) o
              )
            )
            ( makeff )
          )
        )
      )
      ( l
        ( seq
          ( append
            ( makeseq
              ( strcat i ":\n" )
            )
            ( relBrowse
              ( XTX2TupleSet i
                ( ap f i )
              )
            )
          )
          ( from i
            ( dom f )
          )
        )
      )
    )
    ( if
      ( equal f
        ( makeff )
      )
      ( error o "Cliente desconhecido ou vazio" )
      ( foreach x l
        ( stdDump x )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCHIST )
        ( quote
          (
            (
              ( Id )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCHIST lambda
  ( i )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
    )
    ( if
      ( not
        ( member i
          ( dom nbdc )
        )
      )
      ( error i "Entidade/relacao desconhecida" )
      ( dumpTupSet
        ( XTX2TupleSet i
          ( ap nbdc i )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCSNAP )
        ( quote
          (
            (
              ( Id )
              ( Dat )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCSNAP lambda
  ( i d )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
    )
    ( if
      ( not
        ( member i
          ( dom nbdc )
        )
      )
      ( error i "Entidade/rela,c~ao desconhecida" )
      ( dumpTupSet
        ( XTX2TupleSet i
          ( TX2Xd
            ( ap nbdc i ) d
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote CLISNAP )
        ( quote
          (
            (
              ( ClId )
              ( Id )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def CLISNAP lambda
  ( c i )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( cs
        ( C sonae )
      )
    )
    ( if
      ( not
        ( member c
          ( dom cs )
        )
      )
      ( error c "Cliente desconhecido" )
      ( let
        (
          ( cl
            ( ap cs c )
          )
          ( db
            ( B cl )
          )
        )
        ( if
          ( not
            ( member i
              ( dom db )
            )
          )
          ( error i "Entidade/rela,c~ao desconhecida" )
          ( dumpTupSet
            ( XTX2TupleSet i
              ( ap db i )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCADDENT )
        ( quote
          (
            (
              ( Id )
              ( Key )
              ( Dat )
              ( Tuple )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCADDENT lambda
  ( e k d tu )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( db
        ( D sonae )
      )
      ( cs
        ( C sonae )
      )
      ( t
        ( T sonae )
      )
      ( te
        ( if
          ( not
            ( member e
              ( dom nbdc )
            )
          )
          ( makeff )
          ( F
            ( ap nbdc e )
          )
        )
      )
      ( tt
        ( if
          ( member k
            ( dom te )
          )
          ( ap te k )
          ( makeff )
        )
      )
      ( nte
        ( plus te
          ( makeff
            ( k
              ( plus tt
                ( makeff
                  ( d tu )
                )
              )
            )
          )
        )
      )
      ( nnbdc
        ( plus nbdc
          ( makeff
            ( e
              ( TEnt nte )
            )
          )
        )
      )
    )
    ( def sonae
      ( SONAE nnbdc db cs t )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCDELENT )
        ( quote
          (
            (
              ( Id )
              ( Key )
              ( Dat )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCDELENT lambda
  ( e k d )
  ( let
    (
      ( nbdc
        ( BDC sonae )
      )
      ( db
        ( D sonae )
      )
      ( cs
        ( C sonae )
      )
      ( t
        ( T sonae )
      )
      ( te
        ( if
          ( not
            ( member e
              ( dom nbdc )
            )
          )
          ( makeff )
          ( F
            ( ap nbdc e )
          )
        )
      )
      ( tt
        ( if
          ( member k
            ( dom te )
          )
          ( ap te k )
          ( makeff )
        )
      )
      ( nte
        ( plus te
          ( makeff
            ( k
              ( plus tt
                ( makeff
                  ( d
                    ( makeff
                      ( "Morte" "*" )
                    )
                  )
                )
              )
            )
          )
        )
      )
      ( nnbdc
        ( plus nbdc
          ( makeff
            ( e
              ( TEnt nte )
            )
          )
        )
      )
    )
    ( def sonae
      ( SONAE nnbdc db cs t )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote BDCADDREL )
        ( quote
          (
            (
              ( Id )
              ( Dat )
              ( FF Id Key )
              ( Tuple )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def BDCADDREL lambda
  ( r d k a )
  ( if
    ( let
      (
        ( nbdc
          ( BDC sonae )
        )
        ( b
          ( if
            ( member r
              ( dom nbdc )
            )
            ( let
              (
                ( kk
                  ( K
                    ( choice
                      ( R
                        ( ap nbdc r )
                      )
                    )
                  )
                )
              )
              ( equal
                ( dom k )
                ( dom kk )
              )
            )
            ( subset
              ( dom k )
              ( set i
                ( from i
                  ( dom nbdc )
                  ( is TEnt
                    ( ap nbdc i )
                  )
                )
              )
            )
          )
        )
      )
      ( if
        ( not b ) false
        ( forall
          ( set
            ( TEntExists
              ( ap k i )
              ( ap nbdc i ) d
            )
            ( from i
              ( dom k )
            )
          )
        )
      )
    )
    ( let
      (
        ( nbdc
          ( BDC sonae )
        )
        ( db
          ( D sonae )
        )
        ( cs
          ( C sonae )
        )
        ( t
          ( T sonae )
        )
        ( tr
          ( if
            ( not
              ( member r
                ( dom nbdc )
              )
            )
            ( makeset )
            ( R
              ( ap nbdc r )
            )
          )
        )
        ( ntr
          ( union tr
            ( makeset
              ( TXTuple d k a )
            )
          )
        )
        ( nnbdc
          ( plus nbdc
            ( makeff
              ( r
                ( TRel ntr )
              )
            )
          )
        )
      )
      ( def sonae
        ( SONAE nnbdc db cs t )
      )
    )
    ( error r "Relacionamento inconsistente" )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote INIT )
        ( quote
          (
            ( )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def INIT lambda
  ( )
  ( progn
    ( def sonae
      ( SONAE
        ( makeff )
        ( makeff )
        ( ff1
          ( list x
            ( Cliente
              ( Dat 90 1 1 )
              ( makeff )
            )
          )
          ( from x
            ( makeset "C1" "C2" "C3" )
          )
        )
        ( Dat 96 3 1 )
      )
    )
    ( BDCADDENT "UNIDADE" "2x3"
      ( Dat 95 2 26 )
      ( makeff
        ( "Nome" "Grupo 2 x 3 unidades" )
      )
    )
    ( BDCADDENT "UNIDADE" "3x4"
      ( Dat 95 2 26 )
      ( makeff
        ( "Nome" "Caixa 3 x 4 unidades" )
      )
    )
    ( BDCADDENT "LOJA" "L1"
      ( Dat 95 2 26 )
      ( makeff
        ( "Nome" "Modelo" )
        ( "Endereco" "Braga" )
      )
    )
    ( BDCADDENT "LOJA" "L2"
      ( Dat 94 2 26 )
      ( makeff
        ( "Nome" "Pingo Doce" )
        ( "Endereco" "Porto" )
      )
    )
    ( BDCADDENT "ARTIGO" "2000023"
      ( Dat 92 1 1 )
      ( makeff
        ( "Descricao" "Pessego Ramirez em lata" )
        ( "IVA" "16" )
      )
    )
    ( BDCADDENT "ARTIGO" "2000023"
      ( Dat 93 1 1 )
      ( makeff
        ( "Descricao" "Pessego Ramirez em lata" )
        ( "IVA" "17" )
      )
    )
    ( BDCADDENT "ARTIGO" "2000023"
      ( Dat 94 1 1 )
      ( makeff
        ( "Descricao" "Pessego Ramirez" )
        ( "IVA" "17" )
      )
    )
    ( BDCADDENT "ARTIGO" "2000023"
      ( Dat 96 12 1 )
      ( makeff
        ( "Descricao" "Pessego Ramirez em calda" )
        ( "IVA" "17" )
      )
    )
    ( BDCADDENT "ARTIGO" "2000024"
      ( Dat 96 2 12 )
      ( makeff
        ( "Descricao" "Atum Bom-Petisco" )
        ( "IVA" "17" )
      )
    )
    ( BDCADDENT "FORNECEDOR" "XYZ Ltd"
      ( Dat 96 2 14 )
      ( makeff
        ( "Razao Social" "Nao sei" )
      )
    )
    ( BDCADDENT "FORNECEDOR" "XXX&Cia"
      ( Dat 96 2 26 )
      ( makeff
        ( "Razao Social" "?" )
      )
    )
    ( BDCADDREL "GAMA LOJA"
      ( Dat 96 2 21 )
      ( makeff
        ( "LOJA" "L1" )
        ( "ARTIGO" "2000023" )
      )
      ( makeff
        ( "Obs." "ok" )
      )
    )
    ( BDCADDREL "GAMA LOJA"
      ( Dat 96 2 12 )
      ( makeff
        ( "LOJA" "L2" )
        ( "ARTIGO" "2000023" )
      )
      ( makeff )
    )
    ( BDCADDREL "UNIDADE FORNECIMENTO"
      ( Dat 98 1 1 )
      ( makeff
        ( "FORNECEDOR" "XYZ Ltd" )
        ( "ARTIGO" "2000024" )
        ( "UNIDADE" "3x4" )
      )
      ( makeff
        ( "Preco" "$" )
      )
    )
    ( BDCADDREL "UNIDADE FORNECIMENTO"
      ( Dat 98 2 12 )
      ( makeff
        ( "FORNECEDOR" "XYZ Ltd" )
        ( "ARTIGO" "2000023" )
        ( "UNIDADE" "2x3" )
      )
      ( makeff
        ( "Preco" "$" )
      )
    )
    ( BDCADDREL "GAMA LOJA"
      ( Dat 96 2 17 )
      ( makeff
        ( "LOJA" "L1" )
        ( "ARTIGO" "2000024" )
      )
      ( makeff )
    )
    ( CLIUPDATE "C1" )
    ( CLIUPDATE "C2" )
    ( CLIUPDATE "C3" )
    ( dumpTupSet
      ( makeset
        ( makeff
          ( "Projecto" "NBDC/SONAE" )
          ( "Versao" "1.0" )
          ( "Obs." "'Valid time' apenas" )
          ( "Arranque" "OK" )
          ( "Data Corrente"
            ( Dat2str
              ( T sonae )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote XTXschema )
        ( quote
          (
            (
              ( Id )
              ( XTX )
            )
            ( Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def XTXschema lambda
  ( i x )
  ( if
    ( is Ent x )
    ( let
      (
        ( y
          ( F x )
        )
      )
      ( plus
        ( makeff
          ( "Entidade" i )
        )
        ( ff1
          ( list a "A" )
          ( from a
            ( atributos
              ( ran y )
            )
          )
        )
      )
    )
    ( if
      ( is Rel x )
      ( let
        (
          ( j
            ( strcat "#" i )
          )
          ( r
            ( R x )
          )
          ( kr
            ( set
              ( K xt )
              ( from xt r )
            )
          )
          ( fks
            ( set
              ( strcat "#" i )
              ( from i
                ( dom
                  ( choice kr )
                )
              )
            )
          )
          ( X
            ( atributos
              ( set
                ( A xt )
                ( from xt r )
              )
            )
          )
        )
        ( plus
          ( plus
            ( makeff
              ( "Relacao" i )
            )
            ( ff1
              ( list j "FK" )
              ( from j fks )
            )
          )
          ( ff1
            ( list a "A" )
            ( from a X )
          )
        )
      )
      ( if
        ( is TRel x )
        ( let
          (
            ( r
              ( R x )
            )
            ( nr
              ( set
                ( XTuple
                  ( K t )
                  ( A t )
                )
                ( from t r )
              )
            )
          )
          ( XTXschema i
            ( Rel nr )
          )
        )
        ( let
          (
            ( f
              ( F x )
            )
            ( nf
              ( ff1
                ( list k
                  ( PLUS
                    ( ran
                      ( ap f k )
                    )
                  )
                )
                ( from k
                  ( dom f )
                )
              )
            )
          )
          ( XTXschema i
            ( Ent nf )
          )
        )
      )
    )
  )
)
;---------------------
;PRE k in dom(F(e))
; let (xxx=princ("\nTEntExists k=",k)) in

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TEntExists )
        ( quote
          (
            (
              ( Key )
              ( TEnt )
              ( Dat )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def TEntExists lambda
  ( k e d )
  ( let
    (
      ( tt
        ( ap
          ( F e ) k
        )
      )
      ( m
        ( DatMIN
          ( dom tt )
        )
      )
    )
    ( leqDat m d )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TX2Xdaux )
        ( quote
          (
            (
              ( TEnt )
              ( Key )
              ( Dat )
            )
            ( Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TX2Xdaux lambda
  ( f k d )
  ( let
    (
      ( tt
        ( ap f k )
      )
      ( ntt
        ( ff1
          ( list t
            ( ap tt t )
          )
          ( from t
            ( dom tt )
            ( leqDat t d )
          )
        )
      )
      ( t
        ( DatMAX
          ( dom ntt )
        )
      )
    )
    ( ap ntt t )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TX2Xd )
        ( quote
          (
            (
              ( TX )
              ( Dat )
            )
            ( X )
          )
        )
      )
    )
  )
)
;---------------------

( def TX2Xd lambda
  ( tx d )
  ( if
    ( is TRel tx )
    ( let
      (
        ( r
          ( R tx )
        )
      )
      ( Rel
        ( set
          ( XTuple
            ( K t )
            ( A t )
          )
          ( from t r
            ( leqDat
              ( T t ) d
            )
          )
        )
      )
    )
    ( let
      (
        ( f
          ( F tx )
        )
        ( ff
          ( ff1
            ( list k
              ( TX2Xdaux f k d )
            )
            ( from k
              ( dom f )
            )
          )
        )
      )
      ( Ent
        ( ff1
          ( list k
            ( ap ff k )
          )
          ( from k
            ( dom ff )
            ( nequal
              ( ap ff k )
              ( makeff )
            )
          )
        )
      )
    )
  )
)
;---------------------
;nb: lets em ffs por compreensao

( def dumpTupSet lambda
  ( s )
  ( stdDump
    ( relBrowse s )
  )
)
;---------------------
;,xxx=princ("strlen=",strlen(hline),"\n")

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote relBrowse )
        ( quote
          (
            (
              ( SET Tuple )
            )
            ( LIST STR )
          )
        )
      )
    )
  )
)
;---------------------

( def relBrowse lambda
  ( r )
  ( if
    ( equal r
      ( makeset )
    )
    ( makeseq "No records found" )
    ( let
      (
        ( A
          ( atributos r )
        )
        ( x
          ( ff1
            ( list a
              ( add 2
                ( MAX
                  ( set
                    ( strlen v )
                    ( from v
                      ( union
                        ( makeset a )
                        ( valores a r )
                      )
                    )
                  )
                )
              )
            )
            ( from a A )
          )
        )
        ( L
          ( seq a
            ( from a A )
          )
        )
        ( hline
          ( Strcat
            ( append
              ( seq
                ( strcat "+"
                  ( strfill "-"
                    ( ap x a )
                  )
                )
                ( from a L )
              )
              ( makeseq "+\n" )
            )
          )
        )
      )
      ( append
        ( append
          ( makeseq hline
            ( Strcat
              ( append
                ( seq
                  ( strcat "|"
                    ( strcenter a
                      ( ap x a )
                    )
                  )
                  ( from a L )
                )
                ( makeseq "|\n" )
              )
            ) hline
          )
          ( seq
            ( Strcat
              ( append
                ( seq
                  ( strcat "|"
                    ( strcenter
                      ( if
                        ( member a
                          ( dom t )
                        )
                        ( ap t a ) ""
                      )
                      ( ap x a )
                    )
                  )
                  ( from a L )
                )
                ( makeseq "|\n" )
              )
            )
            ( from t r )
          )
        )
        ( makeseq hline )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote EntPlus )
        ( quote
          (
            (
              ( Ent )
              ( Ent )
            )
            ( Ent )
          )
        )
      )
    )
  )
)
;---------------------

( def EntPlus lambda
  ( e1 e2 )
  ( let
    (
      ( f1
        ( F e1 )
      )
      ( f2
        ( F e2 )
      )
    )
    ( Ent
      ( plus f1 f2 )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote RelPlus )
        ( quote
          (
            (
              ( Rel )
              ( Rel )
            )
            ( Rel )
          )
        )
      )
    )
  )
)
;---------------------

( def RelPlus lambda
  ( e1 e2 )
  ( let
    (
      ( r1
        ( R e1 )
      )
      ( r2
        ( R e2 )
      )
    )
    ( Rel
      ( union r1 r2 )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DbPlus )
        ( quote
          (
            (
              ( Db )
              ( Db )
            )
            ( Db )
          )
        )
      )
    )
  )
)
;---------------------

( def DbPlus lambda
  ( db1 db2 )
  ( let
    (
      ( I
        ( intersection
          ( dom db1 )
          ( dom db2 )
        )
      )
    )
    ( plus
      ( plus
        ( plus
          ( ds db1 I )
          ( ds db2 I )
        )
        ( ff1
          ( list i
            ( EntPlus
              ( ap db1 i )
              ( ap db2 i )
            )
          )
          ( from i I
            ( is Ent
              ( ap db1 i )
            )
          )
        )
      )
      ( ff1
        ( list i
          ( RelPlus
            ( ap db1 i )
            ( ap db2 i )
          )
        )
        ( from i I
          ( is Rel
            ( ap db1 i )
          )
        )
      )
    )
  )
)
;---------------------
; PRE d1 <= d2
; nb: ver isto

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TDbInterval )
        ( quote
          (
            (
              ( TDb )
              ( Dat )
              ( Dat )
            )
            ( Db )
          )
        )
      )
    )
  )
)
;---------------------

( def TDbInterval lambda
  ( tdb d1 d2 )
  ( if
    ( equal d1 d2 )
    ( makeff )
    ( let
      (
        ( f
          ( ff1
            ( list i
              ( TXInterval
                ( ap tdb i ) d1 d2
              )
            )
            ( from i
              ( dom tdb )
            )
          )
        )
      )
      ( ff1
        ( list i
          ( ap f i )
        )
        ( from i
          ( dom f )
          ( let
            (
              ( x
                ( ap f i )
              )
            )
            ( if
              ( is Rel x )
              ( nequal
                ( R x )
                ( makeset )
              )
              ( nequal
                ( F x )
                ( makeff )
              )
            )
          )
        )
      )
    )
  )
)
;---------------------
;let (xxx=princ("\nTXInterval=",d1,d2)) in

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TXInterval )
        ( quote
          (
            (
              ( TX )
              ( Dat )
              ( Dat )
            )
            ( X )
          )
        )
      )
    )
  )
)
;---------------------

( def TXInterval lambda
  ( tx d1 d2 )
  ( if
    ( is TRel tx )
    ( let
      (
        ( r
          ( R tx )
        )
      )
      ( Rel
        ( set
          ( XTuple
            ( K t )
            ( A t )
          )
          ( from t r
            ( and
              ( leqDat
                ( T t ) d2
              )
              ( gtDat
                ( T t ) d1
              )
            )
          )
        )
      )
    )
    ( let
      (
        ( f
          ( F tx )
        )
        ( ff
          ( ff1
            ( list k
              ( TX2Xdd f k d1 d2 )
            )
            ( from k
              ( dom f )
            )
          )
        )
      )
      ( Ent
        ( ff1
          ( list k
            ( ap ff k )
          )
          ( from k
            ( dom ff )
            ( nequal
              ( ap ff k )
              ( makeff )
            )
          )
        )
      )
    )
  )
)
;---------------------
;nb: simplificar!

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TX2Xdd )
        ( quote
          (
            (
              ( TEnt )
              ( Key )
              ( Dat )
              ( Dat )
            )
            ( Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TX2Xdd lambda
  ( f k d1 d2 )
  ( let
    (
      ( tt
        ( ap f k )
      )
      ( ntt
        ( ff1
          ( list t
            ( ap tt t )
          )
          ( from t
            ( dom tt )
            ( and
              ( leqDat t d2 )
              ( gtDat t d1 )
            )
          )
        )
      )
      ( t
        ( DatMAX
          ( dom ntt )
        )
      )
    )
    ( ap ntt t )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TDb2Db )
        ( quote
          (
            (
              ( TDb )
            )
            ( Db )
          )
        )
      )
    )
  )
)
;---------------------

( def TDb2Db lambda
  ( tdb )
  ( ff1
    ( list i
      ( TX2X
        ( ap tdb i )
      )
    )
    ( from i
      ( dom tdb )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TX2X )
        ( quote
          (
            (
              ( TX )
            )
            ( X )
          )
        )
      )
    )
  )
)
;---------------------

( def TX2X lambda
  ( tx )
  ( if
    ( is TRel tx )
    ( let
      (
        ( r
          ( R tx )
        )
      )
      ( Rel
        ( set
          ( XTuple
            ( K t )
            ( A t )
          )
          ( from t r )
        )
      )
    )
    ( let
      (
        ( f
          ( F tx )
        )
        ( ff
          ( ff1
            ( list k
              ( TTuple2Tuple
                ( ap f k )
              )
            )
            ( from k
              ( dom f )
            )
          )
        )
      )
      ( Ent ff )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TTuple2Tuple )
        ( quote
          (
            (
              ( TTuple )
            )
            ( Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TTuple2Tuple lambda
  ( tt )
  ( let
    (
      ( m
        ( DatMAX
          ( dom tt )
        )
      )
    )
    ( ap tt m )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TDb2TupSet )
        ( quote
          (
            (
              ( TDb )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TDb2TupSet lambda
  ( tdb )
  ( UNION
    ( set
      ( let
        (
          ( tx
            ( ap tdb i )
          )
        )
        ( if
          ( is TRel tx )
          ( TRel2TupSet tx )
          ( TEnt2TupSet i tx )
        )
      )
      ( from i
        ( dom tdb )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TDbBackLog )
        ( quote
          (
            (
              ( TDb )
              ( Dat )
              ( Dat )
            )
            ( TDb )
          )
        )
      )
    )
  )
)
;---------------------

( def TDbBackLog lambda
  ( tbd d1 d2 )
  ( error "!" "not yet" )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote Ent2TupSet )
        ( quote
          (
            (
              ( Id )
              ( Ent )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def Ent2TupSet lambda
  ( i x )
  ( let
    (
      ( j
        ( strcat "#" i )
      )
      ( f
        ( F x )
      )
    )
    ( set
      ( plus
        ( makeff
          ( j k )
        )
        ( ap f k )
      )
      ( from k
        ( dom f )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TRel2TupSet )
        ( quote
          (
            (
              ( TRel )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TRel2TupSet lambda
  ( x )
  ( set
    ( TXTuple2Tuple xt )
    ( from xt
      ( R x )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote Rel2TupSet )
        ( quote
          (
            (
              ( Rel )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def Rel2TupSet lambda
  ( x )
  ( set
    ( let
      (
        ( fk
          ( K y )
        )
        ( fa
          ( A y )
        )
      )
      ( plus
        ( jj fk ) fa
      )
    )
    ( from y
      ( R x )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote XTX2TupleSet )
        ( quote
          (
            (
              ( Id )
              ( XTX )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def XTX2TupleSet lambda
  ( i x )
  ( if
    ( is Ent x )
    ( Ent2TupSet i x )
    ( if
      ( is Rel x )
      ( Rel2TupSet x )
      ( if
        ( is TRel x )
        ( set
          ( TXTuple2Tuple xt )
          ( from xt
            ( R x )
          )
        )
        ( TEnt2TupSet i x )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TEnt2TupSet )
        ( quote
          (
            (
              ( Id )
              ( TEnt )
            )
            ( SET Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TEnt2TupSet lambda
  ( i x )
  ( let
    (
      ( j
        ( strcat "#" i )
      )
      ( f
        ( F x )
      )
    )
    ( UNION
      ( set
        ( set
          ( plus
            ( makeff
              ( j k )
              ( "Data Vigor"
                ( Dat2str d )
              )
            )
            ( ap
              ( ap f k ) d
            )
          )
          ( from d
            ( dom
              ( ap f k )
            )
          )
        )
        ( from k
          ( dom f )
        )
      )
    )
  )
)
;---------------------
;nb: por isto possivel?
;           in { [ j -> k, "Data Vigor" -> Dat2str(d) ] + (f[k])[d]
;                                               | k <- dom(f), d <- dom(f[k]) };

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote Browse )
        ( quote
          (
            (
              ( ClId )
              ( Id )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def Browse lambda
  ( i j )
  ( let
    (
      ( dbs
        ( B sonae )
      )
    )
    ( if
      ( not
        ( member i
          ( dom dbs )
        )
      )
      ( error i "base de dados desconhecida" )
      ( let
        (
          ( db
            ( ap dbs i )
          )
        )
        ( if
          ( not
            ( member j
              ( dom db )
            )
          )
          ( error j "tabela desconhecida" )
          ( dumpTupSet
            ( XTX2TupleSet j
              ( ap db j )
            )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote TXTuple2Tuple )
        ( quote
          (
            (
              ( TXTuple )
            )
            ( Tuple )
          )
        )
      )
    )
  )
)
;---------------------

( def TXTuple2Tuple lambda
  ( t )
  ( plus
    ( plus
      ( makeff
        ( "Data Vigor"
          ( Dat2str
            ( T t )
          )
        )
      )
      ( jj
        ( K t )
      )
    )
    ( A t )
  )
)
;---------------------
;RETURN let (r= { < strcat("#",k), fk[k] > | k <- dom(fk) })
;       in [ p1(t) -> p2(t) | t <- r ];

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote jj )
        ( quote
          (
            (
              ( FF )
            )
            ( FF )
          )
        )
      )
    )
  )
)
;---------------------

( def jj lambda
  ( fk )
  ( if
    ( equal fk
      ( makeff )
    )
    ( makeff )
    ( let
      (
        ( k
          ( choice
            ( dom fk )
          )
        )
        ( kk
          ( strcat "#" k )
        )
      )
      ( plus
        ( makeff
          ( kk
            ( ap fk k )
          )
        )
        ( jj
          ( ds fk
            ( makeset k )
          )
        )
      )
    )
  )
)
;---------------------
;RETURN [ p2(k) -> ff[k] | k <- dom(ff) ]

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote jno2 )
        ( quote
          (
            (
              ( FF )
            )
            ( FF )
          )
        )
      )
    )
  )
)
;---------------------

( def jno2 lambda
  ( ff )
  ( if
    ( equal ff
      ( makeff )
    )
    ( makeff )
    ( let
      (
        ( k
          ( choice
            ( dom ff )
          )
        )
        ( nk
          ( second k )
        )
      )
      ( plus
        ( makeff
          ( nk
            ( ap fk k )
          )
        )
        ( jno2
          ( ds ff
            ( makeset k )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote error )
        ( quote
          (
            (
              ( STR )
              ( STR )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def error lambda
  ( s m )
  ( dumpTupSet
    ( makeset
      ( makeff
        ( "Mensagem" "Erro" )
        ( "Id" s )
        ( "Obs." m )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote warning )
        ( quote
          (
            (
              ( STR )
              ( STR )
            )
            ( SYM )
          )
        )
      )
    )
  )
)
;---------------------

( def warning lambda
  ( s m )
  ( dumpTupSet
    ( makeset
      ( makeff
        ( "Mensagem" "Aviso" )
        ( "Id" s )
        ( "Obs." m )
      )
    )
  )
)
;---------------------
;------- STR extra functionality ----------------------------------------------
; Strcat : STR-list --> STR-list

( def Strcat lambda
  ( l )
  ( if
    ( equal l
      ( makeseq )
    ) ""
    ( strcat
      ( head l )
      ( Strcat
        ( tail l )
      )
    )
  )
)
;---------------------

( def stdDump lambda
  ( l )
  ( progn
    ( foreach s l
      ( progn
        ( princ s )
      )
    ) ""
  )
)
;---------------------
; pre: l >= strlen(s)

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote strcenter )
        ( quote
          (
            (
              ( STR )
              ( INT )
            )
            ( STR )
          )
        )
      )
    )
  )
)
;---------------------

( def strcenter lambda
  ( s l )
  ( if
    ( equal l
      ( strlen s )
    ) s
    ( let
      (
        ( x
          ( sub l
            ( strlen s )
          )
        )
        ( m
          ( div x 2 )
        )
        ( r
          ( rem x 2 )
        )
        ( n
          ( add m r )
        )
      )
      ( strcat
        ( strfill " " m ) s
        ( strfill " " n )
      )
    )
  )
)
;---------------------
; pre: l >= strlen(s)

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote strleft )
        ( quote
          (
            (
              ( STR )
              ( INT )
            )
            ( STR )
          )
        )
      )
    )
  )
)
;---------------------

( def strleft lambda
  ( s l )
  ( if
    ( equal l
      ( strlen s )
    ) s
    ( strcat
      ( strleft s
        ( sub l 1 )
      ) " "
    )
  )
)
;---------------------
;if l==0 then "" else strcat(s,strfill(s,l.-1));

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote strfill )
        ( quote
          (
            (
              ( STR )
              ( INT )
            )
            ( STR )
          )
        )
      )
    )
  )
)
;---------------------

( def strfill lambda
  ( s l )
  ( progn
    ( def x "" )
    ( def n l )
    ( while
      ( gt n 0 )
      ( progn
        ( def x
          ( strcat s x )
        )
        ( def n
          ( sub n 1 )
        )
      )
    ) x
  )
)
;---------------------
;------- BOOL extra functionality ----------------------------------------------

( def forall lambda
  ( B )
  ( subset B
    ( makeset true )
  )
)
;---------------------
;------- INT extra functionality ----------------------------------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote MAX )
        ( quote
          (
            (
              ( SET INT )
            )
            ( INT )
          )
        )
      )
    )
  )
)
;---------------------

( def MAX lambda
  ( s )
  ( MAXloop s 0 )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote MAXloop )
        ( quote
          (
            (
              ( SET INT )
              ( INT )
            )
            ( INT )
          )
        )
      )
    )
  )
)
;---------------------

( def MAXloop lambda
  ( s m )
  ( if
    ( equal s
      ( makeset )
    ) m
    ( let
      (
        ( x
          ( choice s )
        )
      )
      ( MAXloop
        ( difference s
          ( makeset x )
        )
        ( max x m )
      )
    )
  )
)
;---------------------
;------- funcoes polimorficas primitivas -----------------------

( def PLUS lambda
  ( s )
  ( if
    ( equal s
      ( makeset )
    )
    ( makeff )
    ( reduce
      ( makeff ) plus s
    )
  )
)
;---------------------
; valores: A x (A->B)-set --> B-set

( def valores lambda
  ( a r )
  ( set
    ( ap t a )
    ( from t r
      ( member a
        ( dom t )
      )
    )
  )
)
;---------------------
; atributos: (A->B)-set --> A-set 

( def atributos lambda
  ( r )
  ( UNION
    ( set
      ( dom t )
      ( from t r )
    )
  )
)
;---------------------
;---------- Dat Functionality --------------------------------------------------

( deftype Dat TUP
  ( Y INT )
  ( M INT )
  ( D INT )
)
;---------------------

( def leqDat lambda
  ( d e )
  ( or
    ( equal d e )
    ( ltDat d e )
  )
)
;---------------------

( def gtDat lambda
  ( d e )
  ( ltDat e d )
)
;---------------------

( def ltDat lambda
  ( d e )
  ( if
    ( lt
      ( Y d )
      ( Y e )
    ) 'true
    ( if
      ( gt
        ( Y d )
        ( Y e )
      ) 'false
      ( if
        ( lt
          ( M d )
          ( M e )
        ) 'true
        ( if
          ( gt
            ( M d )
            ( M e )
          ) 'false
          ( lt
            ( D d )
            ( D e )
          )
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote Dat2str )
        ( quote
          (
            (
              ( Dat )
            )
            ( STR )
          )
        )
      )
    )
  )
)
;---------------------

( def Dat2str lambda
  ( d )
  ( let
    (
      ( y
        ( Y d )
      )
      ( m
        ( M d )
      )
      ( d
        ( D d )
      )
    )
    ( strcat
      ( itoa y )
      ( if
        ( gt m 9 ) "/" "/0"
      )
      ( itoa m )
      ( if
        ( gt d 9 ) "/" "/0"
      )
      ( itoa d )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DatMAX )
        ( quote
          (
            (
              ( SET Dat )
            )
            ( Dat )
          )
        )
      )
    )
  )
)
;---------------------

( def DatMAX lambda
  ( s )
  ( DatMAXloop s
    ( Dat 0 0 0 )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DatMAXloop )
        ( quote
          (
            (
              ( SET Dat )
              ( Dat )
            )
            ( Dat )
          )
        )
      )
    )
  )
)
;---------------------

( def DatMAXloop lambda
  ( s m )
  ( if
    ( equal s
      ( makeset )
    ) m
    ( let
      (
        ( x
          ( choice s )
        )
      )
      ( DatMAXloop
        ( difference s
          ( makeset x )
        )
        ( if
          ( ltDat x m ) m x
        )
      )
    )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DatMIN )
        ( quote
          (
            (
              ( SET Dat )
            )
            ( Dat )
          )
        )
      )
    )
  )
)
;---------------------

( def DatMIN lambda
  ( s )
  ( DatMINloop s
    ( Dat 9999 1 1 )
  )
)
;---------------------

( def _ops
  ( plus _ops
    ( makeff
      (
        ( quote DatMINloop )
        ( quote
          (
            (
              ( SET Dat )
              ( Dat )
            )
            ( Dat )
          )
        )
      )
    )
  )
)
;---------------------

( def DatMINloop lambda
  ( s m )
  ( if
    ( equal s
      ( makeset )
    ) m
    ( let
      (
        ( x
          ( choice s )
        )
      )
      ( DatMINloop
        ( difference s
          ( makeset x )
        )
        ( if
          ( ltDat x m ) x m
        )
      )
    )
  )
)
;---------------------

( INIT )
;---------------------

( BDCSETDATE
  ( Dat 96 3 2 )
)
;---------------------

( CLISTAT )
;---------------------

( BDCHIST "LOJA" )
;---------------------

( BDCADDENT "LOJA" "L1"
  ( Dat 96 3 2 )
  ( makeff
    ( "Nome" "Pingo Doce" )
  )
)
;---------------------

( BDCHIST "LOJA" )
;---------------------

( CLIBACKLOG "C1" )
;---------------------