(def aaa (_NDF1 (#Ca #Ca #Ca ) )) (def SHIFTUP (GETLCTXS INTERP )) (def GETLCTXS (#I' #C/03 #I? GETCTX-ENLINSTR (CONS ) )) (def PRINTLIST1 (REP NCONSPTHEN (Q #C TYO Q #C. TYO Q #C TYO PRINT Q #C) TYO ) (REP CAR PRINT #C TYO CDR PRINTLIST ) )) (def bcd (_NDF1 (#Cb #Cc #Cd ) )) (def OLDPRINT (REP NCONSPTHEN PROTO-PRINT (REP CAR Q A CAR EQ THEN (CDR CAR PRINTSTRING ) (Q #C( TYO PRINTLIST ) ) )) (def TAIL-OBLIST (_NDF1 (#CT #CA #CI #CL #C- #CO #CB #CL #CI #CS #CT ) )) (def ALT ALT2) (def va (_NDF1 (#Cv #Ca ) )) (def OBLIST (Q #C/02 #I? )) (def #I=) (def PRINT= (_NDF1 (#CP #CR #CI #CN #CT #C= ) )) (def topfi1 (_NDF1 (#Ct #Co #Cp #Cf #Ci #C1 ) )) (def GETDATE-fi (Q Date )) (def w (_NDF1 (#Cw ) )) (def READ-NLOAD (Q #C/03 #Ii READ Q #C/01 #Ii )) (def -NLOAD-x (_NDF1 (#C- #CN #CL #CO #CA #CD #C- #Cx ) )) (def INIT-NLOAD (Q #C/03 #Ii #I@ Q #C/01 #Ii )) (def NLOAD (Q #C/03 #If INIT-NLOAD Q #N ARG -NLOAD-x (Y (READ-NLOAD Q #C< TYO SETVQ -NLOAD-x (GETVQ -NLOAD-x NOT THEN J (GETVQ -NLOAD-x EXEC (Q #C> TYO ) ) ) ) Q #C/01 #Ii ) )) (def PRINTLENGTH (_NDF1 (#CP #CR #CI #CN #CT #CL #CE #CN #CG #CT #CH ) )) (def nprog (_NDF1 (#Cn #Cp #Cr #Co #Cg ) )) (def STEP-n (ARG ctx (GETVQ ctx CAR ARG strat (GETVQ ctx CDR CAR ARG prog (GETVQ prog CDR Q STEP CONS GETVQ prog CAR CONS ARG nprog (GETVQ ctx CDR CDR GETVQ nprog CONS GETVQ strat CONS ) ) ) ) )) (def xzabc (_NDF1 (#Cx #Cz #Ca #Cb #Cc ) )) (def zxb (_NDF1 (#Cz #Cx #Cb ) )) (def zxa (_NDF1 (#Cz #Cx #Ca ) )) (def zyx _NDF) (def abcdefxyz _NDF) (def _NDF1 (C Q (ARG x (Q (#CI #Cn #Cs #Ct #Cr #Cu #Cc #Ct #Ci #Co #Cn #C ) PRINTSTRING GETVQ x PRINTSTRING Q (#C #Cn #Co #Cn #C #Cd #Ce #Cf #Ci #Cn #Ci #Ce #C ) PRINTLINE ) ) )) (def aaaaa _NDF) (def _NDF (ECH REP Q #N ECH CONS Q _NDF1 CONS DES ECH MON )) (def jac #N) (def Date #N) (def cons #N) (def h #N) (def g #N) (def Z #N) (def X #N) (def UNBINDVQ #I/EC) (def BINDVQ #I/EB) (def GETVSQ #I/E9) (def qa #N) (def instr #N) (def INSTR-SKIP-STEP #N) (def PRINTSHORT (Q #C/05 PRINTLEVEL )) (def SKIP-STEP (ARG ctx (GETVQ ctx CDR CAR CAR ARG instr (GETVQ instr NCONSPTHEN (GETVQ instr #IF Q #C/F0 #I. #C/10 EQ ) (GETVQ instr CAR Q A CAR EQ NOT THEN (Q #T ) (GETVQ instr GETVQ INSTR-SKIP-STEP MEMBER ) ) ) ) )) (def abcdef #N) (def text #N) (def J #I/0A) (def Y #I/19) (def UNBINDVSENV #I/AC) (def BINDVSENV #I/AB) (def GETVSENV #I/A9) (def EVOL1 (Q #C/FF #IE )) (def GETVQ #N) (def verifient #N) (def contiennent #N) (def #N) (def non #N) (def ou #N) (def env1 #N) (def et #N) (def env #N) (def erreur (Q (#CE #Cr #Cr #Ce #Cu #Cr #C ) PRINTLINE Q #N )) (def verif (ARG critere (ARG env (ARG fiche (GETVQ env AND (GETVQ critere NCONSPTHEN (Q (#CC #Cr #Ci #Ct #Ce #Cr #Ce #C #Ci #Cn #Cc #Co #Cr #Cr #Ce #Cc #Ct #C ) PRINTLINE Q #N ) (GETVQ critere CAR Q et EQ THEN (GETVQ fiche GETVQ env GETVQ critere CDR CAR verif ARG env1 (GETVQ fiche GETVQ env1 GETVQ critere CDR CDR CAR verif ) ) (GETVQ critere CAR Q ou EQ THEN (GETVQ fiche GETVQ env GETVQ critere CDR CAR verif OR (GETVQ fiche GETVQ env GETVQ critere CDR CDR CAR verif ) ) (GETVQ critere CAR Q non EQ THEN (GETVQ fiche GETVQ env GETVQ critere CDR CAR verif THEN (Q #N ) (GETVQ env ) ) (GETVQ critere CAR Q titre EQ THEN (GETVQ critere CDR CAR NCONSPTHEN (Q #N ) (Q #T ) THEN (GETVQ fiche CAR GETVQ critere CDR CAR EQUAL AND (GETVQ env ) ) (GETVQ critere CDR CAR GETVQ env GETVENV ARG titre (GETVQ titre THEN (GETVQ fiche CAR GETVQ titre EQUAL THEN (GETVQ env ) (Q #N ) ) (GETVQ fiche CAR GETVQ critere CDR CAR GETVQ env ADDVENV ) ) ) ) (GETVQ critere CAR Q contiennent EQ THEN ((GETVQ fiche GETVQ critere CDR CAR depl contient (Q (GETVQ env GETVQ critere CDR CDR CAR verif ) ) ) (GETVQ critere CAR Q verifient EQ THEN (GETVQ fiche GETVQ critere CDR CAR depl (contient (Q ( GETVQ env GETVQ critere CDR CDR CAR verif NOT ) ) ) THEN (Q #N ) (GETVQ env ) ) (Q (#CC #Cr #Ci #Ct #Ce #Cr #Ce #C #Ci #Cn #Cc #Co #Cr #Cr #Ce #Cc #Ct #C ) PRINTLINE Q #N ) ) ) ) ) ) ) ) ) ) ) ) )) (def critere #N) (def extraire (C I (ARG -f (ARG -l (GETVQ -l NCONSPTHEN (GETVQ -l ) (GETVQ -l CAR GETVQ -f EXEC (GETVQ -l CDR extraire (GETVQ -f ) ECH THEN (GETVQ -l CAR CONS ) #N ) ) ) ) ) )) (def selection-a (Q (#CC #Cr #Ci #Ct #Ce #Cr #Ce #C #C? #C ) PRINTSTRING READ ARG critere (GETVQ SELECT extraire (Q (Q #T GETVQ critere verif ) ) ) )) (def selection-m (GETVQ SELECT extraire (Q (ARG fiche (GETVQ fiche af-resume1 Q (#CS #Ce #Cl #Ce #Cc #Ct #Ci #Co #Cn #Cn #Ce #Cr #C #C? #C ) READLINE CAR (#CO #Co ) MEMBER ) ) ) )) (def fiche1 #N) (def fiches #N) (def APPEND (REP NCONSPTHEN DEP (REP CAR DES CDR APPEND MON CONS ) )) (def dp-cu (ARG fiche (GETVQ fiches mapcan (Q (ARG fiche1 ((GETVQ fiche1 CDR CDR CDR CAR contient (Q (ARG correl (GETVQ correl CAR GETVQ SEUIL MOINS POSP AND (GETVQ correl CDR CAR GETVQ fiche EQ ) ) ) ) ) AND (Q #N GETVQ fiche1 CONS ) ) ) ) ) )) (def dp-ca (ARG fiche (GETVQ fiche CDR CDR CDR CAR mapcan (Q (ARG correl (GETVQ correl CAR GETVQ SEUIL MOINS POSP THEN (GETVQ correl CDR CAR ) (Q #N ) ) ) ) ) )) (def dp-date (ARG fiche (GETVQ fiche CDR CAR acces-fiche Q #N ECH CONS ) )) (def dp-auteur (ARG fiche (GETVQ fiche CDR CAR acces-fiche Q #N ECH CONS ) )) (def mapcan (C I (ARG -f (ARG -l (GETVQ -l NCONSPTHEN (Q #N ) (GETVQ -l CAR GETVQ -f EXEC (GETVQ -l CDR mapcan (GETVQ -f ) ECH APPEND ) ) ) ) ) )) (def depl (ARG rep (ARG SELECT ((GETVQ rep Q (#Ca ) EQUAL THEN (GETVQ SELECT mapcan (Q dp-auteur ) SETVQ SELECT ) (GETVQ rep Q (#Cd ) EQUAL THEN (GETVQ SELECT mapcan (Q dp-date ) SETVQ SELECT ) (GETVQ rep Q (#Cc #Ca ) EQUAL THEN (GETVQ SELECT mapcan (Q dp-ca ) SETVQ SELECT ) (GETVQ rep Q (#Cc #Cu ) EQUAL THEN (GETVQ SELECT mapcan (Q dp-cu ) SETVQ SELECT ) (GETVQ rep Q (#C* ) EQUAL THEN (GETVQ FICHES SETVQ SELECT ) (GETVQ rep Q (#Cr ) EQUAL THEN (GETVQ RACINE Q #N ECH CONS SETVQ SELECT ) (Q (#CE #Cr #Cr #Ce #Cu #Cr #C ) PRINTLINE ) ) ) ) ) ) ) GETVQ SELECT ) ) )) (def EQUAL #I/95) (def contient (C I (ARG -f (ARG -l (GETVQ -l NCONSPTHEN (Q #N ) (GETVQ -l CAR GETVQ -f EXEC (OR (GETVQ -l CDR contient (GETVQ -f ) ) ) ) ) ) ) )) (def acces-fiche (ARG titre (FICHES contient (Q (ARG fiche (GETVQ titre GETVQ fiche CAR EQUAL AND (GETVQ fiche ) ) ) ) ) )) (def NIVEAU #N) (def niveau #N) (def lire-fiche (Q (#CT #Ci #Ct #Cr #Ce #C #C? #C ) PRINTSTRING READLINE acces-fiche REP THEN #N (Q (#CC #Ce #Ct #Ct #Ce #C #Cf #Ci #Cc #Ch #Ce #C #Cn #C' #Ce #Cx #Ci #Cs #Ct #Ce #C #Cp #Ca #Cs #C. ) PRINTLINE lire-fiche ) )) (def MEMBER #I/94) (def texte #N) (def l-correl #N) (def lire-l-correl (Q (#CF #Ci #Cc #Ch #Ce #Cs #C #Cc #Co #Cr #Cr #Ce #Cl #Ce #Ce #Cs #C #C? #C ) PRINTSTRING READLINE CAR Q (#CO #Co ) MEMBER NOT THEN (Q #N ) (lire-fiche ARG fiche (Q (#CN #Ci #Cv #Ce #Ca #Cu #C #C? #C ) READLINE ARG niveau (Q #N GETVQ fiche CONS GETVQ NIVEAU CONS lire-l-correl ECH CONS ) ) ) )) (def titre #N) (def correl #N) (def REMOVE #I/98) (def sign-acces (ARG fiche (GETVQ FICHES GETVQ fiche REMOVE GETVQ fiche CONS SETVQ FICHES ) )) (def PRINTDATE #N) (def fiche #N) (def af-detaille (ARG fiche (GETVQ fiche af-resume1 GETVQ fiche CDR CDR CDR CAR mapc (Q (ARG correl (GETVQ correl CAR GETVQ SEUIL MOINS POSP NOT THEN #N (Q #N PRINTLINE Q (#CN #Ci #Cv #Ce #Ca #Cu #C #Cd #Ce #C #Cc #Co #Cr #Cr #Ce #Cl #Ca #Ct #Ci #Co #Cn #C #C: #C ) PRINTSTRING GETVQ correl CAR PRINT Q #N PRINTLINE GETVQ correl CDR CAR af-resume ) ) ) ) Q #N PRINTLINE GETVQ fiche CDR CDR CDR CDR CAR PRINTTEXT Q #N PRINTLINE ) )) (def rep #N) (def af-resume1 (ARG fiche (Q (#CT #Ci #Ct #Cr #Ce #C #C: #C ) PRINTSTRING GETVQ fiche CAR PRINTLINE Q (#CA #Cu #Ct #Ce #Cu #Cr #C #C: #C ) PRINTSTRING GETVQ fiche CDR CAR PRINTLINE Q (#CD #Ca #Ct #Ce #C #C: #C ) PRINTSTRING GETVQ fiche CDR CDR CAR PRINTDATE Q #N PRINTLINE GETVQ fiche sign-acces ) )) (def -f #N) (def -l #N) (def BUTLAST (ARG l (GETVQ l NCONSPTHEN (Q #N ) (GETVQ l CDR ARG s (GETVQ s NCONSPTHEN (GETVQ s ) (GETVQ s BUTLAST GETVQ l CAR CONS ) ) ) ) )) (def modif-seuil (Q (#CS #Ce #Cu #Ci #Cl #C #C= #C ) PRINTSTRING GETVQ SEUIL PRINT Q (#C #C- #C> #C ) PRINTSTRING READ SETVQ SEUIL )) (def ms #N) (def selection (Q (#CS #Ce #Cl #Ce #Cc #Ct #Ci #Co #Cn #C #C: #C ) PRINTLINE Q (#C #C #C #Cm #C #C: #C #Cm #Ca #Cn #Cu #Ce #Cl #Cl #Ce #C ) PRINTLINE Q (#C #C #C #Ca #C #C: #C #Ca #Cu #Ct #Co #Cm #Ca #Ct #Ci #Cq #Cu #Ce #C ) PRINTLINE Q (#C? #C ) PRINTSTRING READLINE ARG rep (GETVQ rep Q (#Cm ) EQUAL THEN selection-m (GETVQ rep Q (#Ca ) EQUAL THEN selection-a (Q (#CE #Cr #Cr #Ce #Cu #Cr #C ) PRINTLINE ) ) ) )) (def sl #N) (def deplacement (Q (#CD #Ce #Cp #Cl #Ca #Cc #Ce #Cm #Ce #Cn #Ct #C #C: #C ) PRINTLINE Q (#C #C #C #Ca #C #C: #C #Ca #Cu #Ct #Ce #Cu #Cr #C ) PRINTLINE Q (#C #C #C #Cd #C #C: #C #Cd #Ca #Ct #Ce #C ) PRINTLINE Q (#C #C #C #Cc #Ca #C #C: #C #Cc #Co #Cr #Cr #Ce #Cl #Ce #Ce #Cs #C #Ca #Cn #Ct #Ce #Cr #Ci #Ce #Cu #Cr #Ce #Cs #C ) PRINTLINE Q (#C #C #C #Cc #Cu #C #C: #C #Cc #Co #Cr #Cr #Ce #Cl #Ce #Ce #Cs #C #Cu #Cl #Ct #Ce #Cr #Ci #Ce #Cu #Cr #Ce #Cs #C ) PRINTLINE Q (#C #C #C #C* #C #C: #C #Ct #Co #Cu #Ct #C #Cl #Ce #C #Cf #Ci #Cc #Ch #Ci #Ce #Cr #C ) Q (#C #C #C #Cr #C #C: #C #Cl #Ca #C #Cf #Ci #Cc #Ch #Ce #C #Cr #Ca #Cc #Ci #Cn #Ce #C ) Q (#C? #C ) PRINTSTRING READLINE ARG rep (GETVQ SELECT GETVQ rep depl SETVQ SELECT ) )) (def dp #N) (def creer-fiche (Q (#CT #Ci #Ct #Cr #Ce #C #C? #C ) PRINTSTRING READLINE ARG titre (lire-l-correl ARG l-correl (Q (#CT #Ce #Cx #Ct #Ce #C #C? #C ) PRINTLINE READTEXT ARG texte (Q #N GETVQ texte CONS GETVQ l-correl CONS GETVQ DATE CONS GETVQ NOM CONS GETVQ titre CONS ARG fiche (GETVQ FICHES GETVQ fiche SETVQ FICHES ) ) ) ) )) (def cf #N) (def af-resume (GETVQ FICHES mapc (Q af-resume1 ) Q (#CA #Cf #Cf #Ci #Cc #Ch #Ca #Cg #Ce #C #Cd #Ce #Ct #Ca #Ci #Cl #Cl #Ce #C #C? #C ) PRINTSTRING READLINE SETVQ rep (GETVQ rep THEN (GETVQ rep af-detaille ) #N ) )) (def ar #N) (def commande #N) (def COMMANDE #N) (def LENGTH #I/91) (def test-max (GETVQ FICHES LENGTH GETVQ MAX MOINS POSP NOT THEN #N (GETVQ FICHES BUTLAST SETVQ FICHES ) )) (def top-fi1 (test-max GETVQ SELECT LENGTH PRINT Q (#C #Cf #Ci #Cc #Ch #Ce #Cs #C #Cs #Ce #Cl #Ce #Cc #Ct #Ci #Co #Cn #Cn #Ce #Ce #Cs #C ) PRINTLINE af-menu Q (#CC #Co #Cm #Cm #Ca #Cn #Cd #Ce #C #C? #C ) PRINTSTRING READLINE SETVQ commande GETVQ commande Q (#Ca #Cr ) EQUAL THEN af-resume (GETVQ commande Q (#Cc #Cf ) EQUAL THEN creer-fiche (GETVQ commande Q (#Cd #Cp ) EQUAL THEN deplacement (GETVQ commande Q (#Cs #Cl ) EQUAL THEN selection (GETVQ commande Q (#Cm #Cs ) EQUAL THEN modif-seuil (Q (#CC #Co #Cm #Cm #Ca #Cn #Cd #Ce #C #Ce #Cr #Cr #Co #Cn #Ce #Ce #C ) PRINTLINE ) ) ) ) ) )) (def af-menu (Q (#CC #Co #Cm #Cm #Ca #Cn #Cd #Ce #Cs #C #C: #C ) PRINTLINE Q (#C #C #C #Ca #Cr #C #C: #C #Ca #Cf #Cf #Ci #Cc #Ch #Ce #Cr #C #Cu #Cn #C #Cr #Ce #Cs #Cu #Cm #Ce #C #Cd #Ce #Cs #C #Cf #Ci #Cc #Ch #Ce #Cs #C #Cs #Ce #Cl #Ce #Cc #Ct #Ci #Co #Cn #Cn #Ce #Ce #Cs #C ) PRINTLINE Q (#C #C #C #Cc #Cf #C #C: #C #Cc #Cr #Ce #Ce #Cr #C #Cu #Cn #Ce #C #Cf #Ci #Cc #Ch #Ce #C ) PRINTLINE Q (#C #C #C #Cd #Cp #C #C: #C #Cd #Ce #Cp #Cl #Ca #Cc #Ce #Cm #Ce #Cn #Ct #C ) PRINTLINE Q (#C #C #C #Cs #Cl #C #C: #C #Cs #Ce #Cl #Ce #Cc #Ct #Ci #Co #Cn #C ) PRINTLINE Q (#C #C #C #Cm #Cs #C #C: #C #Cm #Co #Cd #Ci #Cf #Ci #Ce #Cr #C #Cl #Ce #C #Cs #Ce #Cu #Ci #Cl #C ) PRINTLINE )) (def FICHES #N) (def initialiser-fi (Q ((#CR #Ca #Cc #Ci #Cn #Ce ) #N #N #N #N ) SETVQ RACINE GETVQ RACINE #N ECH CONS SETVQ FICHES )) (def MAX #N) (def SEUIL #N) (def SELECT #N) (def RACINE #N) (def DATE #N) (def NOM #N) (def top-fi (top-fi1 top-fi )) (def init-fi (Q (#CN #Co #Cm #C #C? #C ) PRINTSTRING READLINE SETVQ NOM GETDATE-fi SETVQ DATE GETVQ RACINE Q #N ECH CONS SETVQ SELECT Q #C@ SETVQ SEUIL Q #Cx SETVQ MAX )) (def fi (init-fi top-fi )) (def GETDATE (Q ((#C/01 . #C/00) ) Q #C/1A #I^ CDR CDR CDR CAR )) (def mapc (C I (ARG -f (ARG -l (GETVQ -l NCONSPTHEN #N (GETVQ -l CAR GETVQ -f EXEC (GETVQ -l CDR mapc (GETVQ -f ) ) ) ) ) ) )) (def PRINTTEXT (ARG text (GETVQ text NCONSPTHEN #N (GETVQ text CAR PRINTLINE GETVQ text CDR PRINTTEXT ) ) )) (def READTEXT (READLINE REP Q #N EQ THEN (DEP Q #N ) (READTEXT ECH CONS ) )) (def READLINE (TYI REP Q #C/0A EQ THEN (DEP Q #N ) (REP Q #C/8D EQ THEN (DEP Q #N ) (READLINE ECH CONS ) ) )) (def PRINTLINE (PRINTSTRING Q (#C/0A ) PRINTSTRING )) (def xxx #N) (def  #N) (def ; #N) (def stop #N) (def LIST-SYMBS (#I' #C/02 #I? A (#Il #I' #CQ #I= #I> KI (#IR #IA PRINT #I' #C/0D #IO #I' #C/0A #IO #ID A ) ) )) (def TEST-STOP (#IR #I' STOP #I= #I> (#I; ; #I' #T ) (#I' #X./05 #I= ) )) (def MEMQ (#I[ #I[ GETH1 NCONSPTHEN GETH1 (GETH1 #IA GETH0 #I= #I> GETH1 (GETH0 GETH1 #ID MEMQ ) ) )) (def SAVE (#I' #C/03 #If #I' #C/03 #Io #I# #I' (#C( #C/0D #C/0A ) PRINTSTRING #I' #C/02 #I? PRINTDEFS #I' (#C) #C/0D #C/0A #C( #C) #C/0D #C/0A ) PRINTSTRING #I' #C/02 #Io #I# )) (def PRINTDEFS (#IR NCONSPTHEN #I; (#IR #IA PRINTDEF #ID PRINTDEFS ) )) (def PRINTDEF (Q (#C( #Cd #Ce #Cf #C ) PRINTSTRING #ID #IR #IA PRINTSTRING Q (#C ) PRINTSTRING #ID #IA PRINT #I' (#C) #C #C/0D #C/0A ) PRINTSTRING )) (def testalt (#I' #C/03 #I? #I' ((#C/01 ) (#I' #CA STOP #I' suite PRINT ) (pile ) ) #IC #I' #C/03 #I! )) (def ev (#I' #Ca #I? EVOL-LCTXS #I' #Ca #I! #I' #Ca #I? #I' #N MAPKAR (#I; #ID #IR #IA PRINT #ID #IA PRINT #I' (#C/0D #C/0A ) PRINTSTRING #I' #N ) #I; #I' (#C/0D #C/0A ) PRINTSTRING )) (def suite #N) (def end #N) (def prog #N) (def strat #N) (def OLDDEF-AJINSTR #N) (def prologif (GETCTX-ENLINSTR (#I[ GETH0 ENLINSTR ENLINSTR ENLINSTR GETH0 PREMINSTR *APPLIQ #IR NCONSPTHEN (GETH0 ENLINSTR ENLINSTR SETCTX ) (GETH0 #ID #IA #ID #IA MAPKAR AJINSTR SETCTXS ) ) )) (def prolognot (GETCTX-ENLINSTR (#IR ¹PREMINSTR NCONSPTHEN (ENLINSTR SETCTX ) END ) )) (def hyp (GETCTX-ENLINSTR (#IR ¹PREMINSTR NCONSPTHEN END (ENLINSTR SETCTX ) ) )) (def bloc (GETCTX-ENLINSTR (*APPREMINSTR SETCTXS ) )) (def cut (GETCTX-ENLINSTR (¹PREMINSTR #IA SETCTX ) )) (def SOMPIL (#ID #ID #IA #IA )) (def MAPKAR (C #I' (#I[ #I[ #I[ (GETH0 NCONSPTHEN GETH0 (GETH0 #IA GETH1 GETH2 #I& (GETH0 #ID GETH1 #I' #N GETH2 #IC #I' MAPKAR #IC #I& (#IX #IC ) ) ) ) #I] #I; #I] #I; #I] #I; ) )) (def values (GETCTX-ENLINSTR ((#IR *APPREMINSTR #I' #N MAPKAR (#I; SOMPIL ) #IX ENLINSTR #IX EMPIL ) SETCTX ) )) (def *APPREMINSTR (#IR ENLINSTR #IX PREMINSTR *APPLIQ )) (def *APPLIQ (#I' #N #I' STOP #IC #IX #IC AJINSTR #I' #N #IX #IC *REPEVOL )) (def *REPEVOL (¾PEVOL #IR NCONSPTHEN #N (#IR #ID *REPEVOL #IX #IA #IC ) )) (def ¹PREMINSTR (#IR ENLINSTR #IX PREMINSTR ¹PLIQ )) (def ¹PLIQ (#I' #N #I' STOP #IC #IX #IC AJINSTR #I' #N #IX #IC ¾PEVOL )) (def ¾PEVOL (INTERP #IR NCONSPTHEN #N (#IR #ID #IX #IA ENLINSTR #IC ) )) (def ENLINSTR (#IR #IA #I[ #ID #IR #ID #I[ #IA #ID #I] #IX #IC #I] #IC )) (def STOP #X./05) (def PREMINSTR (#ID #IA #IA )) (def INTERP (A (#IR NCONSPTHEN KI (#IR #IA PREMINSTR TEST-STOP #I> KI (EVOL-LCTXS A ) ) ) )) (def KI (#I' #C/05 #I? (#ID #ID #I' #C/05 #I! ) )) (def f (Q a PRINT )) (def OLDDEF-FPRINTLISTLEVEL #N) (def CANAL #N) (def pile #N) (def FPRINTLISTLEVEL (#IR #IP #IN #I> (#I' (#C #C. #C #C< #C> #C) ) PRINTSTRING #I; ) (#IX #IR NCONSPTHEN (Q (#C #C. #C ) PRINTSTRING #IX FPRINTLEVEL #I' #C) #IO ) (#I[ #IR #I] #IR #I[ #IA #IX #I' #C/01 #I- FPRINTLEVEL #I] #ID #IX #I' #C/01 #I- FPRINTLISTLEVEL ) ) )) (def FPRINTLEVEL (#IR #IP #IN #I> (#I; #I; #I' (#C< #C> ) PRINTSTRING ) (#IX #IR NCONSPTHEN (PROTO-PRINT #I; ) (#IR #IA #I' a #IA #I= #I> (#ID #IA PRINTSTRING #I; ) (#I' #C( #IO #IX FPRINTLISTLEVEL ) ) ) )) (def INSLCTXS (#I[ #I[ (GETH1 NCONSPTHEN GETH0 (GETH0 GETH1 #ID INSLCTXS GETH1 #IA INSCTX ) ) #I] #I; #I] #I; )) (def RECEIVE (GETCTX-ENLINSTR (INSTR-RECEIVE SETCTXS ) )) (def SETCTXS (REP NCONSPTHEN (DEP END ) (REP CDR #I' #C/03 #I? #IX INSLCTXS #I' #C/03 #I! CAR SETCTX ) )) (def SEND (GETCTX-ENLINSTR (INSTR-SEND SETCTXS ) )) (def NCNSPTHEN #N) (def INSTR-RECEIVE (#I[ (GETH0 #ID #ID #IA #IA #ID #ID #IA NCONSPTHEN (Q #N Q #N GETH0 #IC #IC Q #N #IC GETH0 #ID #ID #IA #IA #Id Q #N ) (GETH0 #ID #ID #IA #IA #ID #IA #IN #I> (GETH0 #ID #ID #IA #IA #ID #ID #IA GETH0 #I' #C/15 #I? ENFILER Q #N ) (Q #N GETH0 DEPIL GETH0 #ID #ID #IA #IA #ID #ID #IA #IA #ID #ID #IA #ID #IA EMPIL #IC GETH0 #ID #ID #IA #IA #ID #ID #IA #IA DEPIL DEPIL #IC GETH0 #ID #ID #IA #IA #ID #ID #IA #ID GETH0 #ID #ID #IA #IA #ID #ID #Ia ) ) ) #I] #I; )) (def EMPIL (#IX #IR #IA #I[ #ID #IR #IA #I[ #ID #IR #IA #I[ #IX #I] #IX #IC #I[ #ID #I] #IC #I] #IC #I] #IC )) (def DEPIL (#IR #IA #I[ #ID #IR #IA #I[ #ID #IR #IA #ID #I[ #ID #I] #IC #I] #IC #I] #IC )) (def INSTR-SEND (#I[ (GETH0 #ID #ID #IA #IA #ID #ID #IA NCONSPTHEN (Q #N Q #N GETH0 CONS CONS Q #T CONS GETH0 #ID #ID #IA #IA #Id Q #N ) (GETH0 #ID #ID #IA #IA #ID #IA #I> (GETH0 #ID #ID #IA #IA #ID #ID #IA GETH0 #I' #C/15 #I? ENFILER Q #N ) (Q #N GETH0 DEPIL DEPIL #IC GETH0 #ID #ID #IA #IA #ID #ID #IA #IA DEPIL GETH0 #ID #ID #IA #ID #IA EMPIL #IC GETH0 #ID #ID #IA #IA #ID #ID #IA #ID GETH0 #ID #ID #IA #IA #ID #ID #Ia ) ) ) #I] #I; )) (def LAST (#I[ (GETH0 #ID NCONSPTHEN GETH0 (GETH0 CDR LAST ) ) #I] #I; )) (def ENFILER (#I[ #I[ #I[ (GETH2 #IN #I> (Q #N GETH1 CONS GETH0 LAST #Id ) (GETH1 #IA #IA GETH0 #IA #IA #IA #I- #IP #I> (GETH0 #IR #IA #I[ #ID #I] #IC GETH0 #Id GETH1 GETH0 #Ia ) (GETH0 #ID NCONSPTHEN (Q #N GETH1 #IC GETH0 #Id ) (GETH0 #ID GETH1 GETH2 ENFILER ) ) ) ) #I] #I; #I] #I; #I] #I; )) (def EVOL-ALT (#I' #N #IX #IC EVOL-LCTXS )) (def EVOL-LCTXS (#I' #C/03 #I? #I' #C/14 #I? #IX #IC #I' #C/14 #I! #IR #ID #I' #C/03 #I! #IA EVOL #I' #C/03 #I? #IX #IC #I' #C/14 #I? #IR #ID #I' #C/14 #I! #IA #I' #C/03 #I! )) (def GETPRIO (CAR CAR )) (def INSCTX (#I[ #I[ (GETH0 NCONSPTHEN (GETH0 GETH1 #IC ) (GETH1 #IA #IA GETH0 #IA #IA #IA #I- #IP #I> (GETH0 GETH1 #IC ) (GETH0 #ID GETH1 INSCTX GETH0 #IA #IC ) ) ) #I] #I; #I] #I; )) (def ALT1 (GETCTX-ENLINSTR (#I' #C/03 #I? #IX INSCTX #I' #C/03 #I! #I' #C/05 #I? (#ID #ID #I' #C/05 #I! ) ) )) (def ALT2 (B ALT1 K )) (def END (#I' #C/03 #I? #IR #ID #I' #C/03 #I! #IA SETCTX )) (def GETOCTXS (#I' #C/03 #I? )) (def ctx #N) (def BOUBLE-STEP #N) (def PRINTLISTLEVEL (ARG n (ARG x (GETVQ n POSP NOT THEN (Q (#C #C. #C #C< #C> #C) ) PRINTSTRING ) (GETVQ x NCONSPTHEN (Q (#C #C. #C ) PRINTSTRING GETVQ x GETVQ n PRINTLEVEL #C) TYO ) (GETVQ x CAR GETVQ n Q #C/01 MOINS PRINTLEVEL Q #C TYO GETVQ x CDR GETVQ n Q #C/01 MOINS PRINTLISTLEVEL ) ) ) ) )) (def PRINTLEVEL (ARG n (ARG x (GETVQ n POSP NOT THEN (Q (#C< #C> ) PRINTSTRING ) (GETVQ x NCONSPTHEN (GETVQ x PROTO-PRINT ) (GETVQ x CAR Q a CAR EQ THEN (GETVQ x CDR CAR PRINTSTRING ) (#C( TYO GETVQ x GETVQ n PRINTLISTLEVEL ) ) ) ) ) )) (def l #N) (def n #N) (def INSPOS (ARG n (ARG x (ARG l (GETVQ n Q #C/01 MOINS POSP NOT THEN (GETVQ l GETVQ x CONS ) (GETVQ l CDR GETVQ x GETVQ n Q #C/01 MOINS INSPOS GETVQ l CAR CONS ) ) ) ) )) (def PREFIX (GETPROG (CDR ARG p (GETVQ p CDR CDR GETVQ p CDR CAR GETVQ p CAR INSPOS SETPROG ) ) )) (def c (GETVQ Y-EDIT GETVQ E-EDIT CAR EXEC SETVQ Y-EDIT GETVQ E-EDIT CDR SETVQ E-EDIT )) (def b #N) (def d1 (Q (CONS ) GETVQ Y-EXEC CAR REP PRINT CONS Q Q CONS GETVQ E-EDIT ECH CONS SETVQ E-EDIT GETVQ Y-EDIT CDR SETVQ Y-EDIT )) (def z #N) (def y #N) (def D (GETVQ Y-EDIT CDR SETVQ Y-EDIT )) (def i (GETVQ Y-EDIT Q #N CONS SETVQ Y-EDIT )) (def d (Q (CONS ) GETVQ Y-EDIT CAR CONS Q Q CONS GETVQ E-EDIT ECH CONS SETVQ E-EDIT GETVQ Y-EDIT CDR SETVQ Y-EDIT )) (def Y-EXEC #N) (def a (Q (ECH CONS ) GETVQ Y-EDIT CDR CONS Q Q CONS GETVQ E-EDIT ECH CONS SETVQ E-EDIT GETVQ Y-EDIT CAR SETVQ Y-EDIT )) (def r (SETVQ Y-EDIT )) (def p (GETVQ Y-EDIT PRINT Q (#C/0D #C/0A ) PRINTSTRING )) (def E-EDIT #N) (def Y-EDIT #N) (def X-EDIT #N) (def EDIT (REP SETVQ X-EDIT SETVQ Y-EDIT Q #N SETVQ E-EDIT )) (def EXEC #I&) (def DEX (GETPROG (CDR CAR EXEC ) )) (def ø #N) (def GETCTX #N) (def q (GETVQ Y-EDIT GETVQ E-EDIT EXEC REP PRINT )) (def AJINSTR (#IX #IR #IA #I[ #ID #IR #ID #I[ #IA #IX #IC #I] #IX #IC #I] #IC )) (def e (GETVQ Y-EDIT )) (def BOUCE-STEP BOUCLE-STEP) (def s #N) (def BOUCLE-STEP (REP SKIP-STEP THEN (EVOL1 BOUCLE-STEP ) (Q #N PRINTLINE Q (#C #Cp #Cr #Co #Cg #C #C: #C ) PRINTSTRING REP CDR CAR PRINTSHORT Q #N PRINTLINE Q (#C #Cp #Ci #Cl #Ce #C #C: #C ) PRINTSTRING REP CDR CDR CAR PRINTSHORT Q #N PRINTLINE Q (#C #C? #C ) PRINTSTRING READ REP Q s EQ THEN (DEP EVOL1 BOUCLE-STEP ) (REP Q n EQ THEN (DEP STEP-n SETCTX ) (REP Q e EQ THEN (DEP READ AJINSTR BOUCLE-STEP ) (REP Q x EQ THEN DEP (REP Q q EQ THEN (DEP SETCTX ) (DEP Q (#CE #CR #CR #CE #CU #CR ) PRINTSTRING BOUCLE-STEP ) ) ) ) ) ) )) (def SETCTX (REP CAR #C/04 SETFIELD CDR REP CAR DES CDR REP CAR DES CDR REP CAR DES CDR REP CAR #C/08 SETFIELD CDR REP CAR #C/09 SETFIELD CDR CAR #C/0A SETFIELD MON MON ECH MON ECH #C/07 SETFIELD DES #C/06 SETFIELD MON #C/05 SETFIELD )) (def GETCTX-ENLINSTR (Q #N #C/0A GETFIELD CONS #C/09 GETFIELD CONS #C/08 GETFIELD CONS #C/07 GETFIELD CONS #C/06 GETFIELD CDR CONS #C/05 GETFIELD (CDR CDR CONS #C/04 GETFIELD CONS ) )) (def x #N) (def A (#I' #C/05 #I? (#ID #IA #I& ) )) (def xyz #N) (def PRINTLIST (REP Q #N EQ THEN (DEP Q #C) TYO ) PRINTLIST1 )) (def PRINTSTRING (REP NCONSPTHEN DEP (REP CAR TYO CDR PRINTSTRING ) )) (def PRINT (REP NCONSPTHEN #I6 (REP CAR Q A CAR EQ THEN (CDR CAR PRINTSTRING ) (Q #C( TYO PRINTLIST ) ) )) (def K #I/0B) (def .IvN #N) (def S #I/13) (def ARG #I/E6) (def REMVQ (C Q (GETENV REMVENV SETENV ) )) (def ADDVQ (C Q (GETENV ADDVENV SETENV ) )) (def SETVQ #I/E2) (def GETVQ #I/E1) (def REMVENV #I/A4) (def ADDVENV #I/A3) (def SETVENV #I/A2) (def GETVENV #I/A1) (def AND (B (REP C THEN I ) DEP )) (def OR (B (REP THEN I ) DEP )) (def C #I/03) (def B #I/02) (def SETENV (Q #C/0A SETFIELD )) (def GETENV (Q #C/0A GETFIELD )) (def SETSTACK (Q 6 SETFIELD )) (def 6 #N) (def GETSTACK (Q 6 GETFIELD )) (def SETPROG (Q #C/05 SETFIELD )) (def GETPROG (Q #C/05 GETFIELD )) (def MONDEP (MON DEP )) (def NCONSPTHEN (GETFLAGS Q #C/02 ETL #C/00 EQ THEN )) (def GETH2 (MON MON MON REP DES ECH DES ECH DES )) (def GETH1 (MON MON REP DES ECH DES )) (def GETH0 (MON REP DES )) (def LISE #IL) (def LICA #Il) (def RDCA #Ir) (def TYO #IO) (def TYI #II) (def GETVAL #IV) (def GETFLAGS #IF) (def POSP #IP) (def ETL #I.) (def MOINS #I-) (def PLUS #I+) (def SETFIELD #I!) (def GETFIELD #I?) (def RPLACD #Id) (def RPLACA #Ia) (def CONS #IC) (def CDR #ID) (def CAR #IA) (def EQ #I=) (def THEN #I>) (def NOT #IN) (def MON #I]) (def REP #IR) (def DEP #I;) (def EVAL #I&) (def QUOTE #I') (def Q #I') (def EVOL #I,) (def I #T) (def LOAD (#I' #CC #I? #I& )) (def TOP (#I' #CB #I? #I& )) (def EQL (#I' #C* #I? #I& )) (def SYMBOL (#I' #C( #I? #I& )) (def READ (#I' #C" #I? #I& )) (def STEP (GETCTX-ENLINSTR BOUCLE-STEP )) (def PROTO-PRINT (#I' #C, #I? #I& )) (def LIRE-CARACTERE (#I' #C+ #I? #I& )) (def def (#I' #CA #I? #I& )) (def ?&'%?&'+?&&'?'? #I]) (def DES #I[) (def ECH #IX)