├── README.md └── src ├── .DS_Store ├── README ├── axioms.xtr ├── consts.xtr ├── def.lsn ├── def.nvo ├── dlist.dft ├── dml ├── dml.lsp ├── drul.ml ├── elcf.dir ├── files.2 ├── files.el ├── files.lsp ├── files.ml ├── gen.ml ├── gp ├── gpx ├── iox ├── iox.lsp ├── lap.dir ├── lap ├── clrbfi.lap ├── dml.lap ├── files.lap ├── gp.lap ├── iox.lap ├── lcfb.lap ├── lcfc.lap ├── lcfm.lap ├── lcfo.lap ├── lean.lap ├── lis.lap ├── ltcons.lap ├── mlprin.lap ├── ol0.lap ├── ol1.lap ├── ol2.lap ├── ol3.lap ├── opp.lap ├── prompt.lap ├── share.lap ├── simpl.lap ├── thyfns.lap ├── tml.lap ├── trace.lap ├── tran.lap ├── typeml.lap ├── typeol.lap └── writml.lap ├── lapld ├── lapld.e ├── lapld.fls ├── lapld.mic ├── lcf.dir ├── lcf.gra ├── lcf.new ├── lcfa ├── lcfb ├── lcfc ├── lcfm ├── lcfm.lsp ├── lcfo ├── lcfo.lsp ├── lean ├── leanpr ├── lesyn ├── lesyn.all ├── lesyn.ind ├── lesyn.tac ├── lesyn1 ├── lesyn1.dft ├── lis ├── lis.lsp ├── lis.ml ├── lookup ├── lpsyn.a ├── lpsyn.ind ├── lspld ├── lspld.mic ├── misc ├── dlist.fct ├── equt.fct ├── equt.fct.~1~ ├── equt.thy ├── equt.thy.~1~ ├── fixt.fct ├── fixt.thy ├── lesyn.fct ├── lesyn.thy ├── lesyn1.fct ├── lstacs.new ├── parent.xtr ├── propt.fct └── propt.thy ├── mlprin ├── ol0 ├── ol0.lsp ├── ol1 ├── ol1.lsp ├── ol2 ├── ol2.lsp ├── ol2.ml ├── ol3 ├── ol3.lsp ├── ol3.ml ├── opp ├── pcrul.ml ├── pplamb.lsp ├── pplamb.ml ├── prompt ├── ptble ├── restor ├── rul.ml ├── share ├── simpl ├── simpl.lsp ├── simpl.ml ├── symbs ├── tac.ml ├── tcl.ml ├── thyfns ├── thyfns.lsp ├── thyfns.ml ├── tml ├── tml.lsp ├── tmlini ├── trace.lsp ├── tran ├── tran.lsp ├── typeml ├── typeml.lsp ├── typeol ├── udpel.dir ├── writml └── writml.lsp /README.md: -------------------------------------------------------------------------------- 1 | # LCF77 2 | The original Edinburgh LCF. 3 | -------------------------------------------------------------------------------- /src/.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/theoremprover-museum/LCF77/7a43e95deee18ae37389d98e184b38fdfb3df923/src/.DS_Store -------------------------------------------------------------------------------- /src/README: -------------------------------------------------------------------------------- 1 | Copy of LCF found in Friedrich von Henke's SAIL directory (1977) 2 | Code for LCF Version 5, Oct 1977 3 | -------------------------------------------------------------------------------- /src/axioms.xtr: -------------------------------------------------------------------------------- 1 | 2 | o1 "!i:IDEN. occne i UU == UU:tr" 3 | 4 | o2 "!n:NCON. !i:IDEN. occne i(mkncon n) == FF" 5 | 6 | o3 "!j:IDEN. !i:IDEN. occne i(mkiden j) == i = j" 7 | 8 | o4 "!e2:NEXP. !e1:NEXP. !nop:NOP. !i:IDEN. occne i(mkcnexp(nop, (e1, e2))) == occne i e1=>TT|occne i e2" 9 | 10 | s1 "!i:IDEN. !d:NEXP. substne d i UU == UU:NEXP" 11 | 12 | s2 "!n:NCON. !i:IDEN. !d:NEXP. substne d i(mkncon n) == mkncon n" 13 | 14 | s3 "!j:IDEN. !i:IDEN. !d:NEXP. substne d i(mkiden j) == i = j=>d|mkiden j" 15 | 16 | s4 "!e2:NEXP. !e1:NEXP. !nop:NOP. !i:IDEN. !d:NEXP. substne d i(mkcnexp(nop, (e1, e2))) == mkcnexp(nop, (substn~ 17 | e d i e1, substne d i e2))" 18 | 19 | e1 "!i:IDEN. i = i == TT" 20 | -------------------------------------------------------------------------------- /src/consts.xtr: -------------------------------------------------------------------------------- 1 | 2 | newolinfix ( `=` , ":IDEN#IDEN->tr" ) ;; 3 | 4 | newconstant ( `occne` , ":IDEN->(NEXP->tr)" ) ;; 5 | 6 | newconstant ( `substne` , ":NEXP->(IDEN->(NEXP->NEXP))" ) ;; 7 | -------------------------------------------------------------------------------- /src/def.lsn: -------------------------------------------------------------------------------- 1 | (TML) 2 | %definitions needed in list stack problem in new system% 3 | "F:d->d";; 4 | "F1:d->d->dlist->d";; 5 | "f:d->d";; 6 | "x:d";; 7 | "P:d->tr";; 8 | "h:d # d -> d";; 9 | "g1:d->d";; 10 | "g2:d->d";; 11 | "z:d";; 12 | "s:dlist";; 13 | "Exp:(d->d)->(d#d->d)->d->d->dlist->d";; 14 | "e:d";; 15 | 16 | 17 | let th1 = ASSUME "F == FIX (\F'.\x. P x => f x | 18 | h (F' (g1 x), F' (g2 x)))";; 19 | let th2 = ASSUME "F1 == FIX (\F1'. \x. \z. \s. EQ s NIL => z | 20 | P x => F1' (HD s) (h (z, f x)) (TL s) | 21 | F1' (g1 x) z (CONS (g2 x) s))";; 22 | let th3 = ASSUME "Exp == FIX (\Exp'.\F. \h. \x. \z. \s. 23 | EQ s NIL => z | Exp' F h (HD s) (h(z, F x)) (TL s))";; 24 | let th4 = ASSUME "G == FIX (\G'. \x. \z. \s. EQ s NIL => z | 25 | G' (HD s) (h(z, F x)) (TL s))";; 26 | 27 | let leftid = ASSUME "!x:d. h(e, x) == x";; 28 | let strictrh = ASSUME "!x:d. h(x, UU) == UU";; 29 | let strictlh = ASSUME "!x:d. h(UU, x) == UU";; 30 | let assoch = ASSUME "!a:d.!b:d.!c:d. h((h(a,b)),c) == h(a,(h(b,c)))";; 31 | 32 | let [HDCONS;TLCONS;HDLIST;TLLIST;CNSNIL;LISCNS] = map (FACT `-`) 33 | [`HDCONS`;`TLCONS`;`HDLIST`;`TLLIST`;`CNSNIL`;`LISCNS`];; 34 | let [NNCNS1;NNCNS2;AXLIST;AXNIL2] = map (AXIOM `-`) 35 | [`NNCNS1`;`NNCNS2`;`AXLIST`;`AXNIL2`];; 36 | let ss23 = itlist ssadd [NNCNS1;NNCNS2;HDCONS;TLCONS;assoch;strictlh; 37 | strictrh] BASICSS;; 38 | let ss5 = ssadd strictlh BASICSS;; 39 | let ss6 = itlist ssadd [LISCNS;CNSNIL;leftid;HDLIST;TLLIST; 40 | AXLIST;AXNIL2] BASICSS;; 41 | 42 | let goal1 = "G == Exp F h ",BASICSS,[]:form list;; 43 | let goal2 = "F1 << Exp F h ", ss23, []:form list;; 44 | let goal3 = "G << F1 ", ss23, []:form list;; 45 | let goal4 = "F1 == Exp F h ", BASICSS,[]:form list;; 46 | let goal5 = "!x.!s.F1 x UU s == UU", ss5, []:form list;; 47 | let goal6 = "Exp F h x e (LIST dummy) == F x", ss6, []:form list;; 48 | 49 | let goal7 = "F1 x e (LIST dummy) == F x",BASICSS,[]:form list;; 50 | 51 | let TAC1 = REPEAT APPLYTAC2 THEN INDUCTAC [th4;th3] THEN SIMPTAC 52 | THEN REPEAT GENTAC THEN ANYCASESTAC THEN SIMPTAC 53 | THEN USEIHTAC THEN SIMPTAC;; 54 | 55 | let TAC2 = REPEAT APPLYTAC2 THEN INDUCTAC [th2] THEN SIMPTAC 56 | THEN REPEAT GENTAC THEN UNWINDTAC th3 THEN 57 | SIMPTAC THEN ANYCASESTAC THEN SIMPTAC THEN 58 | ANYCASESTAC THEN SIMPTAC THEN UNWINDOCCSTAC [2] th1 59 | THEN SIMPTAC THEN USEIHLESSTAC THEN SIMPTAC 60 | THEN STRENGTHENTAC THEN SIMPTAC 61 | THEN UNWINDOCCSTAC [1] th3 THEN SIMPTAC THEN 62 | UNWINDOCCSTAC [1] th3 THEN SIMPTAC;; 63 | 64 | let TAClemma = INDUCTAC [th2] THEN SIMPTAC THEN REPEAT GENTAC THEN 65 | SIMPTAC THEN ANYCASESTAC THEN SIMPTAC THEN 66 | ANYCASESTAC THEN SIMPTAC THEN USEIHTAC THEN SIMPTAC;; 67 | 68 | let TAC3 = WEAKFIXTAC th4 THEN SIMPTAC THEN REPEAT APPLYTAC2 69 | THEN SIMPTAC THEN INDUCTAC [th1] THEN 70 | UNWINDOCCSTAC [2] th2 THEN SIMPTAC THEN REPEAT GENTAC THEN 71 | ANYCASESTAC THEN SIMPTAC THEN ANYCASESTAC THEN 72 | SIMPTAC THEN USEIHMORETAC THEN SIMPTAC THEN 73 | USEIHMORETAC THEN SIMPTAC;; 74 | 75 | let TAC6 = UNWINDTAC th3 THEN SIMPTAC THEN UNWINDTAC th3 THEN SIMPTAC;; 76 | 77 | %TACn achieves goaln; TAClemma achieves goal5; goal3 first needs 78 | the result of TAClemma goal5 in its simpset. 79 | to obtain goal4, do: SYM (SYNTH (TRANS ((SYM res1),res3),res2));; 80 | where resn is a meta-notation for the theorem achieving goaln. 81 | to achieve goal7, add res4 and res6 to the simpset, and do SIMPTAC.% 82 | 83 | 84 | -------------------------------------------------------------------------------- /src/def.nvo: -------------------------------------------------------------------------------- 1 | (TML) 2 | %for new system % 3 | "f:*->*";; 4 | "P:*->tr";; 5 | "h:*#*->*";; 6 | "g:*->*";; 7 | "e:*";; 8 | 9 | let th1 = ASSUME "F == FIX (\F':*->*.(\x:*. (P x) => (f x) | 10 | (h (x, F' (g x)))))";; 11 | let th2 = ASSUME "F1 == FIX (\F1':*->*->*.(\x:*. (\z:*. (P x) => 12 | (h (z, f x)) | 13 | (F1' (g x) (h(z, x))))))";; 14 | 15 | let assoch = ASSUME "!a. !b. !c. h(a, h(b,c)) == 16 | h(h(a,b), c)";; 17 | let stricth = ASSUME "!a. h(a, UU:*) == UU";; 18 | let leftid = ASSUME "!a. h(e, a) == a";; 19 | 20 | let ss1 = itlist ssadd [assoch;stricth] BASICSS;; 21 | let ss2 = ssadd leftid BASICSS;; 22 | 23 | let goal1 = "!x.!z.(F1 x z) == h(z, (F x))",ss1,[]:form list;; 24 | let goal2 = "!x.F1 x e == F x",ss2,[]:form list;; 25 | 26 | 27 | %definitions needed for the new variable problem; 28 | goal2 needs result of using TAC1 on goal1 added to its 29 | simpset% 30 | 31 | letrec destquantl (l, w) = isquant w => let c,d = destquant w 32 | in destquantl ((c.l), d) | 33 | (l,w);; 34 | 35 | % !xn ... ! x1. w to [x1; ... ;xn],w % 36 | 37 | letrec ITSPEC l th = null l => th | ITSPEC (tl l) (SPEC (hd l) th);; 38 | 39 | %[xn'; ... ;x1'], |- !x1...!xn. P(x1...xn) to |- P(xn'...x1') % 40 | 41 | letrec reverse l1 l2 = null l1 => l2 | reverse (tl l1) ((hd l1).l2);; 42 | 43 | let USEIHTAC ((w,ss,fml):goal) = 44 | letref FML = fml 45 | in ((let IH = ASSUME (hd FML) 46 | in let boundvars,rest = destquantl (nil, (hd FML)) 47 | in let matchlist = fst (termmatch ([]:term list, 48 | []:type list) (lhs rest)(lhs w)) 49 | in let speclist = reverse 50 | ((map (fst o (\e. revassoc e matchlist))) 51 | boundvars) nil 52 | in let IH' = ITSPEC speclist IH 53 | in aconvform (w, (concl IH')) => 54 | ([w, (ssadd IH ss), fml], 55 | hd) | fail) 56 | ! FML := tl FML) 57 | ? failwith `USEIHTAC`;; 58 | 59 | % takes a goal, finds the IH in the fml 60 | and adds that to the ss part of the goal. 61 | The form in question must have form "!x1...xn. P == Q" or "P == Q". % 62 | 63 | let TAC1 = INDUCTAC [th2;th1] THEN SIMPTAC THEN REPEAT GENTAC 64 | THEN ANYCASESTAC THEN SIMPTAC THEN USEIHTAC THEN SIMPTAC;; 65 | 66 | let TAC2 = SIMPTAC;; 67 | 68 | % tactics to perform the proof % 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /src/dlist.dft: -------------------------------------------------------------------------------- 1 | 2 | newparent `PROPT` ;; 3 | 4 | newparent `EQUT` ;; 5 | 6 | newparent `FIXT` ;; 7 | 8 | newtypes [ ``dlist = . + dpair`` ; 9 | ``dpair = d # dlist`` ] ;; 10 | 11 | newconstant ( `HD` , ":dlist->d" ) ;; 12 | 13 | newconstant ( `TL` , ":dlist->dlist" ) ;; 14 | 15 | newconstant ( `CONS` , ":d->(dlist->dlist)" ) ;; 16 | 17 | newconstant ( `NIL` , ":dlist" ) ;; 18 | 19 | newconstant ( `dummy` , ":d" ) ;; 20 | 21 | newconstant ( `LIST` , ":d->dlist" ) ;; 22 | 23 | NEWAXIOMS();; 24 | 25 | AXHD "HD == \dl:dlist.FST(OUTR dl :dpair) :d" 26 | 27 | AXTL "TL == \dl:dlist.SND(OUTR dl :dpair) :dlist" 28 | 29 | AXNIL "NIL == INL () :dlist" 30 | 31 | AXCONS "CONS == \d:d.\dl:dlist.INR(d, dl) :dlist" 32 | 33 | AXNIL2 "EQ NIL NIL == TT" 34 | 35 | AXLIST "LIST == \d:d.INR(d, NIL) :dlist" 36 | 37 | NNCNS1 "!d:d. !s:dlist. EQ s NIL == FF IMP EQ(CONS d s)NIL == FF" 38 | 39 | NNCNS2 "!d:d. !s:dlist. EQ s NIL == TT IMP EQ(CONS d s)NIL == FF" 40 | 41 | % the last two should actually be proved as facts by contradiction % 42 | -------------------------------------------------------------------------------- /src/dml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP MKTIDY 4 | (LAMBDA(TY) 5 | ((LAMBDA (%L %STAR) (MKTIDYUP (MAKETY TY))) NIL (QUOTE *))) 6 | EXPR) 7 | 8 | (DEFPROP MKTIDYUP 9 | (LAMBDA(TY) 10 | (COND ((ASSOC1 TY %L)) 11 | ((ATOM TY) 12 | (SETQ %L (CONS (CONS TY %STAR) %L)) 13 | (SETQ %STAR (READLIST (CONS (QUOTE *) (EXPLODE %STAR)))) 14 | (CDAR %L)) 15 | ((SHARECONS (QUOTE MLTYPE) (CAR TY) (MKTIDYUPL (CDR TY)))))) 16 | EXPR) 17 | 18 | (DEFPROP MKTIDYUPL 19 | (LAMBDA(TYL) 20 | (COND 21 | (TYL 22 | (SHARECONS (QUOTE MLTYPE) 23 | (MKTIDYUP (CAR TYL)) 24 | (MKTIDYUPL (CDR TYL)))))) 25 | EXPR) 26 | 27 | (DEFPROP DML 28 | (LAMBDA(L) 29 | ((LAMBDA(FN ARGS BODY MTY) 30 | (PROG NIL 31 | (PUTPROP FN (LENGTH ARGS) (QUOTE NUMARGS)) 32 | (PUTPROP FN (LIST (QUOTE LAMBDA) ARGS BODY) (QUOTE EXPR)) 33 | (PUTPROP FN (MKTIDY MTY) (QUOTE MLTYPE)) 34 | (RETURN FN))) 35 | (CAR L) 36 | (CADR L) 37 | (CADDR L) 38 | (CADDDR L))) 39 | FEXPR) 40 | 41 | (DEFPROP DML' 42 | (LAMBDA(L) 43 | ((LAMBDA(FN N LISPFN MTY) 44 | (PROG NIL 45 | (PUTPROP FN (CONS LISPFN N) (QUOTE NUMARGS)) 46 | (PUTPROP FN (MKTIDY MTY) (QUOTE MLTYPE)) 47 | (RETURN FN))) 48 | (CAR L) 49 | (CADR L) 50 | (CADDR L) 51 | (CADDDR L))) 52 | FEXPR) 53 | 54 | (DEFPROP DMLC 55 | (LAMBDA(L) 56 | ((LAMBDA(ID EXP MTY) 57 | (PROG NIL 58 | (PUTPROP ID (EVAL EXP) (QUOTE MLVAL)) 59 | (PUTPROP ID (MKTIDY MTY) (QUOTE MLTYPE)) 60 | (RETURN ID))) 61 | (CAR L) 62 | (CADR L) 63 | (CADDR L))) 64 | FEXPR) 65 | 66 | (DEFPROP DIV 67 | (LAMBDA (X Y) (COND ((ZEROP Y) (ERR (QUOTE div))) (T (*QUO X Y)))) 68 | EXPR) 69 | 70 | (DEFPROP do 71 | (LAMBDA (X) NIL) 72 | EXPR) 73 | 74 | (DEFPROP hd 75 | (LAMBDA (X) (HDTL X (QUOTE hd))) 76 | EXPR) 77 | 78 | (DEFPROP tl 79 | (LAMBDA (X) (HDTL X (QUOTE tl))) 80 | EXPR) 81 | 82 | (DEFPROP HDTL 83 | (LAMBDA(X hdtl) 84 | (COND ((NULL X) (ERR hdtl)) 85 | ((ATOM X) (ERROR (CONS X (QUOTE (IS NOT A LIST))))) 86 | ((SELECTQ hdtl 87 | (hd (CAR X)) 88 | (tl (CDR X)) 89 | (ERROR (QUOTE HDTL)))))) 90 | EXPR) 91 | 92 | (DEFPROP isl 93 | (LAMBDA (X) (NOT (isr X))) 94 | EXPR) 95 | 96 | (DEFPROP isr 97 | (LAMBDA(X) 98 | (COND ((AND (NOT (ATOM X)) (MEMQ (CAR X) (QUOTE (T NIL)))) (CAR X)) 99 | ((ERROR (CONS X (QUOTE (BAD MLSUMTYPE))))))) 100 | EXPR) 101 | 102 | (DEFPROP outl 103 | (LAMBDA (X) (COND ((isr X) (ERR (QUOTE outl))) ((CDR X)))) 104 | EXPR) 105 | 106 | (DEFPROP outr 107 | (LAMBDA (X) (COND ((isr X) (CDR X)) ((ERR (QUOTE outr))))) 108 | EXPR) 109 | 110 | (DEFPROP inl 111 | (LAMBDA (X) (CONS NIL X)) 112 | EXPR) 113 | 114 | (DEFPROP inr 115 | (LAMBDA (X) (CONS T X)) 116 | EXPR) 117 | 118 | (DEFPROP explode 119 | (LAMBDA(X) 120 | (COND ((EQ X EMPTYTOK) NIL) (T (UNSLASHIFY (EXPLODE X))))) 121 | EXPR) 122 | 123 | (DEFPROP implode 124 | (LAMBDA(L) 125 | (COND ((NULL L) EMPTYTOK) 126 | ((MAPAND (FUNCTION (LAMBDA (X) (EQ (LENGTH (explode X)) 1))) 127 | L) 128 | (READLIST (SLASHIFY L))) 129 | ((ERR (QUOTE implode))))) 130 | EXPR) 131 | 132 | (DEFPROP mlinfix 133 | (LAMBDA (X) (MLINFIX X (QUOTE PAIRED))) 134 | EXPR) 135 | 136 | (DEFPROP mlcinfix 137 | (LAMBDA (X) (MLINFIX X (QUOTE CURRIED))) 138 | EXPR) 139 | 140 | (DEFPROP mlin 141 | (LAMBDA(%TOK PRFLAG) 142 | (ProtectIO 143 | (FUNCTION 144 | (LAMBDA(%F) 145 | (PROG (B %DUMP) 146 | (SETQ B 147 | (ERRSET 148 | (PROG2 (OPENERR (QUOTE DSK:) (FILEOF %TOK)) 149 | (TMLLOOP)))) 150 | (AND %DUMP (end (CDAR (LAST %DUMP)))) 151 | (AND (EQ B (QUOTE / DURING/ mlin/ )) 152 | (PRINX (QUOTE `) %TOK (QUOTE `) CR LF)) 153 | (OR (EQ B (QUOTE $EOF$)) (ERR (QUOTE mlin)))))) 154 | (LIST (QUOTE mlin)))) 155 | EXPR) 156 | 157 | (DEFPROP FILEOF 158 | (LAMBDA(TOK) 159 | (PROG (X Y) 160 | (SETQ Y (explode TOK)) 161 | L (COND ((NULL Y) (RETURN TOK)) 162 | ((EQ (CAR Y) (QUOTE /.)) 163 | (RETURN 164 | (CONS (implode (REVERSE X)) (implode (CDR Y))))) 165 | ((SETQ X (CONS (CAR Y) X)) (SETQ Y (CDR Y)) (GO L))))) 166 | EXPR) 167 | -------------------------------------------------------------------------------- /src/dml.lsp: -------------------------------------------------------------------------------- 1 | (MAPC (FUNCTION (LAMBDA (A) (EVLIST (QUOTE DML') (CAR A) 2 (CADR A) (CDDR A)))) 2 | (QUOTE 3 | ((* *TIMES (int # int) /-> int) 4 | (// DIV (int # int) /-> int) 5 | (/+ *PLUS (int # int) /-> int) 6 | (/- *DIF (int # int) /-> int) 7 | (= EQUAL (%a # %a) /-> bool) 8 | (< *LESS (int # int) /-> bool) 9 | (> *GREAT (int # int) /-> bool) 10 | (%& AND (bool # bool) /-> bool) 11 | (%or OR (bool # bool) /-> bool) 12 | (/@ *APPEND ((%a list) # (%a list)) /-> (%a list)) 13 | (/. CONS (%a # (%a list)) /-> (%a list))))) 14 | (MAPC (FUNCTION (LAMBDA (A) (EVLIST (QUOTE DML') (CAR A) 1 (CADR A) (CDDR A)))) 15 | (QUOTE 16 | ((%/- MINUS int /-> int) 17 | (not NOT bool /-> bool) 18 | (null NULL (%a list) /-> bool) 19 | (fst CAR (%a # %b) /-> %a) 20 | (snd CDR (%a # %b) /-> %b)))) 21 | (DMLC nil NIL (%a list)) 22 | (PUTPROP (QUOTE do) 1 (QUOTE NUMARGS)) 23 | (PUTPROP (QUOTE do) (MKTIDY (QUOTE (%a /-> /.))) (QUOTE MLTYPE)) 24 | (PUTPROP (QUOTE hd) 1 (QUOTE NUMARGS)) 25 | (PUTPROP (QUOTE hd) (MKTIDY (QUOTE ((%a list) /-> %a))) (QUOTE MLTYPE)) 26 | (PUTPROP (QUOTE tl) 1 (QUOTE NUMARGS)) 27 | (PUTPROP (QUOTE tl) (MKTIDY (QUOTE ((%a list) /-> (%a list)))) (QUOTE MLTYPE)) 28 | (PUTPROP (QUOTE isl) 1 (QUOTE NUMARGS)) 29 | (PUTPROP (QUOTE isl) (MKTIDY (QUOTE ((%a /+ %b) /-> bool))) (QUOTE MLTYPE)) 30 | (PUTPROP (QUOTE isr) 1 (QUOTE NUMARGS)) 31 | (PUTPROP (QUOTE isr) (MKTIDY (QUOTE ((%a /+ %b) /-> bool))) (QUOTE MLTYPE)) 32 | (PUTPROP (QUOTE outl) 1 (QUOTE NUMARGS)) 33 | (PUTPROP (QUOTE outl) (MKTIDY (QUOTE ((%a /+ %b) /-> %a))) (QUOTE MLTYPE)) 34 | (PUTPROP (QUOTE outr) 1 (QUOTE NUMARGS)) 35 | (PUTPROP (QUOTE outr) (MKTIDY (QUOTE ((%a /+ %b) /-> %b))) (QUOTE MLTYPE)) 36 | (PUTPROP (QUOTE inl) 1 (QUOTE NUMARGS)) 37 | (PUTPROP (QUOTE inl) (MKTIDY (QUOTE (%a /-> (%a /+ %b)))) (QUOTE MLTYPE)) 38 | (PUTPROP (QUOTE inr) 1 (QUOTE NUMARGS)) 39 | (PUTPROP (QUOTE inr) (MKTIDY (QUOTE (%b /-> (%a /+ %b)))) (QUOTE MLTYPE)) 40 | (SETQ EMPTYTOK (GENSYM)) 41 | (PUTPROP (QUOTE explode) 1 (QUOTE NUMARGS)) 42 | (PUTPROP (QUOTE explode) (MKTIDY (QUOTE (token /-> (token list)))) (QUOTE MLTYPE)) 43 | (PUTPROP (QUOTE implode) 1 (QUOTE NUMARGS)) 44 | (PUTPROP (QUOTE implode) (MKTIDY (QUOTE ((token list) /-> token))) (QUOTE MLTYPE)) 45 | (PUTPROP (QUOTE mlinfix) 1 (QUOTE NUMARGS)) 46 | (PUTPROP (QUOTE mlinfix) (MKTIDY (QUOTE (token /-> /.))) (QUOTE MLTYPE)) 47 | (PUTPROP (QUOTE mlcinfix) 1 (QUOTE NUMARGS)) 48 | (PUTPROP (QUOTE mlcinfix) (MKTIDY (QUOTE (token /-> /.))) (QUOTE MLTYPE)) 49 | (DML' gentok 0 GENSYM (/. /-> tok)) 50 | (PUTPROP (QUOTE mlin) 2 (QUOTE NUMARGS)) 51 | (PUTPROP (QUOTE mlin) (MKTIDY (QUOTE ((token # bool) /-> /.))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/drul.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let suboccs nll tt'l = 5 | substoccsinform (map (\(nl,t,t').(t,nl,t')) (combine(nll,tt'l))) ;; 6 | 7 | let GSUBS substfn thl th = 8 | let thxl = thxpairs thl in 9 | let w = substfn (xlhspairs thxl) (concl th) in 10 | SUBST thxl w th ;; 11 | 12 | let SUBS thl th = GSUBS substinform thl th ? failwith `SUBS` 13 | 14 | and SUBSOCCS nlthl th = 15 | let nll,thl = split nlthl in 16 | GSUBS (suboccs nll) thl th ? failwith `SUBSOCCS` ;; 17 | 18 | let SIMP ss th = p th where (),p,() = simpform ss (concl th) ;; 19 | 20 | let FIX th = (SUBS [SYM th] (FIXPT fun) 21 | where fix,fun = destcomb(snd(equivpair th)) 22 | )? failwith `FIX` ;; 23 | -------------------------------------------------------------------------------- /src/gen.ml: -------------------------------------------------------------------------------- 1 | 2 | (DML tokofint(N) N (int /-/> tok)) 3 | (DML intoftok(TOK) 4 | (COND ((NUMBERP TOK) TOK) (T (ERR @intoftok))) 5 | (tok /-/> int) 6 | ) 7 | 8 | (TML) 9 | 10 | let juxt(tok1,tok2) = implode( explode tok1 @ explode tok2) ;; 11 | 12 | mlinfix `orf`;; 13 | mlinfix `andf`;; 14 | mlinfix `o`;; 15 | mlinfix `orelsef`;; 16 | 17 | mlinfix `#`;; 18 | mlinfix `commaf`;; 19 | mlinfix `oo`;; 20 | mlinfix `o2`;; 21 | 22 | 23 | let $orf(p,q)x = p x or q x ;; 24 | 25 | let $andf(p,q)x = p x & q x ;; 26 | 27 | let notf p x = not p x ;; 28 | 29 | let $o(f,g)x = f(g x) ;; 30 | 31 | let $orelsef(f,g)x = f x ? g x ;; 32 | 33 | let condf(p,f,g)x = p x => f x | g x ;; 34 | 35 | let can f x = (f x ; true) ? false ;; 36 | 37 | let assert p x = p x => x | fail ;; 38 | 39 | 40 | let $# (f,g) (x,y) = (f x, g y);; 41 | 42 | let $commaf (f,g) x = (f x, g x);; 43 | 44 | let $oo (f,(g,h)) x = f(g x, h x);; 45 | 46 | let $o2 (f,g) x y = f(g x y);; 47 | 48 | let pair x y = (x,y);; 49 | 50 | let eqfst x (y,z) = (x=y) 51 | and eqsnd x (y,z) = (x=z);; 52 | 53 | let I x = x;; 54 | 55 | let K x y = x;; 56 | -------------------------------------------------------------------------------- /src/gp: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP GENLINK 3 | (LAMBDA NIL (CONS (QUOTE link) (SETQ LINKCOUNT (ADD1 LINKCOUNT)))) 4 | EXPR) 5 | 6 | (DEFPROP TYCONSTP 7 | (LAMBDA (TY) (GET TY (QUOTE CANON))) 8 | EXPR) 9 | 10 | (DEFPROP CONSTP 11 | (LAMBDA (TOK) (GET TOK (QUOTE const))) 12 | EXPR) 13 | 14 | (DEFPROP TRIPLE 15 | (LAMBDA (X Y Z) (CONS X (CONS Y Z))) 16 | EXPR) 17 | 18 | (DEFPROP STRIP 19 | (LAMBDA(TAG X) 20 | (COND ((EQ (CAR X) TAG) (CDR X)) 21 | ((ERR 22 | (READLIST (APPEND (EXPLODE (QUOTE dest)) (EXPLODE TAG))))))) 23 | EXPR) 24 | 25 | (DEFPROP REVASSOC 26 | (LAMBDA(X L) 27 | (PROG NIL 28 | (COND ((NULL L) (RETURN NIL))) 29 | A (COND ((EQ X (CDAR L)) (RETURN (CAR L))) 30 | ((SETQ L (CDR L)) (GO A))))) 31 | EXPR) 32 | 33 | (DEFPROP REVASSOC1 34 | (LAMBDA (X L) ((LAMBDA (PR) (COND (PR (CAR PR)))) (REVASSOC X L))) 35 | EXPR) 36 | 37 | (DEFPROP ASSOC1 38 | (LAMBDA (X L) ((LAMBDA (PR) (COND (PR (CDR PR)))) (ASSOC X L))) 39 | EXPR) 40 | 41 | (DEFPROP ITLIST 42 | (LAMBDA(FN XL X) 43 | (PROG NIL 44 | (SETQ XL (REVERSE XL)) 45 | L (COND ((NULL XL) (RETURN X)) 46 | (T (SETQ X (FN (CAR XL) X)) 47 | (SETQ XL (CDR XL)) 48 | (GO L))))) 49 | EXPR) 50 | 51 | (DEFPROP XGENSYM 52 | (LAMBDA(X) 53 | ((LAMBDA(XCOUNT BASE IBASE) 54 | (MAKNAM 55 | (APPEND (EXPLODE X) 56 | (EXPLODE (SET XCOUNT (ADD1 (EVAL XCOUNT))))))) 57 | (READLIST (CONS X (QUOTE (C O U N T)))) 58 | 12 59 | 12)) 60 | EXPR) 61 | 62 | (DEFPROP ADDPROP 63 | (LAMBDA (I V P) (CAR (PUTPROP I (CONS V (GET I P)) P))) 64 | EXPR) 65 | 66 | (DEFPROP SELECTQ 67 | (LAMBDA(%%%L) 68 | (PROG (%%%X1 %%%X2 %%%X3 %%%X4) 69 | (SETQ %%%X1 (EVAL (CAR %%%L))) 70 | (SETQ %%%X2 (CDR %%%L)) 71 | L (COND ((NULL (CDR %%%X2)) (RETURN (EVAL (CAR %%%X2)))) 72 | ((OR (EQ %%%X1 73 | (SETQ %%%X4 (CAR (SETQ %%%X3 (CAR %%%X2))))) 74 | (AND (NOT (ATOM %%%X4)) (MEMQ %%%X1 %%%X4))) 75 | (RETURN 76 | (EVAL (LIST (QUOTE COND) (CONS T (CDR %%%X3)))))) 77 | (T (SETQ %%%X2 (CDR %%%X2)) (GO L))))) 78 | FEXPR) 79 | 80 | (DEFPROP SELECTQ 81 | (NIL . N) 82 | VALUE) 83 | 84 | (DEFPROP CHARSEQ 85 | (LAMBDA(CH N) 86 | (PROG (L) 87 | LOOP (COND ((EQ N 0) (RETURN L))) 88 | (SETQ L (CONS CH L)) 89 | (SETQ N (SUB1 N)) 90 | (GO LOOP))) 91 | EXPR) 92 | 93 | (DEFPROP PACK 94 | (LAMBDA(L) 95 | (READLIST 96 | (ITLIST 97 | (FUNCTION 98 | (LAMBDA(Y YL) 99 | (APPEND 100 | (COND ((NUMBERP Y) (SLASHIFY (EXPLODE Y))) (T (EXPLODE Y))) 101 | YL))) 102 | L 103 | NIL))) 104 | EXPR) 105 | -------------------------------------------------------------------------------- /src/gpx: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP SELECTQ 3 | (LAMBDA(%SL) 4 | ((LAMBDA(%KEY %CLAUSES %ESC) 5 | (LIST (LIST (QUOTE LAMBDA) 6 | (QUOTE (%KEY)) 7 | (CONS (QUOTE COND) 8 | (APPEND (MAPCAR (FUNCTION T-CLAUSE) %CLAUSES) 9 | (LIST (LIST (QUOTE T) %ESC))))) 10 | %KEY)) 11 | (CADR %SL) 12 | (REVERSE (CDR (REVERSE (CDDR %SL)))) 13 | (CAR (REVERSE (CDDR %SL))))) 14 | MACRO) 15 | 16 | (DEFPROP T-CLAUSE 17 | (LAMBDA(%CL) 18 | (COND ((NULL (CDR %CL)) (LIST (T-LOCK (CAR %CL)) NIL)) 19 | (T (CONS (T-LOCK (CAR %CL)) (CDR %CL))))) 20 | EXPR) 21 | 22 | (DEFPROP T-LOCK 23 | (LAMBDA(%LOCK) 24 | (COND ((ATOM %LOCK) 25 | (LIST (QUOTE EQ) (QUOTE %KEY) (LIST (QUOTE QUOTE) %LOCK))) 26 | (T 27 | (LIST (QUOTE MEMQ) 28 | (QUOTE %KEY) 29 | (LIST (QUOTE QUOTE) %LOCK))))) 30 | EXPR) 31 | 32 | (DEFPROP PROGN 33 | (LAMBDA(%PL) 34 | (COND ((NULL (CDR %PL)) NIL) 35 | (T (LIST (QUOTE COND) (CONS (QUOTE T) (CDR %PL)))))) 36 | MACRO) 37 | 38 | (DEFPROP AND# 39 | (LAMBDA(%L) 40 | (COND ((NULL (CDR %L)) T) 41 | ((NULL (CDDR %L)) (CADR %L)) 42 | (T 43 | (LIST (QUOTE COND) 44 | (LIST (CONS (QUOTE AND) 45 | (REVERSE (CDR (REVERSE (CDR %L))))) 46 | (CAR (REVERSE (CDDR %L)))))))) 47 | MACRO) 48 | 49 | (DEFPROP POPQ 50 | (LAMBDA(%%L%%) 51 | (LIST (QUOTE SETQ) (CADR %%L%%) (LIST (QUOTE CDR) (CADR %%L%%)))) 52 | MACRO) 53 | 54 | (DEFPROP PUSHQ 55 | (LAMBDA(%%L%%) 56 | (LIST (QUOTE SETQ) 57 | (CADDR %%L%%) 58 | (LIST (QUOTE CONS) (CADR %%L%%) (CADDR %%L%%)))) 59 | MACRO) 60 | -------------------------------------------------------------------------------- /src/iox: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 (LAP CLRBFI SUBR) 5 | C00009 ENDMK 6 | C⊗; 7 | (LAP CLRBFI SUBR) 8 | (051000 11 0 0) 9 | (POPJ P) 10 | NIL 11 | 12 | 13 | ~↑Z Specials: %F, PRFLAG, %FN, %ARGS, %L, %G 14 | 15 | ~↑Z Manifest: CR, LF 16 | 17 | ~↑Z FEXPRs: DIN, NULLIFY 18 | 19 | ~↑Z MACROs: EVLIST, PRINX, MAKE 20 | 21 | 22 | (SETQ %F NIL) 23 | 24 | (DE ERR%F (X Y) (PRINX X @": " Y CR LF (ERR %F))) 25 | 26 | (DE SLASHIFY (L) (PROG (L1) K (COND 27 | ((NULL L) (RETURN (REVERSE L1))) 28 | ((SETQ L1 (CONS(CAR L)(CONS @// L1))) (SETQ L (CDR L)) (GO K)) 29 | ))) 30 | 31 | (DE UNSLASHIFY (L) (PROG (L1) K (COND 32 | ((NULL L) (RETURN (REVERSE L1))) 33 | ((AND (EQ(CAR L)@//) (NULL(SETQ L (CDR L)))) (ERR @UNSLASHIFY)) 34 | (T (SETQ L1 (CONS(CAR L)L1)) (SETQ L (CDR L)) (GO K)) 35 | ))) 36 | 37 | (DE PUSHNCONC (ID X) (SET ID (NCONC (EVAL ID) (LIST X)))) 38 | ~↑Z All values of ID must be special 39 | 40 | (DE INQ (X L) (COND ((MEMQ X L) L) ((CONS X L)))) 41 | 42 | (DE OUTQ (X L) (COND (L (COND 43 | ((EQ X (CAR L)) (OUTQ X (CDR L))) 44 | ((CONS (CAR L) (OUTQ X (CDR L)))) 45 | )))) 46 | 47 | (DE MAPAND (F L) (OR (NULL L) 48 | (AND (APPLY F (LIST (CAR L))) (MAPAND F (CDR L))) 49 | )) 50 | 51 | (DE MAPOR (F L) (AND (NOT(NULL L)) 52 | (OR (APPLY F (LIST (CAR L))) (MAPOR F (CDR L))) 53 | )) 54 | 55 | (DE QEVAL (X) (LIST @QUOTE X)) 56 | 57 | (DM EVLIST (L) (LIST @EVAL (CONS @LIST (CDR L)))) 58 | 59 | (DE JUXT (X Y) (implode(NCONC(explode X)(explode Y)))) 60 | 61 | (DE ASK (Q) (PROG (X L) 62 | (PRINX CR LF Q @/?) 63 | (PROMPT 32.) 64 | (CLRBFI) 65 | K (COND 66 | ((EQ(SETQ X (READCH))CR) (PROMPT 42.) (RETURN(REVERSE L))) 67 | ((SETQ L (CONS X L)) (GO K)) 68 | ))) 69 | 70 | (DE PeekINC () ((LAMBDA (CH) (PROG2 (INC CH T) CH)) (INC NIL NIL))) 71 | (DE PeekOUTC () ((LAMBDA (CH) (PROG2 (OUTC CH T) CH)) (OUTC NIL NIL))) 72 | 73 | (DE ProtectIO (%FN %ARGS) (PROG (ICH OCH B) 74 | (SETQ ICH (PeekINC)) 75 | (SETQ OCH (PeekOUTC)) 76 | (SETQ B (ERRSET (APPLY %FN %ARGS))) 77 | (OR (EQ ICH (PeekINC)) (INC ICH T)) 78 | (OR (EQ OCH (PeekOUTC)) (OUTC OCH T)) 79 | (COND ((ATOM B) (ERR B)) (T (RETURN (CAR B))) ) 80 | )) 81 | 82 | (DF DIN (L) (ProtectIO (FUNCTION (LAMBDA (L) (PROG (DEV X B) 83 | (SETQ DEV @DSK:) 84 | A (COND 85 | ((NULL L) (RETURN @FILES-LOADED)) 86 | ((ISDEV(SETQ X (CAR L))) (SETQ DEV X) (GO Z)) 87 | ) 88 | (OPENERR DEV X) 89 | K (COND 90 | ((NOT(ATOM(SETQ B (ERRSET(EVAL(READ)))))) 91 | (COND (PRFLAG (PRINT(CAR B))) (T (PRINC @/:))) 92 | (GO K) 93 | )) 94 | (OR (EQ B @$EOF$) (ERR @DIN)) 95 | (PRINX (AND PRFLAG (TERPRI)) X @/ LOADED) 96 | (TERPRI) 97 | Z (SETQ L (CDR L)) 98 | (GO A) 99 | ))) 100 | (LIST L) 101 | )) 102 | 103 | (DE ISDEV (X) (COND 104 | ((ATOM X) (EQ @/: (CAR(LAST(EXPLODE X))))) 105 | ((EQ(LENGTH X)2) (AND (NUMBERP(CAR X)) (NUMBERP(CADR X)))) 106 | )) 107 | 108 | (DE ISDSK (F) (ProtectIO (FUNCTION OPENP) (LIST @DSK: F))) 109 | 110 | (DE OPENERR (DEV F) (OR (OPENP DEV F) (PROG2 111 | (PRINC @"CAN'T FIND ") 112 | (SELECTQ %F 113 | (draftin (ERR%F @DRAFT (CAR F))) 114 | (newparent (ERR%F @THEORY (CAR F))) 115 | (ERR%F @FILE F) 116 | )))) 117 | 118 | (DE OPENP (DEV F) (PROG (%G %L) 119 | (SETQ %L (LIST @INPUT (SETQ %G (GENSYM)) DEV F)) 120 | (COND 121 | ((NOT(ATOM(ERRSET(INC(EVAL %L)NIL)NIL))) (RETURN T)) 122 | (T (ERRSET(INC %G NIL)NIL) (INC NIL T) (RETURN NIL)) 123 | ))) 124 | 125 | (DE OPENO (F) (OUTC (EVLIST @OUTPUT (GENSYM) @DSK: F) NIL)) 126 | 127 | (DE CLOSEI () (INC NIL T)) 128 | (DE CLOSEO () (OUTC NIL T)) 129 | 130 | (DE OPENCOPY (F) (PROG2 (OPENO F) (COPY F))) 131 | (DE COPY (F) (AND (OPENP @DSK: F) (COPYTILLEOF))) 132 | (DE COPYTILLEOF() (ERRSET(PROG() K (TYO(TYI)) (GO K)))) 133 | 134 | (DM PRINX (L) (CONS @PROG (CONS NIL (MAPCAR 135 | (FUNCTION (LAMBDA (A) (COND 136 | ((OR (ATOM A) (EQ(CAR A)@QUOTE)) (LIST @PRINC A)) 137 | ((ATOM (CDR A)) (LIST @COPY (LIST @QUOTE A))) 138 | (T A) 139 | ))) 140 | (CDR L) 141 | )))) 142 | 143 | (DM MAKE (L) (LIST @PROG2 144 | (LIST @OPENO (CADR L)) 145 | (CONS @PRINX (CDDR L)) 146 | @(CLOSEO) 147 | )) 148 | 149 | (DE CONCAT (F1 F2) (PROG() (OPENCOPY F1) (COPY F2) (CLOSEO))) 150 | 151 | (DF NULLIFY (L) (MAPC (FUNCTION NULLIFY1) L)) 152 | (DE NULLIFY1 (F) (OR (NULLP F) (MAKE F))) 153 | (DE NULLP (F) (OR 154 | (NOT (OPENP @DSK: F)) 155 | (EQ (ERRSET(TYI)) @$EOF$) 156 | (PROG2 (CLOSEI) NIL) 157 | )) 158 | 159 | (DE SKIPTO (X) (PROG() K (OR (EQ(READCH)X) (GO K)))) 160 | 161 | (DE FINDP (S) (PROG (S1 S2 X B) 162 | (COND 163 | ((OR(NULL S)(MEMQ @/" S)) 164 | (ERR%F @"BAD TOK FOR FINDP" (implode S))) 165 | ) 166 | A (SETQ S1 NIL) 167 | (SETQ S2 S) 168 | L (COND 169 | (B (SETQ X (CAR B)) (SETQ B (CDR B))) 170 | ((EQ (SETQ X (ERRSET(READCH))) @$EOF$) (RETURN NIL)) 171 | ((SETQ X (CAR X))) 172 | ) 173 | (COND 174 | ((EQ X @/") (SETQ B NIL) (SKIPTO @/") (GO A)) 175 | ((EQ X (CAR S2)) 176 | (SETQ S1 (CONS X S1)) 177 | (OR (SETQ S2 (CDR S2)) (RETURN @FOUND)) 178 | ) 179 | (S1 (SETQ B (NCONC(CDR(REVERSE S1))(CONS X B))) (GO A)) 180 | ) 181 | (GO L) 182 | )) 183 | 184 | -------------------------------------------------------------------------------- /src/iox.lsp: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 5 | C00003 ENDMK 6 | C⊗; 7 | 8 | 9 | (SETQ %F NIL) 10 | (DM EVLIST (L) (LIST (QUOTE EVAL) (CONS (QUOTE LIST) (CDR L)))) 11 | (DM PRINX 12 | (L) 13 | (CONS (QUOTE PROG) 14 | (CONS NIL 15 | (MAPCAR (FUNCTION 16 | (LAMBDA(A) 17 | (COND ((OR (ATOM A) (EQ (CAR A) (QUOTE QUOTE))) (LIST (QUOTE PRINC) A)) 18 | ((ATOM (CDR A)) (LIST (QUOTE COPY) (LIST (QUOTE QUOTE) A))) 19 | (T A)))) 20 | (CDR L))))) 21 | (DM MAKE (L) (LIST (QUOTE PROG2) (LIST (QUOTE OPENO) (CADR L)) (CONS (QUOTE PRINX) (CDDR L)) (QUOTE (CLOSEO)))) 22 | 23 | 24 | -------------------------------------------------------------------------------- /src/lap.dir: -------------------------------------------------------------------------------- 1 | This is the list of LAP-files deleted on 6-mar-1978 2 | 3 | 06-MAR-78 1147 4 | FILNAM EXT PPN SIZE WRITTEN TIME PRO WRITER REFERENCE DUMPED OFF 5 | 6 | OL3 LAP LCFFWH 575 26-JAN-78 1313 000 LCFFWH TENDMP 09-FEB-78 07-FEB-78 P1061> 7 | CLRBFI LAP LCFFWH 12 26-JAN-78 1414 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 8 | PROMPT LAP LCFFWH 38 26-JAN-78 1414 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 9 | GP LAP LCFFWH 729 26-JAN-78 1414 000 LFWH COPY 09-FEB-78 07-FEB-78 P1061> 10 | LEAN LAP LCFFWH 1.5 26-JAN-78 1414 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 11 | OPP LAP LCFFWH 557 26-JAN-78 1414 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 12 | LCFO LAP LCFFWH 1.9 26-JAN-78 1414 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 13 | LCFM LAP LCFFWH 5.5 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 14 | MLPRIN LAP LCFFWH 869 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 15 | SHARE LAP LCFFWH 917 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 16 | TYPEOL LAP LCFFWH 1.2 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 17 | TYPEML LAP LCFFWH 7.8 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 18 | DML LAP LCFFWH 1.3 26-JAN-78 1308 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 19 | TRAN LAP LCFFWH 5.5 26-JAN-78 1415 000 LFWH COPY 08-FEB-78 07-FEB-78 P1061> 20 | WRITML LAP LCFFWH 3.5 26-JAN-78 1309 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 21 | TML LAP LCFFWH 2.0 26-JAN-78 1309 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 22 | THYFNS LAP LCFFWH 5.8 26-JAN-78 1309 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 23 | LIS LAP LCFFWH 741 26-JAN-78 1309 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 24 | OL0 LAP LCFFWH 2.4 26-JAN-78 1310 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 25 | OL1 LAP LCFFWH 1.2 26-JAN-78 1310 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 26 | OL2 LAP LCFFWH 3.8 26-JAN-78 1310 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 27 | SIMPL LAP LCFFWH 1.6 26-JAN-78 1313 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 28 | TRACE LAP LCFFWH 300 26-JAN-78 1314 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 29 | IOX LAP LCFFWH 2.1 26-JAN-78 1314 000 LCFFWH TENDMP 08-FEB-78 07-FEB-78 P1061> 30 | TOTAL= 52.5 31 | 32 | -------------------------------------------------------------------------------- /src/lap/clrbfi.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP CLRBFI SUBR) 3 | (051000 11 0 0) 4 | (POPJ P) 5 | NIL 6 | -------------------------------------------------------------------------------- /src/lap/dml.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP MKTIDY SUBR) 3 | (MOVEI 2 (QUOTE NIL))(MOVEI 3 (QUOTE *))(JSP 6 SPECBIND)(0 2 (SPECIAL %L))(0 3 (SPECIAL %STAR)) 4 | (PUSH P 1)(CALL 1 (E MAKETY))(CALL 1 (E MKTIDYUP))(SUB P (C 0 0 1 1))(JRST 0 SPECSTR) 5 | NIL 6 | 7 | 8 | (LAP MKTIDYUP SUBR) 9 | (PUSH P 1)(MOVE 2 (SPECIAL %L))(CALL 2 (E ASSOC1))(JUMPN 1 G0001)(MOVE 1 0 P)(CALL 1 (E ATOM)) 10 | (JUMPE 1 G0003)(MOVE 2 (SPECIAL %STAR))(MOVE 1 0 P)(CALL 2 (E CONS))(MOVE 2 (SPECIAL %L)) 11 | (CALL 2 (E CONS))(MOVEM 1 (SPECIAL %L))(MOVE 1 (SPECIAL %STAR))(CALL 1 (E EXPLODE)) 12 | (MOVEI 2 (QUOTE *))(CALL 2 (E XCONS))(CALL 1 (E READLIST))(MOVEM 1 (SPECIAL %STAR)) 13 | (HLRZ@ 1 (SPECIAL %L))(HRRZ@ 1 1)(JRST 0 G0001) 14 | G0003 (HLRZ@ 1 0 P)(PUSH P 1)(HRRZ@ 1 -1 P)(CALL 1 (E MKTIDYUPL))(MOVE 3 1)(POP P 2)(MOVEI 1 (QUOTE MLTYPE)) 15 | (CALL 3 (E SHARECONS)) 16 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 17 | NIL 18 | 19 | 20 | (LAP MKTIDYUPL SUBR) 21 | (PUSH P 1)(JUMPE 1 G0002)(HLRZ@ 1 1)(CALL 1 (E MKTIDYUP))(PUSH P 1)(HRRZ@ 1 -1 P) 22 | (CALL 1 (E MKTIDYUPL))(MOVE 3 1)(POP P 2)(MOVEI 1 (QUOTE MLTYPE))(CALL 3 (E SHARECONS)) 23 | G0002 (SUB P (C 0 0 1 1))(POPJ P) 24 | NIL 25 | 26 | 27 | (LAP DML FSUBR) 28 | (HLRZ@ 2 1)(HRRZ@ 3 1)(HLRZ@ 3 3)(HRRZ@ 4 1)(HRRZ@ 4 4)(HLRZ@ 4 4)(HRRZ@ 5 1)(HRRZ@ 5 5) 29 | (HRRZ@ 5 5)(HLRZ@ 5 5)(MOVE 1 3)(PUSH P 2)(PUSH P 3)(CALL 1 (E LENGTH))(MOVEI 3 (QUOTE NUMARGS)) 30 | (MOVE 2 1)(MOVE 1 -1 P)(PUSH P 4)(PUSH P 5)(CALL 3 (E PUTPROP))(MOVE 1 -1 P)(CALL 1 (E NCONS)) 31 | (MOVE 2 -2 P)(CALL 2 (E XCONS))(MOVEI 2 (QUOTE LAMBDA))(CALL 2 (E XCONS))(MOVEI 3 (QUOTE EXPR)) 32 | (MOVE 2 1)(MOVE 1 -3 P)(CALL 3 (E PUTPROP))(MOVE 1 0 P)(CALL 1 (E MKTIDY))(MOVEI 3 (QUOTE MLTYPE)) 33 | (MOVE 2 1)(MOVE 1 -3 P)(CALL 3 (E PUTPROP))(MOVE 4 -3 P)(EXCH 1 4)(SUB P (C 0 0 4 4)) 34 | (POPJ P) 35 | NIL 36 | 37 | 38 | (LAP DML' FSUBR) 39 | (HLRZ@ 2 1)(HRRZ@ 3 1)(HLRZ@ 3 3)(HRRZ@ 4 1)(HRRZ@ 4 4)(HLRZ@ 4 4)(HRRZ@ 5 1)(HRRZ@ 5 5) 40 | (HRRZ@ 5 5)(HLRZ@ 5 5)(PUSH P 2)(MOVE 2 3)(EXCH 1 4)(CALL 2 (E CONS))(PUSH P 3)(MOVEI 3 (QUOTE NUMARGS)) 41 | (MOVE 2 1)(MOVE 1 -1 P)(PUSH P 5)(CALL 3 (E PUTPROP))(MOVE 1 0 P)(CALL 1 (E MKTIDY)) 42 | (MOVEI 3 (QUOTE MLTYPE))(MOVE 2 1)(MOVE 1 -2 P)(CALL 3 (E PUTPROP))(MOVE 4 -2 P)(EXCH 1 4) 43 | (SUB P (C 0 0 3 3))(POPJ P) 44 | NIL 45 | 46 | 47 | (LAP DMLC FSUBR) 48 | (HLRZ@ 2 1)(HRRZ@ 3 1)(HLRZ@ 3 3)(HRRZ@ 4 1)(HRRZ@ 4 4)(HLRZ@ 4 4)(MOVE 1 3)(PUSH P 2) 49 | (PUSH P 3)(PUSH P 4)(CALL 1 (E *EVAL))(MOVEI 3 (QUOTE MLVAL))(MOVE 2 1)(MOVE 1 -2 P) 50 | (CALL 3 (E PUTPROP))(MOVE 1 0 P)(CALL 1 (E MKTIDY))(MOVEI 3 (QUOTE MLTYPE))(MOVE 2 1) 51 | (MOVE 1 -2 P)(CALL 3 (E PUTPROP))(MOVE 3 -2 P)(EXCH 1 3)(SUB P (C 0 0 3 3))(POPJ P) 52 | NIL 53 | 54 | 55 | (LAP DIV SUBR) 56 | (PUSH P 1)(PUSH P 2)(EXCH 1 2)(CALL 1 (E ZEROP))(JUMPE 1 G0002)(MOVEI 1 (QUOTE div)) 57 | (CALL 1 (E ERR))(JRST 0 G0001) 58 | G0002 (MOVE 2 0 P)(MOVE 1 -1 P)(CALL 2 (E *QUO)) 59 | G0005 60 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 61 | NIL 62 | 63 | 64 | (LAP do SUBR) 65 | (MOVEI 1 (QUOTE NIL))(POPJ P) 66 | NIL 67 | 68 | 69 | (LAP hd SUBR) 70 | (MOVEI 2 (QUOTE hd))(JCALL 2 (E HDTL)) 71 | NIL 72 | 73 | 74 | (LAP tl SUBR) 75 | (MOVEI 2 (QUOTE tl))(JCALL 2 (E HDTL)) 76 | NIL 77 | 78 | 79 | (LAP HDTL SUBR) 80 | (PUSH P 1)(PUSH P 2)(JUMPN 1 G0002)(EXCH 1 2)(CALL 1 (E ERR))(JRST 0 G0001) 81 | G0002 (CALL 1 (E ATOM))(JUMPE 1 G0004)(MOVEI 2 (QUOTE (IS NOT A LIST)))(MOVE 1 -1 P)(CALL 2 (E CONS)) 82 | (CALL 1 (E ERROR))(JRST 0 G0001) 83 | G0004 (PUSH P 2)(CAIE 2 (QUOTE hd))(JRST 0 G0009)(HLRZ@ 1 -2 P)(JRST 0 G0008) 84 | G0009 (CAIE 2 (QUOTE tl))(JRST 0 G0011)(HRRZ@ 1 -2 P)(JRST 0 G0008) 85 | G0011 (MOVEI 1 (QUOTE HDTL))(CALL 1 (E ERROR)) 86 | G0013 87 | G0008 (SUB P (C 0 0 1 1)) 88 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 89 | NIL 90 | 91 | 92 | (LAP isl SUBR) 93 | (CALL 1 (E isr))(JUMPE 1 G0001)(TDZA 1 1) 94 | G0001 (MOVEI 1 T)(POPJ P) 95 | NIL 96 | 97 | 98 | (LAP isr SUBR) 99 | (PUSH P 1)(CALL 1 (E ATOM))(JUMPN 1 G0002)(MOVEI 2 (QUOTE (T NIL)))(HLRZ@ 1 0 P)(CALL 2 (E MEMQ)) 100 | (JUMPE 1 G0002)(HLRZ@ 1 0 P)(JRST 0 G0001) 101 | G0002 (MOVEI 2 (QUOTE (BAD MLSUMTYPE)))(MOVE 1 0 P)(CALL 2 (E CONS))(CALL 1 (E ERROR)) 102 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 103 | NIL 104 | 105 | 106 | (LAP outl SUBR) 107 | (PUSH P 1)(CALL 1 (E isr))(JUMPE 1 G0002)(MOVEI 1 (QUOTE outl))(CALL 1 (E ERR))(JRST 0 G0001) 108 | G0002 (HRRZ@ 1 0 P) 109 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 110 | NIL 111 | 112 | 113 | (LAP outr SUBR) 114 | (PUSH P 1)(CALL 1 (E isr))(JUMPE 1 G0002)(HRRZ@ 1 0 P)(JRST 0 G0001) 115 | G0002 (MOVEI 1 (QUOTE outr))(CALL 1 (E ERR)) 116 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 117 | NIL 118 | 119 | 120 | (LAP inl SUBR) 121 | (MOVEI 2 (QUOTE NIL))(JCALL 2 (E XCONS)) 122 | NIL 123 | 124 | 125 | (LAP inr SUBR) 126 | (MOVEI 2 (QUOTE T))(JCALL 2 (E XCONS)) 127 | NIL 128 | 129 | 130 | (LAP explode SUBR) 131 | (PUSH P 1)(CAME 1 (SPECIAL EMPTYTOK))(JRST 0 G0002)(MOVEI 1 (QUOTE NIL))(JRST 0 G0001) 132 | G0002 (MOVE 1 0 P)(CALL 1 (E EXPLODE))(CALL 1 (E UNSLASHIFY)) 133 | G0003 134 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 135 | NIL 136 | 137 | 138 | (LAP implode#1 SUBR) 139 | (CALL 1 (E explode))(CALL 1 (E LENGTH))(CAIE 1 (QUOTE 1))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 140 | NIL 141 | 142 | 143 | (LAP implode SUBR) 144 | (PUSH P 1)(JUMPN 1 G0005)(MOVE 1 (SPECIAL EMPTYTOK))(JRST 0 G0004) 145 | G0005 (MOVE 2 1)(MOVEI 1 (QUOTE implode#1))(CALL 2 (E MAPAND))(JUMPE 1 G0006)(MOVE 1 0 P) 146 | (CALL 1 (E SLASHIFY))(CALL 1 (E READLIST))(JRST 0 G0004) 147 | G0006 (MOVEI 1 (QUOTE implode))(CALL 1 (E ERR)) 148 | G0004 (SUB P (C 0 0 1 1))(POPJ P) 149 | NIL 150 | 151 | 152 | (LAP mlinfix SUBR) 153 | (MOVEI 2 (QUOTE PAIRED))(JCALL 2 (E MLINFIX)) 154 | NIL 155 | 156 | 157 | (LAP mlcinfix SUBR) 158 | (MOVEI 2 (QUOTE CURRIED))(JCALL 2 (E MLINFIX)) 159 | NIL 160 | 161 | 162 | (LAP mlin#2 SUBR) 163 | (MOVE 1 (SPECIAL %TOK))(CALL 1 (E FILEOF))(MOVE 2 1)(MOVEI 1 (QUOTE DSK:))(CALL 2 (E OPENERR)) 164 | (JCALL 0 (E TMLLOOP)) 165 | NIL 166 | 167 | 168 | (LAP mlin#1 SUBR) 169 | (JSP 6 SPECBIND)(0 1 (SPECIAL %F))(0 0 (SPECIAL %DUMP))(MOVEI 1 (QUOTE ((mlin#2)))) 170 | (CALL 17 (E ERRSET))(PUSH P 1)(MOVE 1 (SPECIAL %DUMP))(JUMPE 1 G0009)(CALL 1 (E LAST)) 171 | (CALL 1 (E CDAR))(CALL 1 (E end))(JUMPN 1 G0008) 172 | G0009 173 | G0008 (MOVE 1 0 P)(CAIE 1 (QUOTE / DURING/ mlin/ ))(JRST 0 G0015)(MOVEI 1 (QUOTE `))(CALL 1 (E PRINC)) 174 | (MOVE 1 (SPECIAL %TOK))(CALL 1 (E PRINC))(MOVEI 1 (QUOTE `))(CALL 1 (E PRINC))(MOVE 1 (SPECIAL CR)) 175 | (CALL 1 (E PRINC))(MOVE 1 (SPECIAL LF))(CALL 1 (E PRINC))(MOVEI 1 (QUOTE NIL))(JUMPN 1 G0014) 176 | G0015 177 | G0014 (MOVE 1 0 P)(CAIN 1 (QUOTE $EOF$))(JRST 0 G0026)(MOVEI 1 (QUOTE mlin))(CALL 1 (E ERR)) 178 | (JUMPN 1 G0026) 179 | G0026 (MOVEI 1 (QUOTE NIL))(SUB P (C 0 0 1 1))(JRST 0 SPECSTR) 180 | NIL 181 | 182 | 183 | (LAP mlin SUBR) 184 | (JSP 6 SPECBIND)(0 1 (SPECIAL %TOK))(0 2 (SPECIAL PRFLAG))(MOVEI 1 (QUOTE mlin))(CALL 1 (E NCONS)) 185 | (MOVE 2 1)(MOVEI 1 (QUOTE mlin#1))(CALL 2 (E ProtectIO))(JRST 0 SPECSTR) 186 | NIL 187 | 188 | 189 | (LAP FILEOF SUBR) 190 | (PUSH P 1)(CALL 1 (E explode))(PUSH P 1)(PUSH P (C 0 0 (QUOTE NIL))) 191 | G0001 (MOVE 1 -1 P)(JUMPN 1 G0007)(MOVE 1 -2 P)(JRST 0 G0002) 192 | G0007 (HLRZ@ 1 1)(CAIE 1 (QUOTE /.))(JRST 0 G0009)(MOVE 1 0 P)(CALL 1 (E REVERSE))(CALL 1 (E implode)) 193 | (PUSH P 1)(HRRZ@ 1 -2 P)(CALL 1 (E implode))(POP P 2)(CALL 2 (E XCONS))(JRST 0 G0002) 194 | G0009 (MOVE 2 0 P)(CALL 2 (E CONS))(MOVEM 1 0 P)(JUMPE 1 G0017)(HRRZ@ 1 -1 P)(MOVEM 1 -1 P) 195 | (JRST 0 G0001) 196 | G0017 (MOVEI 1 (QUOTE NIL)) 197 | G0002 (SUB P (C 0 0 3 3))(POPJ P) 198 | NIL 199 | 200 | -------------------------------------------------------------------------------- /src/lap/gp.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP GENLINK SUBR) 3 | (MOVE 1 (SPECIAL LINKCOUNT))(CALL 1 (E ADD1))(MOVEM 1 (SPECIAL LINKCOUNT))(MOVEI 2 (QUOTE link)) 4 | (JCALL 2 (E XCONS)) 5 | NIL 6 | 7 | 8 | (LAP TYCONSTP SUBR) 9 | (MOVEI 2 (QUOTE CANON))(JCALL 2 (E GET)) 10 | NIL 11 | 12 | 13 | (LAP CONSTP SUBR) 14 | (MOVEI 2 (QUOTE const))(JCALL 2 (E GET)) 15 | NIL 16 | 17 | 18 | (LAP TRIPLE SUBR) 19 | (EXCH 2 3)(EXCH 1 3)(CALL 2 (E CONS))(MOVE 2 3)(JCALL 2 (E XCONS)) 20 | NIL 21 | 22 | 23 | (LAP STRIP SUBR) 24 | (PUSH P 1)(PUSH P 2)(HLRZ@ 1 2)(CAME 1 -1 P)(JRST 0 G0002)(HRRZ@ 1 2)(JRST 0 G0001) 25 | G0002 (MOVEI 1 (QUOTE dest))(CALL 1 (E EXPLODE))(PUSH P 1)(MOVE 1 -2 P)(CALL 1 (E EXPLODE)) 26 | (MOVE 2 1)(POP P 1)(CALL 2 (E *APPEND))(CALL 1 (E READLIST))(CALL 1 (E ERR)) 27 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 28 | NIL 29 | 30 | 31 | (LAP REVASSOC SUBR) 32 | (PUSH P 1)(PUSH P 2)(JUMPE 2 G0003) 33 | G0001 (HLRZ@ 1 0 P)(HRRZ@ 1 1)(CAME 1 -1 P)(JRST 0 G0008)(HLRZ@ 1 0 P)(JRST 0 G0002) 34 | G0008 (HRRZ@ 1 0 P)(MOVEM 1 0 P)(JUMPN 1 G0001) 35 | G0003 (MOVEI 1 (QUOTE NIL)) 36 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 37 | NIL 38 | 39 | 40 | (LAP REVASSOC1 SUBR) 41 | (CALL 2 (E REVASSOC))(PUSH P 1)(JUMPE 1 G0003)(HLRZ@ 1 1) 42 | G0003 (SUB P (C 0 0 1 1))(POPJ P) 43 | NIL 44 | 45 | 46 | (LAP ASSOC1 SUBR) 47 | (CALL 2 (E ASSOC))(PUSH P 1)(JUMPE 1 G0003)(HRRZ@ 1 1) 48 | G0003 (SUB P (C 0 0 1 1))(POPJ P) 49 | NIL 50 | 51 | 52 | (LAP ITLIST SUBR) 53 | (PUSH P 1)(MOVE 1 2)(PUSH P 2)(PUSH P 3)(CALL 1 (E REVERSE))(MOVEM 1 -1 P) 54 | G0001 (MOVE 1 -1 P)(JUMPN 1 G0007)(MOVE 1 0 P)(JRST 0 G0002) 55 | G0007 (MOVE 2 0 P)(HLRZ@ 1 -1 P)(CALLF@ 2 -2 P)(MOVEM 1 0 P)(HRRZ@ 1 -1 P)(JRST 0 (G0001 -1)) 56 | G0009 (MOVEI 1 (QUOTE NIL)) 57 | G0002 (SUB P (C 0 0 3 3))(POPJ P) 58 | NIL 59 | 60 | 61 | (LAP XGENSYM SUBR) 62 | (MOVEI 2 (QUOTE (C O U N T)))(PUSH P 1)(CALL 2 (E CONS))(CALL 1 (E READLIST))(MOVEI 2 (QUOTE 12)) 63 | (MOVEI 3 (QUOTE 12))(JSP 6 SPECBIND)(0 2 (SPECIAL BASE))(0 3 (SPECIAL IBASE))(PUSH P 1) 64 | (MOVE 1 -1 P)(CALL 1 (E EXPLODE))(MOVEM 1 -1 P)(MOVE 1 0 P)(CALL 1 (E *EVAL))(CALL 1 (E ADD1)) 65 | (MOVE 2 1)(MOVE 1 0 P)(CALL 2 (E SET))(CALL 1 (E EXPLODE))(MOVE 2 1)(EXCH 1 -1 P) 66 | (CALL 2 (E *APPEND))(CALL 1 (E MAKNAM))(SUB P (C 0 0 2 2))(JRST 0 SPECSTR) 67 | NIL 68 | 69 | 70 | (LAP ADDPROP SUBR) 71 | (PUSH P 2)(MOVE 2 3)(PUSH P 1)(CALL 2 (E GET))(EXCH 2 -1 P)(CALL 2 (E XCONS))(MOVE 2 1) 72 | (POP P 1)(CALL 3 (E PUTPROP))(HLRZ@ 1 1)(SUB P (C 0 0 1 1))(POPJ P) 73 | NIL 74 | 75 | 76 | (LAP SELECTQ FSUBR) 77 | (PUSH P 1)(HLRZ@ 1 1)(CALL 1 (E *EVAL))(PUSH P 1)(HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(PUSH P (C 0 0 (QUOTE NIL))~ 78 | )(PUSH P (C 0 0 (QUOTE NIL))) 79 | G0001 (HRRZ@ 1 -3 P)(JUMPN 1 G0009)(HLRZ@ 1 -3 P)(CALL 1 (E *EVAL))(JRST 0 G0002) 80 | G0009 (HLRZ@ 1 -3 P)(MOVEM 1 0 P)(HLRZ@ 1 1)(MOVEM 1 -1 P)(CAMN 1 -2 P)(JRST 0 G0015)(CALL 1 (E ATOM)) 81 | (JUMPN 1 G0014)(MOVE 2 -1 P)(MOVE 1 -2 P)(CALL 2 (E MEMQ))(JUMPE 1 G0014) 82 | G0015 (HRRZ@ 2 0 P)(MOVEI 1 (QUOTE T))(CALL 2 (E CONS))(CALL 1 (E NCONS))(CALL 17 (E COND)) 83 | (JRST 0 G0002) 84 | G0014 (HRRZ@ 1 -3 P)(MOVEM 1 -3 P)(JRST 0 G0001) 85 | G0026 (MOVEI 1 (QUOTE NIL)) 86 | G0002 (SUB P (C 0 0 4 4))(POPJ P) 87 | NIL 88 | 89 | 90 | (DEFPROP SELECTQ (NIL . N) VALUE) 91 | (LAP CHARSEQ SUBR) 92 | (PUSH P 1)(PUSH P 2)(PUSH P (C 0 0 (QUOTE NIL))) 93 | G0001 (MOVE 1 -1 P)(CAIE 1 (QUOTE 0))(JRST 0 G0006)(MOVE 1 0 P)(JRST 0 G0002) 94 | G0006 (MOVE 2 0 P)(MOVE 1 -2 P)(CALL 2 (E CONS))(MOVEM 1 0 P)(MOVE 1 -1 P)(CALL 1 (E SUB1)) 95 | (MOVEM 1 -1 P)(JRST 0 G0001) 96 | G0002 (SUB P (C 0 0 3 3))(POPJ P) 97 | NIL 98 | 99 | 100 | (LAP PACK#1 SUBR) 101 | (PUSH P 1)(PUSH P 2)(CALL 1 (E NUMBERP))(JUMPE 1 G0002)(MOVE 1 -1 P)(CALL 1 (E EXPLODE)) 102 | (CALL 1 (E SLASHIFY))(JRST 0 G0001) 103 | G0002 (MOVE 1 -1 P)(CALL 1 (E EXPLODE)) 104 | G0006 105 | G0001 (POP P 2)(SUB P (C 0 0 1 1))(JCALL 2 (E *APPEND)) 106 | NIL 107 | 108 | 109 | (LAP PACK SUBR) 110 | (MOVEI 3 (QUOTE NIL))(MOVE 2 1)(MOVEI 1 (QUOTE PACK#1))(CALL 3 (E ITLIST))(JCALL 1 (E READLIST)) 111 | NIL 112 | 113 | -------------------------------------------------------------------------------- /src/lap/lis.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP twoof SUBR) 3 | (PUSH P 1)(JUMPE 1 G0002)(HRRZ@ 2 1)(JUMPE 2 G0002)(HRRZ@ 2 0 P)(HLRZ@ 2 2)(HLRZ@ 1 0 P) 4 | (CALL 2 (E CONS))(JRST 0 G0001) 5 | G0002 (MOVEI 1 (QUOTE twoof))(CALL 1 (E ERR)) 6 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 7 | NIL 8 | 9 | 10 | (LAP threeof SUBR) 11 | (PUSH P 1)(JUMPE 1 G0002)(HRRZ@ 2 1)(JUMPE 2 G0002)(HRRZ@ 3 2)(JUMPE 3 G0002)(HRRZ@ 2 0 P) 12 | (HRRZ@ 2 2)(HLRZ@ 2 2)(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 2 (E CONS))(HLRZ@ 2 0 P)(CALL 2 (E XCONS)) 13 | (JRST 0 G0001) 14 | G0002 (MOVEI 1 (QUOTE threeof))(CALL 1 (E ERR)) 15 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 16 | NIL 17 | 18 | 19 | (LAP flat SUBR) 20 | (PUSH P 1)(PUSH P (C 0 0 G0001))(PUSH P (C 0 0 (QUOTE APPEND)))(PUSH P 1)(MOVNI 6 2) 21 | (JCALL 16 (E APPLY)) 22 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 23 | NIL 24 | 25 | 26 | (LAP map#1 SUBR) 27 | (MOVE 2 1)(MOVE 1 (SPECIAL %%F))(JCALL 2 (E AP)) 28 | NIL 29 | 30 | 31 | (LAP map SUBR) 32 | (JSP 6 SPECBIND)(0 1 (SPECIAL %%F))(MOVEI 1 (QUOTE map#1))(CALL 2 (E MAPCAR))(JRST 0 SPECSTR) 33 | NIL 34 | 35 | 36 | (LAP exists SUBR) 37 | (PUSH P 1)(PUSH P 2) 38 | G0001 (MOVE 1 0 P)(JUMPE 1 G0003)(HLRZ@ 2 1)(MOVE 1 -1 P)(CALL 2 (E AP))(JUMPE 1 G0006)(MOVEI 1 (QUOTE T)) 39 | (JRST 0 G0002) 40 | G0006 (HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0001) 41 | G0010 42 | G0003 (MOVEI 1 (QUOTE NIL)) 43 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 44 | NIL 45 | 46 | 47 | (LAP forall SUBR) 48 | (PUSH P 1)(PUSH P 2) 49 | G0001 (MOVE 1 0 P)(JUMPN 1 G0006)(MOVEI 1 (QUOTE T))(JRST 0 G0002) 50 | G0006 (HLRZ@ 2 1)(MOVE 1 -1 P)(CALL 2 (E AP))(JUMPE 1 G0008)(HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0001) 51 | G0008 (JRST 0 G0002) 52 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 53 | NIL 54 | 55 | 56 | (LAP revitlist SUBR) 57 | (PUSH P 1)(PUSH P 2)(PUSH P 3) 58 | G0001 (MOVE 1 -1 P)(JUMPN 1 G0006)(MOVE 1 0 P)(JRST 0 G0002) 59 | G0006 (HLRZ@ 2 -1 P)(MOVE 1 -2 P)(CALL 2 (E AP))(MOVE 2 0 P)(CALL 2 (E AP))(MOVEM 1 0 P)(HRRZ@ 1 -1 P) 60 | (MOVEM 1 -1 P)(JRST 0 G0001) 61 | G0002 (SUB P (C 0 0 3 3))(POPJ P) 62 | NIL 63 | 64 | 65 | (LAP find SUBR) 66 | (PUSH P 1)(PUSH P 2) 67 | G0001 (MOVE 1 0 P)(JUMPN 1 G0006)(MOVEI 1 (QUOTE fail))(CALL 1 (E ERR))(JRST 0 G0005) 68 | G0006 (HLRZ@ 2 1)(MOVE 1 -1 P)(CALL 2 (E AP))(JUMPE 1 G0008)(HLRZ@ 1 0 P)(JRST 0 G0002) 69 | G0008 (HRRZ@ 1 0 P)(MOVEM 1 0 P)(JRST 0 G0001) 70 | G0013 71 | G0005 (MOVEI 1 (QUOTE NIL)) 72 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 73 | NIL 74 | 75 | 76 | (LAP tryfind#1 SUBR) 77 | (HLRZ@ 2 (SPECIAL %L))(MOVE 1 (SPECIAL %%F))(JCALL 2 (E AP)) 78 | NIL 79 | 80 | 81 | (LAP tryfind SUBR) 82 | (JSP 6 SPECBIND)(0 1 (SPECIAL %%F))(0 2 (SPECIAL %L))(PUSH P (C 0 0 (QUOTE NIL))) 83 | G0001 (MOVE 1 (SPECIAL %L))(JUMPN 1 G0008)(MOVEI 1 (QUOTE fail))(CALL 1 (E ERR)) 84 | G0008 (MOVEI 1 (QUOTE ((tryfind#1))))(CALL 17 (E ERRSET))(MOVEM 1 0 P)(CALL 1 (E ATOM))(JUMPN 1 G0013) 85 | (HLRZ@ 1 0 P)(JRST 0 G0004) 86 | G0013 (HRRZ@ 1 (SPECIAL %L))(MOVEM 1 (SPECIAL %L))(JRST 0 G0001) 87 | G0017 (MOVEI 1 (QUOTE NIL)) 88 | G0004 (SUB P (C 0 0 1 1))(JRST 0 SPECSTR) 89 | NIL 90 | 91 | 92 | (LAP filter SUBR) 93 | (PUSH P 1)(PUSH P 2)(PUSH P (C 0 0 (QUOTE NIL))) 94 | G0001 (MOVE 1 -1 P)(JUMPN 1 G0006)(MOVE 1 0 P)(CALL 1 (E REVERSE))(JRST 0 G0002) 95 | G0006 (HLRZ@ 2 1)(MOVE 1 -2 P)(CALL 2 (E AP))(JUMPE 1 G0009)(MOVE 2 0 P)(HLRZ@ 1 -1 P)(CALL 2 (E CONS)) 96 | (MOVEM 1 0 P) 97 | G0009 (HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0001) 98 | G0002 (SUB P (C 0 0 3 3))(POPJ P) 99 | NIL 100 | 101 | 102 | (LAP mapfilter#1 SUBR) 103 | (HLRZ@ 2 (SPECIAL %L))(MOVE 1 (SPECIAL %%F))(JCALL 2 (E AP)) 104 | NIL 105 | 106 | 107 | (LAP mapfilter SUBR) 108 | (JSP 6 SPECBIND)(0 1 (SPECIAL %%F))(0 2 (SPECIAL %L))(PUSH P (C 0 0 (QUOTE NIL))) 109 | (PUSH P (C 0 0 (QUOTE NIL))) 110 | G0001 (MOVE 1 (SPECIAL %L))(JUMPN 1 G0008)(MOVE 1 -1 P)(CALL 1 (E REVERSE))(JRST 0 G0004) 111 | G0008 (MOVEI 1 (QUOTE ((mapfilter#1))))(CALL 17 (E ERRSET))(MOVEM 1 0 P)(CALL 1 (E ATOM)) 112 | (JUMPN 1 G0014)(MOVE 2 -1 P)(HLRZ@ 1 0 P)(CALL 2 (E CONS))(MOVEM 1 -1 P) 113 | G0014 (HRRZ@ 1 (SPECIAL %L))(MOVEM 1 (SPECIAL %L))(JRST 0 G0001) 114 | G0004 (SUB P (C 0 0 2 2))(JRST 0 SPECSTR) 115 | NIL 116 | 117 | -------------------------------------------------------------------------------- /src/lap/ltcons.lap: -------------------------------------------------------------------------------- 1 | (SETQ BASE (SETQ IBASE (ADD1 7))) 2 | 3 | (LAP LTSET SUBR) 4 | (PUSH P 1) 5 | (PUSH P 2) 6 | (PUSH P (C 0 0 (QUOTE NIL) 0)) 7 | (MOVE 4 2) 8 | (MOVE 3 (SPECIAL BPEND)) 9 | (MOVE 2 (SPECIAL BPORG)) 10 | (CALL 4 (E LTSET1)) 11 | (MOVEM 1 0 P) 12 | (JUMPE 1 TAG5) 13 | (MOVE 1 -1 P) 14 | (JUMPE 1 TAG5) 15 | (MOVE 1 0 P) 16 | (MOVEM 1 (SPECIAL BPORG)) 17 | TAG5 (MOVE 1 0 P) 18 | (JUMPN 1 TAG7) 19 | (TDZA 1 1) 20 | TAG7 (MOVEI 1 (QUOTE T)) 21 | (SUB P (C 0 0 3 3)) 22 | (POPJ P) 23 | NIL 24 | 25 | (LAP LTREL SUBR) 26 | (PUSH P (C 0 0 (QUOTE NIL) 0)) 27 | (MOVE 2 (SPECIAL BPEND)) 28 | (MOVE 1 (SPECIAL BPORG)) 29 | (CALL 2 (E LTREL1)) 30 | (MOVEM 1 0 P) 31 | (JUMPE 1 TAG5) 32 | (MOVEM 1 (SPECIAL BPORG)) 33 | TAG5 (MOVE 1 0 P) 34 | (JUMPN 1 TAG6) 35 | (TDZA 1 1) 36 | TAG6 (MOVEI 1 (QUOTE T)) 37 | (SUB P (C 0 0 1 1)) 38 | (POPJ P) 39 | NIL 40 | 41 | (LAP LTREAD SUBR) 42 | (MOVEI 2 (QUOTE SUBR)) 43 | (MOVEI 1 (QUOTE READ)) 44 | (CALL 2 (E GET)) 45 | (MOVEI 2 (QUOTE FIXNUM)) 46 | (CALL 2 (E MAKNUM)) 47 | (MOVEI 2 (QUOTE 25)) 48 | (CALL 2 (E *PLUS)) 49 | (MOVEI 2 (QUOTE SUBR)) 50 | (PUSH P 1) 51 | (MOVEI 1 (QUOTE XCONS)) 52 | (CALL 2 (E GET)) 53 | (MOVEI 2 (QUOTE FIXNUM)) 54 | (CALL 2 (E MAKNUM)) 55 | (MOVEI 2 (QUOTE SUBR)) 56 | (PUSH P 1) 57 | (MOVEI 1 (QUOTE LTXCONS)) 58 | (CALL 2 (E GET)) 59 | (MOVEI 2 (QUOTE FIXNUM)) 60 | (CALL 2 (E MAKNUM)) 61 | (MOVEI 2 (QUOTE 254000000000)) 62 | (PUSH P 1) 63 | (CALL 2 (E *PLUS)) 64 | (MOVE 2 1) 65 | (MOVE 1 -2 P) 66 | (CALL 2 (E DEPOSIT)) 67 | (CALL 0 (E READ)) 68 | (MOVE 2 -1 P) 69 | (PUSH P 1) 70 | (MOVEI 1 (QUOTE 254000000000)) 71 | (CALL 2 (E *PLUS)) 72 | (MOVE 2 1) 73 | (MOVE 1 -3 P) 74 | (CALL 2 (E DEPOSIT)) 75 | (MOVE 1 0 P) 76 | (SUB P (C 0 0 4 4)) 77 | (POPJ P) 78 | NIL 79 | 80 | (GETSYM SUBR LTCONS LTXCONS LTSET1 LTREL1 UNLTCONS DDT) 81 | 82 | (GETSYM SUBR LTOCCUPANCY LTAVERAGELOOKUP LTMAXLOOKUP) -------------------------------------------------------------------------------- /src/lap/mlprin.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP PP SUBR) 3 | (JSP 6 SPECBIND)(0 1 (SPECIAL %EX))(0 2 (SPECIAL %PPDEPTH))(CALL 1 (E ATOM))(JUMPE 1 G0002) 4 | (MOVE 1 (SPECIAL %EX))(CALL 1 (E PRINC))(JRST 0 G0001) 5 | G0002 (HLRZ@ 1 (SPECIAL %EX))(PUSH P (SPECIAL %EX))(CALL 1 (E LOOKUP))(MOVE 3 (SPECIAL %PPDEPTH)) 6 | (MOVE 2 1)(POP P 1)(CALL 3 (E PPRINT)) 7 | G0005 8 | G0001 (JRST 0 SPECSTR) 9 | NIL 10 | 11 | 12 | (LAP PPRINT#1 SUBR) 13 | (MOVE 2 (SPECIAL %PPDEPTH))(JCALL 2 (E PP)) 14 | NIL 15 | 16 | 17 | (LAP PPRINT#2 SUBR) 18 | (MOVE 5 4)(EXCH 4 3)(EXCH 3 2)(MOVE 2 (SPECIAL %PPDEPTH))(JCALL 5 (E PPL)) 19 | NIL 20 | 21 | 22 | (LAP PPRINT SUBR) 23 | (JSP 6 SPECBIND)(0 1 (SPECIAL %EX))(0 3 (SPECIAL %PPDEPTH))(PUSH P 2)(PUSH P (C 0 0 (QUOTE NIL))) 24 | (EXCH 1 3)(CALL 1 (E ZEROP))(JUMPE 1 G0008)(MOVE 1 (SPECIAL PPSYM))(CALL 1 (E PRINC)) 25 | (JRST 0 G0004) 26 | G0008 27 | G0001 (MOVE 1 -1 P)(JUMPE 1 G0005)(HLRZ@ 1 -1 P)(MOVEM 1 0 P)(CALL 1 (E NUMBERP))(JUMPE 1 G0017) 28 | (HRRZ@ 2 (SPECIAL %EX))(MOVE 1 0 P)(CALL 2 (E GETNTH))(PUSH P 1)(MOVE 1 (SPECIAL %PPDEPTH)) 29 | (CALL 1 (E SUB1))(MOVE 2 1)(POP P 1)(CALL 2 (E PP))(JRST 0 G0016) 30 | G0017 (MOVE 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0023)(MOVE 1 0 P)(CALL 1 (E PRINC))(JRST 0 G0016) 31 | G0023 (MOVEI 1 (QUOTE PPRINT#1))(MOVEI 2 (QUOTE PPRINT#2))(JSP 6 SPECBIND)(0 1 (SPECIAL %PP)) 32 | (0 2 (SPECIAL %PPL))(MOVE 1 0 P)(CALL 1 (E *EVAL))(PUSHJ P SPECSTR) 33 | G0026 34 | G0016 (HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0001) 35 | G0005 (MOVEI 1 (QUOTE NIL)) 36 | G0004 (SUB P (C 0 0 2 2))(JRST 0 SPECSTR) 37 | NIL 38 | 39 | 40 | (LAP PPL SUBR) 41 | (JSP 6 SPECBIND)(0 2 (SPECIAL %PPDEPTH))(EXCH 1 3)(PUSH P 3)(PUSH P 4)(PUSH P 5)(CALL 1 (E PRINC)) 42 | (MOVE 1 -2 P)(JUMPE 1 G0002) 43 | G0001 (MOVE 2 (SPECIAL %PPDEPTH))(HLRZ@ 1 -2 P)(CALL 2 (E PP))(HRRZ@ 1 -2 P)(MOVEM 1 -2 P) 44 | (JUMPE 1 G0002)(MOVE 1 -1 P)(CALL 1 (E PRINC))(JRST 0 G0001) 45 | G0013 46 | G0002 (MOVE 1 0 P)(CALL 1 (E PRINC))(MOVEI 1 (QUOTE NIL))(SUB P (C 0 0 3 3))(JRST 0 SPECSTR) 47 | NIL 48 | 49 | 50 | (LAP LOOKUP SUBR) 51 | (PUSH P (SPECIAL PRINTTABLE))(PUSH P 1) 52 | G0001 (MOVE 1 -1 P)(JUMPN 1 G0006)(CALL 0 (E SYSTEMERROR))(JRST 0 G0005) 53 | G0006 (CALL 1 (E CAAR))(CAME 1 0 P)(JRST 0 G0008)(HLRZ@ 1 -1 P)(HRRZ@ 1 1)(JRST 0 G0002) 54 | G0008 (HRRZ@ 1 -1 P)(MOVEM 1 -1 P)(JRST 0 G0001) 55 | G0012 56 | G0005 (MOVEI 1 (QUOTE NIL)) 57 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 58 | NIL 59 | 60 | 61 | (LAP GETNTH SUBR) 62 | (PUSH P 1)(PUSH P 2)(CALL 1 (E ZEROP))(JUMPN 1 G0003)(MOVE 1 0 P)(JUMPN 1 G0002) 63 | G0003 (CALL 0 (E SYSTEMERROR))(JRST 0 G0001) 64 | G0002 (MOVE 1 -1 P)(CAIE 1 (QUOTE 1))(JRST 0 G0006)(HLRZ@ 1 0 P)(JRST 0 G0001) 65 | G0006 (MOVE 1 -1 P)(CALL 1 (E SUB1))(HRRZ@ 2 0 P)(CALL 2 (E GETNTH)) 66 | G0008 67 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 68 | NIL 69 | 70 | 71 | (LAP TESTTRAPFN SUBR) 72 | (PUSH P 1)(HLRZ@ 1 2)(PUSH P 1)(PUSH P 2)(PUSH P (C 0 0 (QUOTE NIL))) 73 | G0001 (MOVE 1 -2 P)(JUMPN 1 G0008)(HRRZ@ 2 -1 P)(JUMPE 2 G0004)(HRRZ@ 1 -1 P)(HLRZ@ 1 1)(MOVEM 1 0 P) 74 | (JRST 0 G0002) 75 | G0011 76 | G0008 (HLRZ@ 1 -2 P)(MOVEM 1 0 P)(MOVE 1 -3 P)(JUMPE 1 G0019)(MOVEI 1 (QUOTE "if "))(JRST 0 G0018) 77 | G0019 (HLRZ@ 1 0 P)(CAIE 1 (QUOTE ONCE))(JRST 0 G0023)(MOVE 1 (SPECIAL TP3SYM))(JRST 0 G0022) 78 | G0023 (MOVE 1 (SPECIAL TP4SYM)) 79 | G0025 80 | G0022 81 | G0020 82 | G0018 (CALL 1 (E PRINC))(MOVE 2 (SPECIAL %PPDEPTH))(HRRZ@ 1 0 P)(HLRZ@ 1 1)(CALL 2 (E PP)) 83 | (MOVE 1 -3 P)(JUMPE 1 G0033)(HLRZ@ 1 0 P)(CAIE 1 (QUOTE ONCE))(JRST 0 G0035)(MOVEI 1 (QUOTE " then ")) 84 | (JRST 0 G0034) 85 | G0035 (MOVEI 1 (QUOTE " loop ")) 86 | G0037 87 | G0034 (CALL 1 (E PRINC))(JRST 0 G0032) 88 | G0033 (MOVEI 1 (QUOTE / ))(CALL 1 (E PRINC)) 89 | G0041 90 | G0032 (MOVE 2 (SPECIAL %PPDEPTH))(HRRZ@ 1 0 P)(HRRZ@ 1 1)(CALL 2 (E PP))(HRRZ@ 1 -2 P)(MOVEM 1 -2 P) 91 | (JRST 0 G0001) 92 | G0002 (MOVE 1 -3 P)(JUMPE 1 G0050)(HLRZ@ 1 0 P)(CAIE 1 (QUOTE ONCE))(JRST 0 G0052)(MOVEI 1 (QUOTE " else ")) 93 | (JRST 0 G0051) 94 | G0052 (MOVEI 1 (QUOTE " loop ")) 95 | G0054 96 | G0051 (CALL 1 (E PRINC))(JRST 0 G0049) 97 | G0050 (HLRZ@ 1 0 P)(CALL 1 (E ATOM))(JUMPE 1 G0061)(HLRZ@ 1 0 P)(CAIE 1 (QUOTE ONCE))(JRST 0 G0065) 98 | (MOVE 1 (SPECIAL TP1SYM))(JRST 0 G0064) 99 | G0065 (MOVE 1 (SPECIAL TP2SYM)) 100 | G0067 101 | G0064 (CALL 1 (E PRINC))(JRST 0 G0060) 102 | G0061 (HLRZ@ 1 0 P)(HLRZ@ 1 1)(CAIE 1 (QUOTE ONCE))(JRST 0 G0074)(MOVE 1 (SPECIAL TP5SYM)) 103 | (JRST 0 G0073) 104 | G0074 (MOVE 1 (SPECIAL TP6SYM)) 105 | G0076 106 | G0073 (CALL 1 (E PRINC))(HLRZ@ 1 0 P)(HRRZ@ 1 1)(CALL 1 (E PRINC))(MOVEI 1 (QUOTE / ))(CALL 1 (E PRINC)) 107 | G0071 108 | G0060 109 | G0058 110 | G0049 (MOVE 2 (SPECIAL %PPDEPTH))(HRRZ@ 1 0 P)(CALL 2 (E PP)) 111 | G0004 (MOVEI 1 (QUOTE NIL))(SUB P (C 0 0 4 4))(POPJ P) 112 | NIL 113 | 114 | -------------------------------------------------------------------------------- /src/lap/ol1.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP isquant SUBR) 3 | (HLRZ@ 2 1)(CAIE 2 (QUOTE quant))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 4 | NIL 5 | 6 | 7 | (LAP isimp SUBR) 8 | (HLRZ@ 2 1)(CAIE 2 (QUOTE imp))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 9 | NIL 10 | 11 | 12 | (LAP isconj SUBR) 13 | (HLRZ@ 2 1)(CAIE 2 (QUOTE conj))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 14 | NIL 15 | 16 | 17 | (LAP isequiv SUBR) 18 | (HLRZ@ 2 1)(CAIE 2 (QUOTE equiv))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 19 | NIL 20 | 21 | 22 | (LAP isinequiv SUBR) 23 | (HLRZ@ 2 1)(CAIE 2 (QUOTE inequiv))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 24 | NIL 25 | 26 | 27 | (LAP istruth SUBR) 28 | (HLRZ@ 2 1)(CAIE 2 (QUOTE truth))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 29 | NIL 30 | 31 | 32 | (LAP istype SUBR) 33 | (PUSH P 1)(PUSH P 2)(HLRZ@ 1 2)(CAME 1 -1 P)(TDZA 1 1)(MOVEI 1 T)(JUMPN 1 G0001)(HLRZ@ 1 2) 34 | (CAIE 1 (QUOTE consttype))(JRST 0 G0004)(MOVEI 2 (QUOTE EQTYPE))(HRRZ@ 1 0 P)(CALL 2 (E GET)) 35 | (MOVEM 1 0 P)(JUMPE 1 G0007)(EXCH 2 1)(MOVE 1 -1 P)(CALL 2 (E istype))(JUMPN 1 G0006) 36 | G0007 (TDZA 1 1) 37 | G0006 (MOVEI 1 T)(JRST 0 G0001) 38 | G0004 (MOVEI 1 (QUOTE NIL)) 39 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 40 | NIL 41 | 42 | 43 | (LAP issumtype SUBR) 44 | (MOVE 2 1)(MOVEI 1 (QUOTE sumtype))(JCALL 2 (E istype)) 45 | NIL 46 | 47 | 48 | (LAP isprodtype SUBR) 49 | (MOVE 2 1)(MOVEI 1 (QUOTE prodtype))(JCALL 2 (E istype)) 50 | NIL 51 | 52 | 53 | (LAP isfuntype SUBR) 54 | (MOVE 2 1)(MOVEI 1 (QUOTE funtype))(JCALL 2 (E istype)) 55 | NIL 56 | 57 | 58 | (LAP isconsttype SUBR) 59 | (HLRZ@ 2 1)(CAIE 2 (QUOTE consttype))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 60 | NIL 61 | 62 | 63 | (LAP isvartype SUBR) 64 | (HLRZ@ 2 1)(CAIE 2 (QUOTE vartype))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 65 | NIL 66 | 67 | 68 | (LAP isabs SUBR) 69 | (HLRZ@ 2 1)(CAIE 2 (QUOTE abs))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 70 | NIL 71 | 72 | 73 | (LAP iscomb SUBR) 74 | (HLRZ@ 2 1)(CAIE 2 (QUOTE comb))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 75 | NIL 76 | 77 | 78 | (LAP isvar SUBR) 79 | (HLRZ@ 2 1)(CAIE 2 (QUOTE var))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 80 | NIL 81 | 82 | 83 | (LAP isconst SUBR) 84 | (HLRZ@ 2 1)(CAIE 2 (QUOTE const))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 85 | NIL 86 | 87 | 88 | (LAP destaform SUBR) 89 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(CAIE 2 (QUOTE equiv))(JRST 0 G0003)(HRRZ@ 2 1)(MOVE 1 (SPECIAL %mkequivc~ 90 | losure))(CALL 2 (E CONS))(JRST 0 G0002) 91 | G0003 (CAIE 2 (QUOTE inequiv))(JRST 0 G0006)(HRRZ@ 2 1)(MOVE 1 (SPECIAL %mkinequivclosure)) 92 | (CALL 2 (E CONS))(JRST 0 G0002) 93 | G0006 (MOVEI 1 (QUOTE destaform))(CALL 1 (E ERR)) 94 | G0009 95 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 96 | NIL 97 | 98 | 99 | (LAP mkCOND SUBR) 100 | (MOVEI 2 (QUOTE MLVAL))(PUSH P 1)(MOVEI 1 (QUOTE trtype))(CALL 2 (E GET))(MOVE 2 0 P) 101 | (PUSH P 1)(MOVE 1 2)(CALL 2 (E mk=funtype))(MOVE 2 1)(EXCH 1 -1 P)(CALL 2 (E mk=funtype)) 102 | (MOVE 2 1)(POP P 1)(CALL 2 (E mk=funtype))(MOVE 2 1)(MOVEI 1 (QUOTE COND))(SUB P (C 0 0 1 1)) 103 | (JCALL 2 (E mkconst)) 104 | NIL 105 | 106 | 107 | (LAP mkcond SUBR) 108 | (PUSH P 1)(PUSH P 2)(PUSH P 3)(MOVEI 2 (QUOTE MLVAL))(MOVEI 1 (QUOTE trtype))(CALL 2 (E GET)) 109 | (HRRZ@ 4 -2 P)(HRRZ@ 4 4)(CAME 4 1)(JRST 0 G0002)(HRRZ@ 1 3)(HRRZ@ 1 1)(HRRZ@ 5 -1 P) 110 | (HRRZ@ 5 5)(CAME 5 1)(JRST 0 G0002)(HRRZ@ 1 -1 P)(HRRZ@ 1 1)(CALL 1 (E mkCOND))(MOVE 2 -2 P) 111 | (CALL 2 (E mkcomb))(MOVE 2 -1 P)(CALL 2 (E mkcomb))(MOVE 2 0 P)(CALL 2 (E mkcomb)) 112 | (JRST 0 G0001) 113 | G0002 (MOVEI 1 (QUOTE mkcond))(CALL 1 (E ERR)) 114 | G0001 (SUB P (C 0 0 3 3))(POPJ P) 115 | NIL 116 | 117 | 118 | (LAP mkPAIR SUBR) 119 | (PUSH P 2)(PUSH P 1)(CALL 2 (E mk=prodtype))(MOVE 2 1)(EXCH 1 -1 P)(CALL 2 (E mk=funtype)) 120 | (MOVE 2 1)(POP P 1)(CALL 2 (E mk=funtype))(MOVE 2 1)(MOVEI 1 (QUOTE PAIR))(SUB P (C 0 0 1 1)) 121 | (JCALL 2 (E mkconst)) 122 | NIL 123 | 124 | 125 | (LAP mkpair SUBR) 126 | (PUSH P 2)(HRRZ@ 2 2)(HRRZ@ 2 2)(PUSH P 1)(CALL 1 (E CDDR))(CALL 2 (E mkPAIR))(POP P 2) 127 | (CALL 2 (E mkcomb))(POP P 2)(JCALL 2 (E mkcomb)) 128 | NIL 129 | 130 | 131 | (LAP destcond SUBR) 132 | (PUSH P 1)(PUSH P (C 0 0 (QUOTE NIL)))(PUSH P (C 0 0 (QUOTE NIL)))(PUSH P (C 0 0 (QUOTE NIL))) 133 | (CALL 1 (E iscomb))(JUMPE 1 G0005)(HRRZ@ 1 -3 P)(CALL 1 (E CDAR))(MOVEM 1 -2 P)(HRRZ@ 1 -3 P) 134 | (CALL 1 (E CAAR))(MOVEM 1 -3 P)(CALL 1 (E iscomb))(JUMPE 1 G0005)(HRRZ@ 1 -3 P)(CALL 1 (E CDAR)) 135 | (MOVEM 1 -1 P)(HRRZ@ 1 -3 P)(CALL 1 (E CAAR))(MOVEM 1 -3 P)(CALL 1 (E iscomb))(JUMPE 1 G0005) 136 | (HRRZ@ 1 -3 P)(CALL 1 (E CDAR))(HRRZ@ 2 -3 P)(HLRZ@ 2 2)(HLRZ@ 2 2)(HRRZ@ 2 2)(HLRZ@ 2 2) 137 | (MOVEM 1 0 P)(CAIE 2 (QUOTE COND))(TDZA 1 1)(MOVEI 1 T)(JUMPE 1 G0005)(MOVE 2 -2 P) 138 | (MOVE 1 -1 P)(CALL 2 (E CONS))(MOVE 2 0 P)(CALL 2 (E XCONS))(JRST 0 G0001) 139 | G0005 (MOVEI 1 (QUOTE destcond))(CALL 1 (E ERR))(MOVEI 1 (QUOTE NIL)) 140 | G0001 (SUB P (C 0 0 4 4))(POPJ P) 141 | NIL 142 | 143 | 144 | (LAP destpair SUBR) 145 | (PUSH P 1)(CALL 1 (E CDDR))(PUSH P 1)(PUSH P (C 0 0 (QUOTE NIL)))(PUSH P (C 0 0 (QUOTE NIL))) 146 | (CALL 1 (E isprodtype))(JUMPN 1 G0006)(MOVEI 1 (QUOTE destpair))(CALL 1 (E ERR))(JRST 0 G0005) 147 | G0006 (MOVE 1 -3 P)(CALL 1 (E isUU))(JUMPE 1 G0009)(MOVE 1 -2 P)(CALL 1 (E destprodtype)) 148 | (HLRZ@ 2 1)(MOVEM 1 -2 P)(MOVEI 1 (QUOTE UU))(CALL 2 (E mkconst))(HRRZ@ 2 -2 P)(MOVEM 1 0 P) 149 | (MOVEI 1 (QUOTE UU))(CALL 2 (E mkconst))(MOVEM 1 -1 P)(JRST 0 G0005) 150 | G0009 (MOVE 1 -3 P)(CALL 1 (E iscomb))(JUMPE 1 G0017)(HRRZ@ 1 -3 P)(CALL 1 (E CDAR))(MOVEM 1 -1 P) 151 | (HRRZ@ 1 -3 P)(CALL 1 (E CAAR))(MOVEM 1 -3 P)(CALL 1 (E iscomb))(JUMPE 1 G0017)(HRRZ@ 1 -3 P) 152 | (CALL 1 (E CDAR))(HRRZ@ 2 -3 P)(HLRZ@ 2 2)(HLRZ@ 2 2)(HRRZ@ 2 2)(HLRZ@ 2 2)(MOVEM 1 0 P) 153 | (CAIE 2 (QUOTE PAIR))(TDZA 1 1)(MOVEI 1 T)(JUMPN 1 G0016) 154 | G0017 (TDZA 1 1) 155 | G0016 (MOVEI 1 T)(JUMPN 1 G0005)(MOVEI 1 (QUOTE destpair))(CALL 1 (E ERR)) 156 | G0005 (MOVE 2 -1 P)(MOVE 1 0 P)(SUB P (C 0 0 4 4))(JCALL 2 (E CONS)) 157 | NIL 158 | 159 | 160 | (LAP isUU SUBR) 161 | (HRRZ@ 2 1)(HLRZ@ 2 2)(CAIE 2 (QUOTE UU))(TDZA 1 1)(MOVEI 1 T)(POPJ P) 162 | NIL 163 | 164 | 165 | (LAP lhs SUBR) 166 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(MOVEI 2 (QUOTE (equiv inequiv)))(MOVE 1 0 P)(CALL 2 (E MEMQ)) 167 | (JUMPE 1 G0003)(HRRZ@ 1 -1 P)(HLRZ@ 1 1)(JRST 0 G0002) 168 | G0003 (MOVEI 1 (QUOTE lhs))(CALL 1 (E ERR)) 169 | G0006 170 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 171 | NIL 172 | 173 | 174 | (LAP rhs SUBR) 175 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(MOVEI 2 (QUOTE (equiv inequiv)))(MOVE 1 0 P)(CALL 2 (E MEMQ)) 176 | (JUMPE 1 G0003)(HRRZ@ 1 -1 P)(HRRZ@ 1 1)(JRST 0 G0002) 177 | G0003 (MOVEI 1 (QUOTE rhs))(CALL 1 (E ERR)) 178 | G0006 179 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 180 | NIL 181 | 182 | 183 | (LAP mkfreethm SUBR) 184 | (MOVEI 2 (QUOTE NIL))(JCALL 2 (E XCONS)) 185 | NIL 186 | 187 | 188 | (LAP eqtt SUBR) 189 | (MOVEI 2 (QUOTE MLVAL))(PUSH P 1)(MOVEI 1 (QUOTE tt))(CALL 2 (E GET))(EXCH 2 1)(POP P 1) 190 | (JCALL 2 (E mkequiv)) 191 | NIL 192 | 193 | 194 | (LAP eqff SUBR) 195 | (MOVEI 2 (QUOTE MLVAL))(PUSH P 1)(MOVEI 1 (QUOTE ff))(CALL 2 (E GET))(EXCH 2 1)(POP P 1) 196 | (JCALL 2 (E mkequiv)) 197 | NIL 198 | 199 | 200 | (LAP equu SUBR) 201 | (MOVEI 2 (QUOTE MLVAL))(PUSH P 1)(MOVEI 1 (QUOTE uutr))(CALL 2 (E GET))(EXCH 2 1) 202 | (POP P 1)(JCALL 2 (E mkequiv)) 203 | NIL 204 | 205 | -------------------------------------------------------------------------------- /src/lap/ol3.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP eqtype SUBR) 3 | (HRRZ@ 3 2)(HRRZ@ 3 3)(HRRZ@ 4 1)(HRRZ@ 4 4)(CAME 4 3)(TDZA 1 1)(MOVEI 1 T)(POPJ P) 4 | NIL 5 | 6 | 7 | (LAP genvar SUBR) 8 | (PUSH P 1)(CALL 0 (E GENSYM))(POP P 2)(JCALL 2 (E mkvar)) 9 | NIL 10 | 11 | 12 | (LAP equivpair SUBR) 13 | (HRRZ@ 1 1)(JCALL 1 (E destequiv)) 14 | NIL 15 | 16 | 17 | (LAP inequivpair SUBR) 18 | (HRRZ@ 1 1)(JCALL 1 (E destinequiv)) 19 | NIL 20 | 21 | 22 | (LAP tmfmvars SUBR) 23 | (HRRZ@ 1 1)(JCALL 1 (E ALLVARS)) 24 | NIL 25 | 26 | 27 | (LAP TYPESIN SUBR) 28 | (JSP 6 SPECBIND)(0 1 (SPECIAL %TYL))(EXCH 1 2)(CALL 1 (E %TYLIN1))(JRST 0 SPECSTR) 29 | NIL 30 | 31 | 32 | (LAP %TYLIN1 SUBR) 33 | (PUSH P 1)(MOVE 2 (SPECIAL %TYL))(CALL 2 (E MEMQ))(JUMPN 1 G0001)(HLRZ@ 2 0 P)(PUSH P 2) 34 | (MOVEI 2 (QUOTE (vartype consttype truth)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0006) 35 | (MOVEI 1 (QUOTE NIL))(JRST 0 G0005) 36 | G0006 (MOVEI 2 (QUOTE (var const)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0008)(HRRZ@ 1 -1 P) 37 | (HRRZ@ 1 1)(CALL 1 (E %TYLIN1))(JRST 0 G0005) 38 | G0008 (MOVEI 2 (QUOTE (comb abs)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0012)(HRRZ@ 1 -1 P) 39 | (HLRZ@ 1 1)(CALL 1 (E %TYLIN2))(JRST 0 G0005) 40 | G0012 (MOVEI 2 (QUOTE (quant conj imp equiv inequiv funtype prodtype sumtype)))(MOVE 1 0 P) 41 | (CALL 2 (E MEMQ))(JUMPE 1 G0016)(HRRZ@ 1 -1 P)(CALL 1 (E %TYLIN2))(JRST 0 G0005) 42 | G0016 (MOVEI 1 (QUOTE TYPESIN))(CALL 1 (E ERROR)) 43 | G0020 44 | G0005 (SUB P (C 0 0 1 1))(JUMPN 1 G0001)(TDZA 1 1) 45 | G0001 (MOVEI21 T)(SUB P (C 0 0 1 1))(POPJ P) 46 | NIL 47 | 48 | 49 | (LAP %TYLIN2 SUBR) 50 | (PUSH P 1)(HLRZ@ 1 1)(CALL 1 (E %TYLIN1))(JUMPN 1 G0001)(HRRZ@ 1 0 P)(CALL 1 (E %TYLIN1)) 51 | (JUMPN 1 G0001)(TDZA 1 1) 52 | G0001 (MOVEI 1 T)(SUB P (C 0 0 1 1))(POPJ P) 53 | NIL 54 | 55 | 56 | (LAP TYVARS SUBR) 57 | (JSP 6 SPECBIND)(0 0 (SPECIAL %TYVL))(CALL 1 (E TYVARS1))(MOVE 1 (SPECIAL %TYVL)) 58 | (CALL 1 (E REVERSE))(JRST 0 SPECSTR) 59 | NIL 60 | 61 | 62 | (LAP TYVARS1 SUBR) 63 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(MOVEI 2 (QUOTE (truth consttype)))(MOVE 1 0 P)(CALL 2 (E MEMQ)) 64 | (JUMPE 1 G0003)(MOVEI 1 (QUOTE NIL))(JRST 0 G0002) 65 | G0003 (MOVE 1 0 P)(CAIE 1 (QUOTE vartype))(JRST 0 G0005)(MOVE 2 (SPECIAL %TYVL))(MOVE 1 -1 P) 66 | (CALL 2 (E MEMQ))(JUMPN 1 G0006)(MOVE 2 (SPECIAL %TYVL))(MOVE 1 -1 P)(CALL 2 (E CONS)) 67 | (MOVEM 1 (SPECIAL %TYVL))(JUMPN 1 G0006)(TDZA 1 1) 68 | G0006 (MOVEI 1 T)(JRST 0 G0002) 69 | G0005 (MOVEI 2 (QUOTE (var const)))(CALL 2 (E MEMQ))(JUMPE 1 G0011)(HRRZ@ 1 -1 P)(HRRZ@ 1 1) 70 | (CALL 1 (E TYVARS1))(JRST 0 G0002) 71 | G0011 (MOVEI 2 (QUOTE (comb abs)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0015)(HRRZ@ 1 -1 P) 72 | (HLRZ@ 1 1)(CALL 1 (E TYVARS2))(JRST 0 G0002) 73 | G0015 (MOVEI 2 (QUOTE (quant conj imp equiv inequiv funtype prodtype sumtype)))(MOVE 1 0 P) 74 | (CALL 2 (E MEMQ))(JUMPE 1 G0019)(HRRZ@ 1 -1 P)(CALL 1 (E TYVARS2))(JRST 0 G0002) 75 | G0019 (MOVEI 1 (QUOTE TYVARS))(CALL 1 (E ERROR)) 76 | G0023 77 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 78 | NIL 79 | 80 | 81 | (LAP TYVARS2 SUBR) 82 | (PUSH P 1)(HLRZ@ 1 1)(CALL 1 (E TYVARS1))(HRRZ@ 1 0 P)(SUB P (C 0 0 1 1))(JCALL 1 (E TYVARS1)) 83 | NIL 84 | 85 | -------------------------------------------------------------------------------- /src/lap/opp.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP POP SUBR) 3 | (PUSH P 1)(MOVE 1 (SPECIAL PARSEDEPTH))(CALL 1 (E ADD1))(MOVEM 1 (SPECIAL PARSEDEPTH)) 4 | (CALL 0 (E GNT))(PUSH P (C 0 0 (QUOTE NIL)))(MOVE 1 (SPECIAL PTOKEN))(CALL 1 (E NUMBERP)) 5 | (JUMPN 1 G0008)(MOVE 2 (SPECIAL LANG1))(MOVE 1 (SPECIAL PTOKEN))(CALL 2 (E GET))(MOVEM 1 0 P) 6 | (JUMPE 1 G0008)(MOVE 1 0 P)(CALL 1 (E *EVAL))(JRST 0 G0007) 7 | G0008 (MOVE 1 (SPECIAL ATOMRTN))(CALL 1 (E *EVAL)) 8 | G0013 9 | G0007 (MOVEM 1 (SPECIAL ARG1)) 10 | G0001 (MOVE 1 (SPECIAL TOKEN))(CALL 1 (E NUMBERP))(JUMPE 1 G0018)(MOVEI 1 (QUOTE NIL))(JRST 0 G0017) 11 | G0018 (MOVE 2 (SPECIAL LANGLP))(MOVE 1 (SPECIAL TOKEN))(CALL 2 (E GET)) 12 | G0020 13 | G0017 (MOVEM 1 0 P)(JUMPN 1 G0025)(MOVE 2 (SPECIAL JUXTLEVEL))(MOVE 1 -1 P)(CALL 2 (E *LESS)) 14 | (JUMPN 1 G0025)(MOVE 1 (SPECIAL PARSEDEPTH))(CALL 1 (E SUB1))(MOVEM 1 (SPECIAL PARSEDEPTH)) 15 | (MOVE 1 (SPECIAL ARG1))(JRST 0 G0002) 16 | G0025 (MOVE 1 0 P)(JUMPN 1 G0030)(MOVE 1 (SPECIAL JUXTRTN))(CALL 1 (E *EVAL))(JRST 0 (G0001 -1)) 17 | (JRST 0 G0024) 18 | G0030 (MOVE 2 -1 P)(CALL 2 (E *GREAT))(JUMPN 1 G0033)(MOVE 1 (SPECIAL PARSEDEPTH))(CALL 1 (E SUB1)) 19 | (MOVEM 1 (SPECIAL PARSEDEPTH))(MOVE 1 (SPECIAL ARG1))(JRST 0 G0002) 20 | G0033 21 | G0037 22 | G0024 (MOVE 2 (SPECIAL DECLNCONSTRS))(HLRZ@ 1 (SPECIAL ARG1))(CALL 2 (E MEMQ))(JUMPE 1 G0041) 23 | (MOVEI 1 (QUOTE (NON TOP LEVEL DECLN MUST HAVE in CLAUSE)))(CALL 1 (E FAIL)) 24 | G0041 (MOVE 2 (SPECIAL LANG2))(MOVE 1 (SPECIAL TOKEN))(CALL 2 (E GET))(MOVEM 1 0 P)(JUMPN 1 G0048) 25 | (MOVEI 2 (QUOTE (IS UNDEFINED OPTR (SYSTEM ERROR))))(MOVE 1 (SPECIAL TOKEN))(CALL 2 (E CONS)) 26 | (CALL 1 (E FAIL)) 27 | G0048 (CALL 0 (E GNT))(MOVE 1 0 P)(CALL 1 (E *EVAL))(JRST 0 (G0001 -1)) 28 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 29 | NIL 30 | 31 | 32 | (LAP UNOP SUBR) 33 | (MOVE 3 (SPECIAL LANG1))(JCALL 3 (E PUTPROP)) 34 | NIL 35 | 36 | 37 | (LAP BNOP SUBR) 38 | (MOVE 3 (SPECIAL LANG2))(JCALL 3 (E PUTPROP)) 39 | NIL 40 | 41 | 42 | (LAP BINOP SUBR) 43 | (PUSH P 3)(MOVE 3 (SPECIAL LANG2))(EXCH 2 0 P)(PUSH P 1)(CALL 3 (E PUTPROP))(MOVE 3 (SPECIAL LANGLP)) 44 | (MOVE 2 -1 P)(POP P 1)(SUB P (C 0 0 1 1))(JCALL 3 (E PUTPROP)) 45 | NIL 46 | 47 | 48 | (LAP CHECK SUBR) 49 | (PUSH P 1)(PUSH P 2)(PUSH P 3)(CAME 1 (SPECIAL TOKEN))(JRST 0 G0002)(CALL 0 (E GNT)) 50 | (MOVE 1 -1 P)(JRST 0 G0001) 51 | G0002 (MOVE 1 0 P)(CALL 1 (E FAIL)) 52 | G0004 53 | G0001 (SUB P (C 0 0 3 3))(POPJ P) 54 | NIL 55 | 56 | 57 | (LAP FAIL SUBR) 58 | (CALL 1 (E PRINT))(MOVEI 1 (QUOTE SKIPPING:))(CALL 1 (E PRINT))(MOVE 1 (SPECIAL PTOKEN)) 59 | (CALL 1 (E PRINC))(MOVE 1 (SPECIAL SPACE))(CALL 1 (E PRINC))(MOVE 1 (SPECIAL TOKEN)) 60 | (CALL 1 (E PRINC))(MOVE 1 (SPECIAL SPACE))(CALL 1 (E PRINC)) 61 | G0001 (MOVE 1 (SPECIAL TOKEN))(CAME 1 (SPECIAL TMLSYM))(JRST 0 G0012)(CALL 0 (E INITLEAN)) 62 | (CALL 0 (E EQSETUP))(CALL 0 (E PERSETUP))(MOVEI 1 (QUOTE ***))(CALL 1 (E ERR)) 63 | G0012 (CALL 0 (E GNT))(CALL 1 (E PRINC))(MOVE 1 (SPECIAL SPACE))(JRST 0 (G0001 -1))(POPJ P) 64 | NIL 65 | 66 | -------------------------------------------------------------------------------- /src/lap/prompt.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP PROMPT SUBR) 3 | (PUSH P 1)(MOVEI 1 (QUOTE 6453))(CALL 1 (E EXAMINE))(MOVE 2 0 P)(PUSH P 1)(MOVEI 1 (QUOTE 6453)) 4 | (CALL 2 (E DEPOSIT))(POP P 1)(SUB P (C 0 0 1 1))(POPJ P) 5 | NIL 6 | 7 | -------------------------------------------------------------------------------- /src/lap/share.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP SHAREPAIR SUBR) 3 | (MOVE 4 2)(HRRZ@ 3 2)(HLRZ@ 2 2)(JCALL 4 (E SHARECONS')) 4 | NIL 5 | 6 | 7 | (LAP FORCESHARE SUBR) 8 | (PUSH P 2)(MOVEI 2 (QUOTE SHARECONS))(PUSH P 1)(CALL 2 (E GET))(EXCH 2 1)(HLRZ@ 1 -1 P) 9 | (CALL 2 (E ASSOC))(PUSH P 1)(JUMPE 1 G0005)(HRRZ@ 2 1)(HRRZ@ 1 -2 P)(CALL 2 (E ASSOC1)) 10 | (PUSH P 1)(JUMPE 1 G0010)(CAME 1 -3 P)(TDZA 1 1)(MOVEI 1 T)(JUMPN 1 G0011)(MOVEI 1 (QUOTE FORCESHARE)) 11 | (CALL 1 (E ERR)) 12 | G0011 (JRST 0 G0009) 13 | G0010 (MOVE 2 -3 P)(HRRZ@ 1 2)(CALL 2 (E CONS))(HRRZ@ 2 -1 P)(CALL 2 (E CONS))(HRRM@ 1 -1 P) 14 | (MOVE 1 -1 P) 15 | G0009 (SUB P (C 0 0 1 1))(JRST 0 G0004) 16 | G0005 (MOVE 2 -2 P)(HRRZ@ 1 2)(CALL 2 (E CONS))(CALL 1 (E NCONS))(HLRZ@ 2 -2 P)(CALL 2 (E XCONS)) 17 | (MOVEI 3 (QUOTE SHARECONS))(MOVE 2 1)(MOVE 1 -1 P)(CALL 3 (E ADDPROP)) 18 | G0004 (SUB P (C 0 0 3 3))(POPJ P) 19 | NIL 20 | 21 | 22 | (LAP SHARECONS SUBR) 23 | (PUSH P 2)(MOVE 2 3)(PUSH P 1)(MOVE 1 -1 P)(CALL 2 (E CONS))(MOVE 4 1)(MOVE 2 -1 P) 24 | (POP P 1)(SUB P (C 0 0 1 1))(JCALL 4 (E SHARECONS')) 25 | NIL 26 | 27 | 28 | (LAP SHARECONS' SUBR) 29 | (PUSH P 2)(MOVEI 2 (QUOTE SHARECONS))(PUSH P 1)(CALL 2 (E GET))(EXCH 2 1)(MOVE 1 -1 P) 30 | (PUSH P 3)(PUSH P 4)(CALL 2 (E ASSOC))(PUSH P 1)(PUSH P (C 0 0 (QUOTE NIL)))(JUMPE 1 G0007) 31 | (HRRZ@ 2 1)(MOVE 1 -3 P)(CALL 2 (E ASSOC1))(JUMPN 1 G0008)(MOVE 3 -2 P)(MOVE 2 -3 P) 32 | (MOVE 1 -5 P)(CALL 3 (E CONS'))(MOVEM 1 0 P)(JUMPE 1 G0011)(MOVE 2 -3 P)(CALL 2 (E XCONS)) 33 | (HRRZ@ 2 -1 P)(CALL 2 (E CONS))(HRRM@ 1 -1 P)(MOVE 1 0 P) 34 | G0011 35 | G0008 (JRST 0 G0001) 36 | G0007 (MOVE 3 -2 P)(MOVE 2 -3 P)(MOVE 1 -5 P)(CALL 3 (E CONS'))(MOVE 2 -3 P)(MOVEM 1 0 P) 37 | (CALL 2 (E XCONS))(CALL 1 (E NCONS))(MOVE 2 -5 P)(CALL 2 (E XCONS))(MOVEI 3 (QUOTE SHARECONS)) 38 | (MOVE 2 1)(MOVE 1 -4 P)(CALL 3 (E ADDPROP))(MOVE 1 0 P) 39 | G0001 (SUB P (C 0 0 6 6))(POPJ P) 40 | NIL 41 | 42 | 43 | (LAP CONS' SUBR) 44 | (PUSH P 1)(PUSH P 2)(PUSH P 3)(HLRZ@ 1 3)(CAME 1 -2 P)(JRST 0 G0002)(HRRZ@ 1 3)(CAME 2 1) 45 | (JRST 0 G0002)(MOVE 1 0 P)(JRST 0 G0001) 46 | G0002 (MOVE 2 -1 P)(MOVE 1 -2 P)(CALL 2 (E CONS)) 47 | G0006 48 | G0001 (SUB P (C 0 0 3 3))(POPJ P) 49 | NIL 50 | 51 | 52 | (LAP CONDSHAREOB SUBR) 53 | (PUSH P 1)(PUSH P 2)(MOVEI 2 (QUOTE SHARE))(CALL 2 (E GET))(JUMPE 1 G0002)(MOVE 2 0 P) 54 | (MOVE 1 -1 P)(CALL 2 (E SHAREOB))(JRST 0 G0001) 55 | G0002 (MOVE 1 0 P) 56 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 57 | NIL 58 | 59 | 60 | (LAP SHAREOB SUBR) 61 | (PUSH P 1)(PUSH P 2)(EXCH 1 2)(CALL 1 (E DONTSHAREPRED))(JUMPE 1 G0002)(MOVE 1 0 P) 62 | (JRST 0 G0001) 63 | G0002 (MOVE 1 0 P)(CALL 1 (E SHAREPRED))(JUMPE 1 G0004)(MOVE 2 0 P)(MOVE 1 -1 P)(CALL 2 (E SHAREOB1)) 64 | (JRST 0 G0001) 65 | G0004 (HLRZ@ 2 0 P)(MOVE 1 -1 P)(CALL 2 (E SHAREOB))(HRRZ@ 2 0 P)(PUSH P 1)(MOVE 1 -2 P)(CALL 2 (E SHAREOB)) 66 | (MOVE 3 -1 P)(MOVE 2 1)(POP P 1)(CALL 3 (E CONS')) 67 | G0007 68 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 69 | NIL 70 | 71 | 72 | (LAP SHAREOB1 SUBR) 73 | (PUSH P 1)(PUSH P 2)(EXCH 1 2)(CALL 1 (E DONTSHAREPRED))(JUMPE 1 G0002)(MOVE 1 0 P) 74 | (JRST 0 G0001) 75 | G0002 (HLRZ@ 2 0 P)(MOVE 1 -1 P)(CALL 2 (E SHAREOB1))(HRRZ@ 2 0 P)(PUSH P 1)(MOVE 1 -2 P) 76 | (CALL 2 (E SHAREOB1))(MOVE 4 -1 P)(MOVE 3 1)(POP P 2)(MOVE 1 -1 P)(CALL 4 (E SHARECONS')) 77 | G0004 78 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 79 | NIL 80 | 81 | 82 | (LAP SHAREPRED SUBR) 83 | (MOVE 3 (SPECIAL SHAREDEPTH))(MOVEI 2 (QUOTE 0))(JCALL 3 (E DEPTHCHK)) 84 | NIL 85 | 86 | 87 | (LAP DONTSHAREPRED SUBR) 88 | (PUSH P 1)(CALL 1 (E ATOM))(JUMPN 1 G0001)(HLRZ@ 1 0 P)(CAIN 1 (QUOTE QUOTE))(JRST 0 G0001) 89 | (TDZA 1 1) 90 | G0001 (MOVEI 1 T)(SUB P (C 0 0 1 1))(POPJ P) 91 | NIL 92 | 93 | 94 | (LAP SHARETRIPLE SUBR) 95 | (PUSH P 2)(MOVEI 2 (QUOTE SHARETRIPLE))(PUSH P 1)(CALL 2 (E GET))(EXCH 2 1)(MOVE 1 -1 P) 96 | (PUSH P 3)(CALL 2 (E ASSOC))(PUSH P 1)(PUSH P (C 0 0 (QUOTE NIL)))(JUMPE 1 G0007) 97 | (HRRZ@ 2 1)(MOVE 1 -2 P)(CALL 2 (E ASSOC1))(JUMPN 1 G0008)(MOVE 3 -2 P)(MOVE 2 -4 P) 98 | (MOVE 1 -3 P)(CALL 3 (E TRIPLE))(MOVEM 1 0 P)(JUMPE 1 G0011)(MOVE 2 -2 P)(CALL 2 (E XCONS)) 99 | (HRRZ@ 2 -1 P)(CALL 2 (E CONS))(HRRM@ 1 -1 P)(MOVE 1 0 P) 100 | G0011 101 | G0008 (JRST 0 G0001) 102 | G0007 (MOVE 3 -2 P)(MOVE 2 -4 P)(MOVE 1 -3 P)(CALL 3 (E TRIPLE))(MOVE 2 -2 P)(MOVEM 1 0 P) 103 | (CALL 2 (E XCONS))(CALL 1 (E NCONS))(MOVE 2 -4 P)(CALL 2 (E XCONS))(MOVEI 3 (QUOTE SHARETRIPLE)) 104 | (MOVE 2 1)(MOVE 1 -3 P)(CALL 3 (E ADDPROP))(MOVE 1 0 P) 105 | G0001 (SUB P (C 0 0 5 5))(POPJ P) 106 | NIL 107 | 108 | 109 | (LAP DEPTHCHK SUBR) 110 | (PUSH P 1)(PUSH P 2)(PUSH P 3)(EXCH 2 3)(EXCH 1 3)(CALL 2 (E *LESS))(JUMPE 1 G0001) 111 | (MOVE 1 -2 P)(CALL 1 (E ATOM))(JUMPE 1 G0003)(MOVE 1 -1 P)(JRST 0 G0001) 112 | G0003 (MOVE 3 0 P)(MOVE 2 -1 P)(HLRZ@ 1 -2 P)(CALL 3 (E DEPTHCHK))(PUSH P 1)(JUMPE 1 G0008) 113 | (HRRZ@ 1 -3 P)(PUSH P 1)(MOVE 1 -1 P)(CALL 1 (E ADD1))(MOVE 3 -2 P)(MOVE 2 1)(POP P 1) 114 | (CALL 3 (E DEPTHCHK)) 115 | G0008 (SUB P (C 0 0 1 1)) 116 | G0001 (SUB P (C 0 0 3 3))(POPJ P) 117 | NIL 118 | 119 | -------------------------------------------------------------------------------- /src/lap/trace.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP CHECKTRACEABLE SUBR) 3 | (PUSH P 1)(HRRZ@ 1 1)(CALL 1 (E ATOM))(JUMPE 1 G0002)(HRRZ@ 1 0 P)(CALL 1 (E TRACERR)) 4 | (JRST 0 G0001) 5 | G0002 (MOVE 1 0 P) 6 | G0007 7 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 8 | NIL 9 | 10 | 11 | (LAP TRACERR SUBR) 12 | (PUSH P 1)(MOVEI 1 (QUOTE "CLOSURE NOT TRACEABLE : "))(CALL 1 (E PRINC))(POP P 1) 13 | (CALL 1 (E PRINC))(MOVE 1 (SPECIAL CR))(CALL 1 (E PRINC))(MOVE 1 (SPECIAL LF))(CALL 1 (E PRINC)) 14 | (MOVEI 1 (QUOTE TRACE))(CALL 1 (E ERR))(MOVEI 1 (QUOTE NIL))(POPJ P) 15 | NIL 16 | 17 | 18 | (LAP TRACE#1 SUBR) 19 | (JSP 6 SPECBIND)(0 1 (SPECIAL %E))(HLRZ@ 1 1)(CALL 1 (E CHECKTRACEABLE))(HRRZ@ 2 1) 20 | (PUSH P 1)(HLRZ@ 1 1)(CALL 2 (E CONS))(MOVE 2 1)(PUSH P 1)(HRRZ@ 1 (SPECIAL %E))(HLRZ@ 1 1) 21 | (CALL 2 (E AP))(HLRZ@ 2 1)(HLRZ@ 2 2)(HRLM@ 2 -1 P)(HLRZ@ 3 1)(HRRZ@ 3 3)(HRRM@ 3 -1 P) 22 | (POP P 2)(EXCH 1 0 P)(CALL 2 (E CONS))(MOVE 2 (SPECIAL TRACELIST))(CALL 2 (E CONS)) 23 | (MOVEM 1 (SPECIAL TRACELIST))(PUSH P (C 0 0 (QUOTE NIL)))(PUSH P (C 0 0 (QUOTE NIL))) 24 | (HRRZ@ 1 -2 P)(SUB P (C 0 0 3 3))(JRST 0 SPECSTR) 25 | NIL 26 | 27 | 28 | (LAP TRACE SUBR) 29 | (CALL 1 (E NCONS))(MOVEI 2 (QUOTE TRACE#1))(JCALL 2 (E XCONS)) 30 | NIL 31 | 32 | 33 | (LAP UNTRACE SUBR) 34 | (MOVE 2 (SPECIAL TRACELIST))(PUSH P 1)(CALL 2 (E ASSOC))(PUSH P 1)(JUMPE 1 G0002) 35 | (MOVE 2 (SPECIAL TRACELIST))(MOVE 1 0 P)(CALL 2 (E OUTQ))(MOVEM 1 (SPECIAL TRACELIST)) 36 | (HRRZ@ 2 0 P)(HLRZ@ 2 2)(HRLM@ 2 -1 P)(HRRZ@ 3 0 P)(HRRZ@ 3 3)(HRRM@ 3 -1 P)(MOVEI 1 (QUOTE T)) 37 | (JRST 0 G0001) 38 | G0002 (MOVEI 1 (QUOTE NIL)) 39 | G0001 (SUB P (C 0 0 2 2))(POPJ P) 40 | NIL 41 | 42 | -------------------------------------------------------------------------------- /src/lap/typeol.lap: -------------------------------------------------------------------------------- 1 | 2 | (LAP UNIFY SUBR) 3 | (PUSH P 2)(CALL 1 (E TRUNC))(EXCH 1 0 P)(CALL 1 (E TRUNC))(MOVE 2 1)(POP P 1)(JCALL 2 (E UNIFYB)) 4 | NIL 5 | 6 | 7 | (LAP UNIFYB SUBR) 8 | (PUSH P 1)(PUSH P 2)(CALL 2 (E EQUAL))(JUMPN 1 G0002)(HLRZ@ 1 -1 P)(CAIE 1 (QUOTE link)) 9 | (JRST 0 G0004)(MOVE 2 0 P)(MOVE 1 -1 P)(CALL 2 (E OCCB))(JUMPE 1 G0007)(MOVEI 1 (QUOTE NIL)) 10 | (JRST 0 G0006) 11 | G0007 (MOVE 1 0 P)(HRRM@ 1 -1 P)(MOVE 1 -1 P) 12 | G0006 (JRST 0 G0002) 13 | G0004 (HLRZ@ 1 0 P)(CAIE 1 (QUOTE link))(JRST 0 G0010)(MOVE 2 -1 P)(MOVE 1 0 P)(CALL 2 (E OCCB)) 14 | (JUMPE 1 G0013)(MOVEI 1 (QUOTE NIL))(JRST 0 G0012) 15 | G0013 (MOVE 1 -1 P)(HRRM@ 1 0 P)(MOVE 1 0 P) 16 | G0012 (JRST 0 G0002) 17 | G0010 (HLRZ@ 2 -1 P)(CAME 2 1)(JRST 0 G0016)(PUSH P 2)(MOVEI 2 (QUOTE (consttype vartype))) 18 | (MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0021)(HRRZ@ 1 -1 P)(HRRZ@ 2 -2 P)(CAME 2 1) 19 | (TDZA 1 1)(MOVEI 1 T)(JRST 0 G0020) 20 | G0021 (HRRZ@ 2 -1 P)(HLRZ@ 2 2)(HRRZ@ 1 -2 P)(HLRZ@ 1 1)(CALL 2 (E UNIFY))(JUMPE 1 G0029) 21 | (HRRZ@ 2 -1 P)(HRRZ@ 2 2)(HRRZ@ 1 -2 P)(HRRZ@ 1 1)(CALL 2 (E UNIFY))(JUMPN 1 G0028) 22 | G0029 (TDZA 1 1) 23 | G0028 (MOVEI 1 T) 24 | G0026 25 | G0020 (SUB P (C 0 0 1 1))(JRST 0 G0002) 26 | G0016 (CAIE 2 (QUOTE consttype))(JRST 0 G0038)(MOVEI 2 (QUOTE EQTYPE))(HRRZ@ 1 -1 P)(CALL 2 (E GET)) 27 | (PUSH P 1)(JUMPE 1 G0043)(MOVE 2 -1 P)(CALL 2 (E UNIFYB))(JUMPN 1 G0042) 28 | G0043 (TDZA 1 1) 29 | G0042 (MOVEI 1 T)(SUB P (C 0 0 1 1))(JRST 0 G0002) 30 | G0038 (CAIE 1 (QUOTE consttype))(JRST 0 G0046)(MOVEI 2 (QUOTE EQTYPE))(HRRZ@ 1 0 P)(CALL 2 (E GET)) 31 | (PUSH P 1)(JUMPE 1 G0051)(EXCH 2 1)(MOVE 1 -2 P)(CALL 2 (E UNIFYB))(JUMPN 1 G0050) 32 | G0051 (TDZA 1 1) 33 | G0050 (MOVEI 1 T)(SUB P (C 0 0 1 1))(JRST 0 G0002) 34 | G0046 (MOVEI 1 (QUOTE NIL)) 35 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 36 | NIL 37 | 38 | 39 | (LAP TRUNC SUBR) 40 | (PUSH P 1)(HLRZ@ 1 1)(CAIE 1 (QUOTE link))(JRST 0 G0002)(HRRZ@ 1 0 P)(CALL 1 (E ATOM)) 41 | (JUMPN 1 G0002)(HRRZ@ 1 0 P)(CALL 1 (E TRUNC))(JRST 0 G0001) 42 | G0002 (MOVE 1 0 P) 43 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 44 | NIL 45 | 46 | 47 | (LAP OCC SUBR) 48 | (EXCH 1 2)(PUSH P 2)(CALL 1 (E TRUNC))(MOVE 2 1)(POP P 1)(JCALL 2 (E OCCB)) 49 | NIL 50 | 51 | 52 | (LAP OCCB SUBR) 53 | (PUSH P 1)(PUSH P 2)(CAMN 1 2)(JRST 0 G0001)(HLRZ@ 3 2)(PUSH P 3)(MOVEI 2 (QUOTE (link consttype vartype~ 54 | )))(EXCH 1 3)(CALL 2 (E MEMQ))(JUMPE 1 G0005)(MOVEI 1 (QUOTE NIL))(JRST 0 G0004) 55 | G0005 (HRRZ@ 2 -1 P)(HLRZ@ 2 2)(MOVE 1 -2 P)(CALL 2 (E OCC))(JUMPN 1 G0009)(HRRZ@ 2 -1 P) 56 | (HRRZ@ 2 2)(MOVE 1 -2 P)(CALL 2 (E OCC))(JUMPN 1 G0009)(TDZA 1 1) 57 | G0009 (MOVEI 1 T) 58 | G0007 59 | G0004 (SUB P (C 0 0 1 1))(JUMPN 1 G0001)(TDZA 1 1) 60 | G0001 (MOVEI 1 T)(SUB P (C 0 0 2 2))(POPJ P) 61 | NIL 62 | 63 | 64 | (LAP QUOTCH#1 SUBR) 65 | (HLRZ@ 1 (SPECIAL %OB))(CALL 1 (E *EVAL))(JCALL 1 (E QTCH)) 66 | NIL 67 | 68 | 69 | (LAP QUOTCH#2 SUBR) 70 | (PUSH P 1)(MOVEI 2 (QUOTE STICKYTYPE))(HLRZ@ 1 1)(CALL 2 (E GET))(JUMPN 1 G0004)(HLRZ@ 1 0 P) 71 | (PUSH P 1)(HRRZ@ 1 -1 P)(CALL 1 (E CANONTY))(MOVEI 3 (QUOTE STICKYTYPE))(MOVE 2 1) 72 | (POP P 1)(CALL 3 (E PUTPROP))(JUMPN 1 G0004)(TDZA 1 1) 73 | G0004 (MOVEI 1 T)(SUB P (C 0 0 1 1))(POPJ P) 74 | NIL 75 | 76 | 77 | (LAP QUOTCH FSUBR) 78 | (JSP 6 SPECBIND)(0 1 (SPECIAL %OB))(0 0 (SPECIAL %BVL))(0 0 (SPECIAL %VTYL))(MOVEI 1 (QUOTE ((QUOTCH#1))~ 79 | ))(CALL 17 (E ERRSET))(CALL 1 (E QTRAP))(MOVE 2 (SPECIAL %VTYL))(PUSH P 1)(MOVEI 1 (QUOTE QUOTCH#2)) 80 | (CALL 2 (E MAPC))(MOVE 1 0 P)(SUB P (C 0 0 1 1))(JRST 0 SPECSTR) 81 | NIL 82 | 83 | 84 | (LAP TYQUOTCH#1 SUBR) 85 | (HLRZ@ 1 (SPECIAL %OB))(JCALL 1 (E *EVAL)) 86 | NIL 87 | 88 | 89 | (LAP TYQUOTCH FSUBR) 90 | (JSP 6 SPECBIND)(0 1 (SPECIAL %OB))(MOVEI 1 (QUOTE ((TYQUOTCH#1))))(CALL 17 (E ERRSET)) 91 | (CALL 1 (E QTRAP))(JRST 0 SPECSTR) 92 | NIL 93 | 94 | 95 | (LAP QTRAP SUBR) 96 | (PUSH P 1)(CALL 1 (E ATOM))(JUMPE 1 G0002)(MOVEI 2 (QUOTE / IN/ QUOTATION))(MOVE 1 0 P) 97 | (CALL 2 (E JUXT))(CALL 1 (E ERR))(JRST 0 G0001) 98 | G0002 (HLRZ@ 1 0 P) 99 | G0001 (SUB P (C 0 0 1 1))(POPJ P) 100 | NIL 101 | 102 | 103 | (LAP QTCH SUBR) 104 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(CAIE 2 (QUOTE antiquot))(JRST 0 G0003)(HRRZ@ 1 1) 105 | (JRST 0 G0002) 106 | G0003 (MOVEI 2 (QUOTE (quant imp conj equiv inequiv)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0005) 107 | (HLRZ@ 1 -1 P)(PUSH P 1)(HRRZ@ 1 -2 P)(HLRZ@ 1 1)(CALL 1 (E QTCH))(PUSH P 1)(HRRZ@ 1 -3 P) 108 | (HRRZ@ 1 1)(CALL 1 (E QTCH))(MOVE 3 1)(POP P 2)(POP P 1)(CALL 3 (E TRIPLE))(JRST 0 G0002) 109 | G0005 (MOVE 1 0 P)(CAIE 1 (QUOTE truth))(JRST 0 G0013)(MOVE 1 -1 P)(JRST 0 G0002) 110 | G0013 (MOVEI 2 (QUOTE (abs comb)))(CALL 2 (E MEMQ))(JUMPE 1 G0014)(HLRZ@ 1 -1 P)(PUSH P 1) 111 | (HRRZ@ 1 -2 P)(CALL 1 (E CAAR))(CALL 1 (E QTCH))(PUSH P 1)(HRRZ@ 1 -3 P)(CALL 1 (E CDAR)) 112 | (CALL 1 (E QTCH))(POP P 2)(CALL 2 (E XCONS))(PUSH P 1)(HRRZ@ 1 -3 P)(HRRZ@ 1 1)(CALL 1 (E CANONTY)) 113 | (MOVE 3 1)(POP P 2)(POP P 1)(CALL 3 (E TRIPLE))(JRST 0 G0002) 114 | G0014 (MOVE 1 0 P)(CAIE 1 (QUOTE var))(JRST 0 G0025)(HRRZ@ 1 -1 P)(HLRZ@ 1 1)(PUSH P 1)(HRRZ@ 1 -2 P) 115 | (HRRZ@ 1 1)(CALL 1 (E CANONTY))(MOVE 2 1)(POP P 1)(CALL 2 (E mkrealvar))(JRST 0 G0002) 116 | G0025 (CAIE 1 (QUOTE const))(JRST 0 G0030)(HRRZ@ 1 -1 P)(HLRZ@ 1 1)(PUSH P 1)(HRRZ@ 1 -2 P) 117 | (HRRZ@ 1 1)(CALL 1 (E CANONTY))(MOVE 2 1)(POP P 1)(CALL 2 (E mkconst))(JRST 0 G0002) 118 | G0030 (MOVEI 1 (QUOTE JUNKOB))(CALL 1 (E ERR)) 119 | G0035 120 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 121 | NIL 122 | 123 | 124 | (LAP CANONTY SUBR) 125 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(CAIE 2 (QUOTE link))(JRST 0 G0003)(HRRZ@ 1 1)(CALL 1 (E ATOM)) 126 | (JUMPE 1 G0005)(MOVEI 1 (QUOTE TYPES/ INDETERMINATE))(CALL 1 (E ERR))(JRST 0 G0004) 127 | G0005 (HRRZ@ 1 -1 P)(CALL 1 (E CANONTY)) 128 | G0004 (JRST 0 G0002) 129 | G0003 (MOVEI 2 (QUOTE (consttype vartype)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0012)(MOVE 1 -1 P) 130 | (JRST 0 G0002) 131 | G0012 (MOVEI 2 (QUOTE (sumtype prodtype funtype)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0014) 132 | (HLRZ@ 1 -1 P)(PUSH P 1)(HRRZ@ 1 -2 P)(HLRZ@ 1 1)(CALL 1 (E CANONTY))(PUSH P 1)(HRRZ@ 1 -3 P) 133 | (HRRZ@ 1 1)(CALL 1 (E CANONTY))(MOVE 3 1)(POP P 2)(POP P 1)(CALL 3 (E mktype))(JRST 0 G0002) 134 | G0014 (MOVEI 1 (QUOTE JUNKTYPE))(CALL 1 (E ERR)) 135 | G0022 136 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 137 | NIL 138 | 139 | 140 | (LAP OMUTANT SUBR) 141 | (JSP 6 SPECBIND)(0 0 (SPECIAL %L))(PUSH P 1)(CALL 1 (E OMUTANT1))(SUB P (C 0 0 1 1)) 142 | (JRST 0 SPECSTR) 143 | NIL 144 | 145 | 146 | (LAP OMUTANT1 SUBR) 147 | (HLRZ@ 2 1)(PUSH P 1)(PUSH P 2)(CAIE 2 (QUOTE vartype))(JRST 0 G0003)(MOVE 2 (SPECIAL %L)) 148 | (CALL 2 (E ASSOC1))(JUMPN 1 G0004)(CALL 0 (E GENLINK))(MOVE 2 -1 P)(CALL 2 (E XCONS)) 149 | (MOVE 2 (SPECIAL %L))(CALL 2 (E CONS))(MOVEM 1 (SPECIAL %L))(CALL 1 (E CDAR)) 150 | G0004 (JRST 0 G0002) 151 | G0003 (MOVEI 2 (QUOTE (vartype consttype)))(MOVE 1 0 P)(CALL 2 (E MEMQ))(JUMPE 1 G0011)(MOVE 1 -1 P) 152 | (JRST 0 G0002) 153 | G0011 (HLRZ@ 1 -1 P)(PUSH P 1)(HRRZ@ 1 -2 P)(HLRZ@ 1 1)(CALL 1 (E OMUTANT1))(PUSH P 1)(HRRZ@ 1 -3 P) 154 | (HRRZ@ 1 1)(CALL 1 (E OMUTANT1))(MOVE 3 1)(POP P 2)(POP P 1)(CALL 3 (E TRIPLE)) 155 | G0013 156 | G0002 (SUB P (C 0 0 2 2))(POPJ P) 157 | NIL 158 | 159 | -------------------------------------------------------------------------------- /src/lapld: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 (DE ERROR (X) (PROG2 (PRINX X CR LF) (SYSTEMERROR))) 5 | C00005 ENDMK 6 | C⊗; 7 | (DE ERROR (X) (PROG2 (PRINX X CR LF) (SYSTEMERROR))) 8 | (DE SPRINT (X Y) (PP X Y)) 9 | (SETQ %MLPRINDEPTH 3) 10 | (SETQ SHAREDEPTH 10) 11 | (PUTPROP @ML T @SHARE) 12 | 13 | (DE PROMPT(N) NIL) 14 | 15 | 16 | (DIN 17 | (LCF FWH) (CLRBFI.LAP) 18 | (LCF FWH) (GP.LAP) 19 | (LCF FWH) SYMBS 20 | (LCF FWH) PTBLE 21 | (LCF FWH) (LEAN.LAP) 22 | (LCF FWH) LEANPROP 23 | (LCF FWH) (OPP.LAP) 24 | (LCF FWH) (LCFO.LAP) 25 | (LCF FWH) (LCFO.LSP) 26 | (LCF FWH) (LCFM.LAP) 27 | (LCF FWH) (LCFM.LSP) 28 | (LCF FWH) (MLPRIN.LAP) 29 | (LCF FWH) (SHARE.LAP) 30 | (LCF FWH) (TYPEOL.LAP) 31 | (LCF FWH) (TYPEML.LAP) 32 | (LCF FWH) (TYPEML.LSP) 33 | (LCF FWH) (TRAN.LAP) 34 | (LCF FWH) (TRAN.LSP) 35 | (LCF FWH) (DML.LAP) 36 | (LCF FWH) (DML.LSP) 37 | (LCF FWH) (WRITML.LAP) 38 | (LCF FWH) (WRITML.LSP) 39 | (LCF FWH) (TML.LAP) 40 | (LCF FWH) (TML.LSP) 41 | (LCF FWH) (THYFNS.LAP) 42 | (LCF FWH) (THYFNS.LSP) 43 | (LCF FWH) (THYFNS.ML) 44 | (LCF FWH) (GEN.ML) 45 | (LCF FWH) (LIS.LAP) 46 | (LCF FWH) (LIS.LSP) 47 | (LCF FWH) (LIS.ML) 48 | (LCF FWH) (OL0.LAP) 49 | (LCF FWH) (OL0.LSP) 50 | (LCF FWH) (PPLAMB.LSP) 51 | (LCF FWH) (PPLAMB.ML) 52 | (LCF FWH) (OL1.LAP) 53 | (LCF FWH) (OL1.LSP) 54 | (LCF FWH) (OL2.LAP) 55 | (LCF FWH) (OL2.LSP) 56 | (LCF FWH) (OL2.ML) 57 | (LCF FWH) (OL3.LAP) 58 | (LCF FWH) (OL3.LSP) 59 | (LCF FWH) (OL3.ML) 60 | (LCF FWH) (PCRUL.ML) 61 | (LCF FWH) (RUL.ML) 62 | (LCF FWH) (SIMPL.LAP) 63 | (LCF FWH) (SIMPL.LSP) 64 | (LCF FWH) (SIMPL.ML) 65 | (LCF FWH) (DRUL.ML) 66 | (LCF FWH) (TAC.ML) 67 | (LCF FWH) (TCL.ML) 68 | (LCF FWH) (TRACE.LAP) 69 | (LCF FWH) (TRACE.LSP) 70 | (LCF FWH) TMLINI) 71 | ) 72 | (REMPROP @ML @SHARE) 73 | (REMPROP @ML @SHARECONS) 74 | -------------------------------------------------------------------------------- /src/lapld.e: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 5 | C00004 ENDMK 6 | C⊗; 7 | 8 | 9 | (DE ERROR (X) (PROG2 (PRINX X CR LF) (SYSTEMERROR))) 10 | (DE SPRINT (X Y) (PP X Y)) 11 | (SETQ %MLPRINDEPTH 3) 12 | (SETQ SHAREDEPTH 10) 13 | (PUTPROP @ML T @SHARE) 14 | 15 | (DE PROMPT(N) NIL) 16 | 17 | 18 | (DIN 19 | (CLRBFI.LAP) 20 | (GP.LAP) 21 | SYMBS 22 | PTBLE 23 | (LEAN.LAP) 24 | LEANPROP 25 | (OPP.LAP) 26 | (LCFO.LAP) 27 | (LCFO.LSP) 28 | (LCFM.LAP) 29 | (LCFM.LSP) 30 | (MLPRIN.LAP) 31 | (SHARE.LAP) 32 | (TYPEOL.LAP) 33 | (TYPEML.LAP) 34 | (TYPEML.LSP) 35 | (TRAN.LAP) 36 | (TRAN.LSP) 37 | (DML.LAP) 38 | (DML.LSP) 39 | (WRITML.LAP) 40 | (WRITML.LSP) 41 | (TML.LAP) 42 | (TML.LSP) 43 | (THYFNS.LAP) 44 | (THYFNS.LSP) 45 | (THYFNS.ML) 46 | (GEN.ML) 47 | (LIS.LAP) 48 | (LIS.LSP) 49 | (LIS.ML) 50 | (OL0.LAP) 51 | (OL0.LSP) 52 | (PPLAMB.LSP) 53 | (PPLAMB.ML) 54 | (OL1.LAP) 55 | (OL1.LSP) 56 | (OL2.LAP) 57 | (OL2.LSP) 58 | (OL2.ML) 59 | (OL3.LAP) 60 | (OL3.LSP) 61 | (OL3.ML) 62 | (PCRUL.ML) 63 | (RUL.ML) 64 | (SIMPL.LAP) 65 | (SIMPL.LSP) 66 | (SIMPL.ML) 67 | (DRUL.ML) 68 | (TAC.ML) 69 | (TCL.ML) 70 | (TRACE.LAP) 71 | (TRACE.LSP) 72 | TMLINI) 73 | ) 74 | 75 | (REMPROP @ML @SHARE) 76 | (REMPROP @ML @SHARECONS) 77 | 78 | -------------------------------------------------------------------------------- /src/lapld.mic: -------------------------------------------------------------------------------- 1 | .R LISP 72 2 | =Y 3 | =2000 4 | =34000 5 | =2000 6 | =2000 7 | = 8 | =Y 9 | = 10 | = 11 | = 12 | = 13 | =Y 14 | = 15 | 16 | *(INC(INPUT DSK: (IOX.LAP) (IOX.LSP))) 17 | *(SETQ PRFLAG NIL) 18 | *(DIN LAPLD) 19 | *(SETQ PRFLAG T) 20 | 21 | .SAVE LAPLCF 22 | -------------------------------------------------------------------------------- /src/lcf.dir: -------------------------------------------------------------------------------- 1 | 23-Jan-79 1046 DSK:*.*[LCF,FWH] /PPN/NAME/EXT 2 | 3 | File Ext Pro PPN Size Date Time Writer Using Reference Dumped 4 | ******* Normal Page: 42 files (56029 words) ******* 5 | DEF LSN 000 LCFFWH 692 26-Jan-78 1317 LCFFWH TENDMP 6-Dec-78 7-Feb-78P 2 6 | DEF NVO 000 LCFFWH 470 26-Jan-78 1316 LCFFWH TENDMP 8-Feb-78 7-Feb-78P 2 7 | DLIST DFT 000 LCFFWH 256 24-Feb-78 1003 1HAY E 24-Feb-78 13-Mar-78P 2 8 | DLIST FCT 000 LCFFWH 1020 26-Jan-78 1317 LCFFWH TENDMP 24-Feb-78 7-Feb-78P 2 9 | EQUT FCT 000 LCFFWH 22 26-Jan-78 1317 LCFFWH TENDMP 24-Feb-78 7-Feb-78P 2 10 | EQUT THY 000 LCFFWH 256 24-Feb-78 1009 1HAY E 15-May-78 13-Mar-78P 2 11 | FILES EL 000 LCFFWH 10624 23-Jan-79 1028 PMFWH E 23-Jan-79 12 | FILES LAP 000 LCFFWH 768 23-Jan-79 1027 PMFWH E 23-Jan-79 13 | FILES LSP 000 LCFFWH 6016 23-Jan-79 1031 PMFWH E 23-Jan-79 14 | FILES ML 000 LCFFWH 2944 26-Jun-78 2129 DMPSYS DART 23-Jan-79 10-Dec-78P 2 15 | FIXT FCT 000 LCFFWH 96 26-Jan-78 1317 LCFFWH TENDMP 24-Feb-78 7-Feb-78P 2 16 | FIXT THY 000 LCFFWH 6 26-Jan-78 1317 LCFFWH TENDMP 23-Jun-78 7-Feb-78P 2 17 | IOX 000 LCFFWH 1024 23-Jan-79 0941 PMFWH E 23-Jan-79 18 | IOX LSP 000 LCFFWH 256 23-Jan-79 1031 PMFWH E 23-Jan-79 19 | LAP DIR 000 LCFFWH 512 6-Mar-78 1151 PFWH E 6-Mar-78 22-Mar-78P 2 20 | LAPLD 000 LCFFWH 512 23-Jan-79 0940 PMFWH E 23-Jan-79 21 | LAPLD E 000 LCFFWH 384 26-Jan-78 1451 LFWH E 23-Jan-79 7-Feb-78P 2 22 | LAPLD FLS 000 LCFFWH 2304 23-Jan-79 1013 PMFWH E 23-Jan-79 23 | LAPLD MIC 000 LCFFWH 128 23-Jan-79 0939 PMFWH E 23-Jan-79 24 | LCF DIR 000 LCFFWH 697 23-Jan-79 1038 PMFWH COPY 23-Jan-79 25 | LCFM 000 LCFFWH 2968 26-Jan-78 1247 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 26 | LCFO 000 LCFFWH 991 26-Jan-78 1247 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 27 | LESYN1 000 LCFFWH 132 26-Jan-78 1318 LCFFWH TENDMP 8-Feb-78 7-Feb-78P 2 28 | LESYN1 DFT 000 LCFFWH 167 26-Jan-78 1611 LFWH LCF 8-Feb-78 7-Feb-78P 2 29 | LESYN1 FCT 000 LCFFWH 63 26-Jan-78 1611 LFWH LCF 24-Feb-78 7-Feb-78P 2 30 | LPSYN A 000 LCFFWH 358 26-Jan-78 1317 LCFFWH TENDMP 26-Jun-78 7-Feb-78P 2 31 | LPSYN IND 000 LCFFWH 334 26-Jan-78 1317 LCFFWH TENDMP 8-Feb-78 7-Feb-78P 2 32 | LSPLD 000 LCFFWH 640 23-Jan-79 1024 PMFWH E 23-Jan-79 33 | LSPLD MIC 000 LCFFWH 32 26-Jan-78 1314 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 34 | LSTACS NEW 000 LCFFWH 1590 26-Jan-78 1317 LCFFWH TENDMP 8-Feb-78 7-Feb-78P 2 35 | OL0 000 LCFFWH 1363 26-Jan-78 1256 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 36 | OL2 000 LCFFWH 1648 26-Jan-78 1256 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 37 | PPSAV TMP 000 LCFFWH 627 23-Jan-79 1018 PMFWH PPSAV 23-Jan-79 38 | PROPT FCT 000 LCFFWH 67 26-Jan-78 1317 LCFFWH TENDMP 24-Feb-78 7-Feb-78P 2 39 | PROPT THY 000 LCFFWH 44 26-Jan-78 1317 LCFFWH TENDMP 7-Mar-78 7-Feb-78P 2 40 | RUL ML 000 LCFFWH 1500 26-Jan-78 1313 LCFFWH TENDMP 6-May-78 7-Feb-78P 2 41 | SIMPL ML 000 LCFFWH 2329 26-Jan-78 1313 LCFFWH TENDMP 7-Mar-78 7-Feb-78P 2 42 | THYFNS 000 LCFFWH 2866 26-Jan-78 1255 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 43 | TRAN 000 LCFFWH 2318 26-Jan-78 1248 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 44 | TYPEML 000 LCFFWH 3764 26-Jan-78 1248 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 45 | UDPEL DIR 000 LCFFWH 1664 6-Mar-78 1155 PFWH E 29-Nov-78 22-Mar-78P 2 46 | WRITML 000 LCFFWH 1577 26-Jan-78 1248 LCFFWH TENDMP 23-Jan-79 7-Feb-78P 2 47 | -------------------------------------------------------------------------------- /src/lcf.gra: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00005 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 5 | C00003 00003 1. Terms, awff's and wff's 6 | C00006 00004 2. Command-Syntax 7 | C00009 00005 4. Syntax for deduction commands 8 | C00012 ENDMK 9 | C⊗; 10 | 11 | GRAMMAR FOR LCF-PARSER: 12 | ---------------------- 13 | 14 | 15 | | separates alternatives 16 | { } optional 17 | { }* optional, may be present 0 or more times 18 | < > includes alternatives (separated by | ) 19 | 20 | Upper case letters or quoted symbols denote characters, lower case 21 | letters syntactic notions. Notions ending with "-c" denote commands. 22 | 23 | "aaa-ref" always means something refering to an "aaa", whereas 24 | "aaa-val" means a value which is an "aaa". 25 | A syntactic notion ending with "-number" or "-name" is a number 26 | or an ident resp. 27 | 28 | 29 | 1. Terms, awff's and wff's 30 | ----------------------- 31 | 32 | wff ← awff { ', awff }* 33 | 34 | 35 | awff ← awffref { awffmod } | 36 | term rel term 37 | 38 | awffref ← axiomref | stepref 39 | 40 | awffval ← awffref sep 41 | 42 | rel ← '≡ | '⊂ 43 | 44 | 45 | axiomref ← ident { sep awffselector } 46 | 47 | awffselector ← number 48 | 49 | 50 | stepnum ← stepnumber | labelref 51 | 52 | labelref ← { label } { '+ | '- { number }} 53 | label ← ident 54 | 55 | 56 | term ← infixterm | 57 | infixterm '→ |':→ term ', term | 58 | termval termmod 59 | 60 | termmod ← '[ term '← term { ', term '← term }* '] termmodifier 61 | = substitution 62 | termval ← defval | 63 | awffval termselector { { sep } selector }* 64 | 65 | termselector ← L | R | selector 66 | selector ← number 67 | 68 | sep ← '/ (may be changed) 69 | 70 | defval ← ident sep 71 | 72 | infixterm ← paramterm { infixop paramterm }* 73 | paramterm ← paramterm1 { paramterm1 }* 74 | paramterm1 ← simplterm { '( termlist ') }* 75 | 76 | termlist ← term { ', term }* 77 | 78 | simplterm ← ident | 79 | lambdaterm | 80 | muterm | 81 | sqbracketterm | 82 | '( term ') 83 | 84 | lambdaterm ← 'λ varlist '. term 85 | 86 | 87 | varlist ← idlist 88 | 89 | muterm ← 'α ident '. term 90 | 91 | sqbracketterm ← '[ < lambdaterm | muterm > '] 92 | 93 | 94 | definition ← ident '≡ term 95 | 96 | 2. Command-Syntax 97 | -------------- 98 | 99 | 100 | axiom-c ← AXIOM ident {':} wff ce 101 | 102 | define-c ← < DEFINE | DEF > definition {{',} definition }* ce 103 | 104 | assume-c ← ASSUME wff ce 105 | 106 | show-c ← SHOW < T term | 107 | A awff | 108 | S rangelist | 109 | PROOF | 110 | DEFS | 'D ident | 111 | AXIOMS | 'AX ident > 112 | 113 | rangelist ← steprange {{',} steprange }* 114 | 115 | steprange ← stepnum ': stepnum | stepnum 116 | 117 | 118 | label-c ← LA | LABEL ident stepnum ce 119 | 120 | 121 | ce ← "command-end character" (at present '; = sc) 122 | 123 | 124 | 125 | 126 | 3. Command-syntax for subgoaling 127 | ----------------------------- 128 | 129 | 130 | try-c ← TRY { goalnumber } { tactic } ce 131 | 132 | tactic ← CASES term 133 | SCASES term { simplist } 134 | SIMPL simplist 135 | SUBST lineno { OCC numberlist } 136 | SSUBST lineno { OCC numberlist } { simplist } 137 | INDUCT < stepnum | defname > { OCC numberlist } 138 | IINDUCT term { OCC numberlist } 139 | ABSTR 140 | CONJ 141 | PREF 142 | SPREF simplist 143 | USE ident { ', } {instlist } 144 | 145 | numlist ← number {', number }* 146 | 147 | instlist ← inst { ', inst }* 148 | inst ← ident '← term 149 | 150 | lineno ← labelref | stepnumber 151 | 152 | simplist ← simpseg { ', simpseg }* 153 | simpseg ← BY | WO simpitemlist 154 | simpitemlist ← simpitem {', simpitem }* 155 | simpitem ← simpelt { '/ < S | L | S L >} 156 | simpelt ← range | ident | lineno 157 | 158 | range ← ??? 159 | 160 | 161 | fetch-c ← FETCH filenamelist ce 162 | 163 | filenamelist ← filename {', filename }* 164 | filename ← ident {'. ident } {'[ < ident | number > ', ident '] } 165 | 166 | 4. Syntax for deduction commands 167 | ----------------------------- 168 | 169 | 170 | deduction-command ← appl | abstr | assume | cases | 171 | condt | condf | condu | 172 | conj | conv | cut | etaconv | 173 | equiv | fixp | half | incl | induct | min1 | min2 | 174 | refl1 | refl2 | subst | sym | trans 175 | 176 | 177 | abstr ← ABSTR stepnum ident ce 178 | 179 | appl ← APPL term stepnum ce 180 | 181 | assume ← ASSUME | SASSUME wff ce 182 | 183 | cases ← CASES stepnum stepnum stepnum ce 184 | 185 | condt ← CONDT condterm ce 186 | condf ← CONDF condterm ce 187 | condu ← CONDU condterm ce 188 | 189 | conj ← CONJ stepnum stepnum ce 190 | 191 | conv ← CONV stepnum ce 192 | 193 | cut ← CUT stepnum stepnum ce 194 | 195 | etaconv ← ETACONV term ce 196 | 197 | equiv ← EQUIV stepnum {',} stepnum ce 198 | 199 | fixp ← FIXP stepnum ce 200 | 201 | half ← HALF stepnum ce 202 | 203 | incl ← INCL stepnum stepnum ce 204 | 205 | induct ← INDUCT number number number number ident ce 206 | 207 | min1-c ← MIN1 term ce 208 | min2-c ← MIN2 term ce 209 | 210 | refl1-c ← REFL1 tterm ce 211 | refl2-c ← REFL2 tterm ce 212 | 213 | subst-c ← SUBST stepnum { OCC chrnum } IN number | 214 | SUBST stepnum { OCC chrnum } IN term 215 | 216 | trans ← TRANS stepnum {',} stepnum ce 217 | 218 | -------------------------------------------------------------------------------- /src/lcf.new: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 MODIFICATIONS OF LCF 5 | C00010 ENDMK 6 | C⊗; 7 | MODIFICATIONS OF LCF 8 | 9 | This file contains a listing of points, where the new LCF system 10 | differs from the old one. Because of the changes made to the 11 | syntax and a couple of semantic functions old input files won't 12 | always work. For details of the syntax see the file LCF.GRA. 13 | 14 | 15 | 16 | 1. Term-syntax 17 | ----------- 18 | 19 | Besides the standard term expressions a term can be referred to by 20 | - definition reference (see below), 21 | - stepnumbers, including labels (see below), 22 | - a selected subterm of a wff, awff, or term (see 1.1); e.g. T/3 23 | refers to the 3rd subexpression of T (if it exists and is a term). 24 | 25 | 26 | 1.1 Subexpression selection 27 | ----------------------- 28 | 29 | If you try to select a non-existing subterm the system will complain; 30 | perhaps you will also have other trouble. 31 | The syntax for term reference is 32 | {'/ }* 33 | where can be a definition name (see below) or one of the 34 | terms of an awff. Awff's are referred to in the same way. 35 | 36 | 37 | 38 | 2. Reference to stepnumbers 39 | ------------------------ 40 | 41 | Instead of repetitions of "-" the system now wants a "-", optionally 42 | followed by a number; i.d. instead of "----" you now have to type "-4". 43 | Labels must not be preceeded by a dot (but see below under 5.). 44 | 45 | 46 | 47 | 3. Subgoaling: Tactics-commands 48 | ---------------------------- 49 | There is a new tactic SCASES which knocks out the trivial cases by 50 | calling SIMPL immediately, otherwise it works like CASES. 51 | 52 | In the CASES/SCASES-tactics the term can be omitted if the lefthand-side 53 | of the goal to be tried is a conditional expression; in this case the 54 | required term is the cond-term of that expression. 55 | 56 | The INDUCT-tactic does not generated the base-case, if it is trivial 57 | (but generates the corresponding proofstep). 58 | The command "TRY QED ;" is the same as the sequence 59 | "TRY; QED <...>;". 60 | 61 | 62 | 63 | 64 | 4. Showing 65 | ------- 66 | 67 | There is a feature for options added to the show-command. 68 | For the time being it works only in the constellation 69 | "SHOW PROOF /NOG ". 70 | The switch /NOG means: don't print the goal structure part of 71 | the proof,i.e. only the proofsteps will be shown. 72 | This feature is to be extended to other areas. 73 | 74 | 75 | 5. Definitions 76 | ----------- 77 | 78 | There is a feature added to define functions (and other terms). 79 | The command-syntax is 80 | DEFINE | DEF termname '≡ term '; 81 | where termname ← ident | delimiter. 82 | Definitions are hold in a special list; they are refered to by the 83 | term-reference mechanism: the termname followed by ': or '/ refers 84 | to the defined term and may occur wherever a term is required. 85 | Besides that, definition can be refered to where either a wff or 86 | a stepnumber is required; in these cases the name of the defined 87 | term is sufficient. Thus "SUBST F" means "Replace (all occurences of) 88 | the name F by its definition (i.e., the right hand side of the associated 89 | awff) if it exists (otherwise the command is undefined; but see below!). 90 | The system attempts to use the definition in 91 | the appropriate form, e.g. if F has been defined as a mu-expression 92 | the command "SUBST F" will take the fixpoint whereas "INDUCT F" 93 | takes the original mu-form. 94 | Since the system cannot distinguish between 95 | identifiers denoting definitions, axioms or labels, it is the users 96 | job to pick disjoint names to avoid confusion in the system (and his proofs). 97 | For instance the command "SUBST F" will have different meaning 98 | depending on if a definition for F has been made, a label F has 99 | been declared etc. The system checks for definition, axioms, labels 100 | in this order. 101 | 102 | A more recent version may have some predefined operations, e.g. for for 103 | function composition. You can find out by typing the command 104 | "SHOW DEFINITIONS;". 105 | 106 | 107 | 108 | 109 | 6. System-Initialization 110 | --------------------- 111 | Due to the absence of MLISP2 there is a different procedure for allocating 112 | the token stack size. If there are more then (octal 500) tokens in a 113 | command line (this may happen, e.g., in axioms), then the size of the token 114 | stack must be redefined by "(INIT nn)" with nn a number≥500. 115 | In addition to the optional allocation the user has to go through a procedure 116 | that initializes the appropriate status of the system. For the time being, 117 | the system will ask "STATUS:" and the user can answer "TFL" (or short: T) 118 | or "LCF" (as a matter of fact any input other than TFL or T will cause 119 | the system initializing to LCF). The differences between the two versions 120 | are described in the file TFL.NEW[TFL,FWH]. 121 | 122 | 123 | 124 | 7. Commands 125 | -------- 126 | 127 | Some commands can be abbreviated, e.g. ASSUME to AS, SHOW to SH etc. 128 | For details see LCF.GRA. 129 | 130 | -------------------------------------------------------------------------------- /src/lcfm.lsp: -------------------------------------------------------------------------------- 1 | (SETQ BASTYPES NIL) 2 | (SETQ LANG1 (QUOTE ML1)) 3 | (SETQ LANG2 (QUOTE ML2)) 4 | (SETQ LANGLP (QUOTE MLLP)) 5 | (SETQ METAPREC 20) 6 | (UNOP (QUOTE begin) (QUOTE (SECRTN (QUOTE MK/-BEGIN)))) 7 | (UNOP (QUOTE end) (QUOTE (SECRTN (QUOTE MK/-END)))) 8 | (UNOP TMLSYM (QUOTE (FAIL (QUOTE (STUFF MISSING))))) 9 | (UNOP (QUOTE true) (QUOTE (QUOTE (MK/-BOOLCONST T)))) 10 | (UNOP (QUOTE false) (QUOTE (QUOTE (MK/-BOOLCONST NIL)))) 11 | (UNOP (QUOTE fail) (QUOTE (QUOTE (MK/-FAIL)))) 12 | (UNOP EXFIXSYM (QUOTE (EXFIXRTN))) 13 | (UNOP TCNSTSYM (QUOTE (PROG2 (GNT) (LIST (QUOTE MK/-TOKCONST) PTOKEN)))) 14 | (UNOP LPAREN (QUOTE (LPARENRTN))) 15 | (UNOP (QUOTE do) (QUOTE (LIST (QUOTE MK/-UNOP) (QUOTE do) (POP 410)))) 16 | (UNOP (QUOTE test) (QUOTE (TESTRTN))) 17 | (UNOP (QUOTE if) (QUOTE (TESTRTN))) 18 | (UNOP (QUOTE loop) (QUOTE (LIST (QUOTE MK/-TEST) NIL (CONS (QUOTE ITER) (POP 320))))) 19 | (UNOP (QUOTE else) (QUOTE (LIST (QUOTE MK/-TEST) NIL (CONS (QUOTE ONCE) (POP 320))))) 20 | (BNOP TP1SYM (QUOTE (LIST (QUOTE MK/-TRAP) ARG1 NIL (CONS (QUOTE ONCE) (POP 240))))) 21 | (BNOP TP2SYM (QUOTE (LIST (QUOTE MK/-TRAP) ARG1 NIL (CONS (QUOTE ITER) (POP 240))))) 22 | (BNOP TP3SYM (QUOTE (TRAPRTN (QUOTE ONCE)))) 23 | (BNOP TP4SYM (QUOTE (TRAPRTN (QUOTE ITER)))) 24 | (BNOP TP5SYM (QUOTE (TRAPBINDRTN (QUOTE ONCE)))) 25 | (BNOP TP6SYM (QUOTE (TRAPBINDRTN (QUOTE ITER)))) 26 | (UNOP LBRKT (QUOTE (LISTRTN))) 27 | (BNOP SCOLON (QUOTE (SEQRTN))) 28 | (UNOP (QUOTE let) (QUOTE (LETRTN (QUOTE MK/-LET)))) 29 | (UNOP (QUOTE letrec) (QUOTE (LETRTN (QUOTE MK/-LETREC)))) 30 | (UNOP (QUOTE letref) (QUOTE (LETRTN (QUOTE MK/-LETREF)))) 31 | (UNOP (QUOTE deftype) (QUOTE (LETRTN (QUOTE MK/-DEFTYPE)))) 32 | (UNOP (QUOTE lettype) (QUOTE (LETRTN (QUOTE MK/-DEFTYPE)))) 33 | (UNOP (QUOTE letrectype) (QUOTE (LETRTN (QUOTE MK/-DEFRECTYPE)))) 34 | (UNOP (QUOTE abstype) (QUOTE (LETRTN (QUOTE MK/-ABSTYPE)))) 35 | (UNOP (QUOTE absrectype) (QUOTE (LETRTN (QUOTE MK/-ABSRECTYPE)))) 36 | (BNOP (QUOTE in) (QUOTE (INRTN))) 37 | (BNOP (QUOTE where) (QUOTE (WHERERTN (QUOTE MK/-LET)))) 38 | (BNOP (QUOTE whererec) (QUOTE (WHERERTN (QUOTE MK/-LETREC)))) 39 | (BNOP (QUOTE whereref) (QUOTE (WHERERTN (QUOTE MK/-LETREF)))) 40 | (BNOP (QUOTE wheretype) (QUOTE (WHERERTN (QUOTE MK/-DEFTYPE)))) 41 | (BNOP (QUOTE whererectype) (QUOTE (WHERERTN (QUOTE MK/-DEFRECTYPE)))) 42 | (BNOP (QUOTE whereabstype) (QUOTE (WHERERTN (QUOTE MK/-ABSTYPE)))) 43 | (BNOP (QUOTE whereabsrectype) (QUOTE (WHERERTN (QUOTE MK/-ABSRECTYPE)))) 44 | (UNOP LAMSYM (QUOTE (LAMBRTN))) 45 | (BNOP ASGNSYM (QUOTE (ASSIGNRTN))) 46 | (BNOP COMMA (QUOTE (DUPLRTN))) 47 | (BNOP CONDLSYM (QUOTE (CONDRTN))) 48 | (BNOP DISJSYM (QUOTE (APPLRTN 470 (QUOTE %or)))) 49 | (BNOP CONJSYM (QUOTE (APPLRTN 510 (QUOTE %&)))) 50 | (UNOP (QUOTE failwith) (QUOTE (FAILWITHRTN))) 51 | (UNOP (QUOTE not) (QUOTE (LIST (QUOTE MK/-UNOP) (QUOTE not) (POP 530)))) 52 | (BNOP EQSYM (QUOTE (APPLRTN 550 EQSYM))) 53 | (BNOP LTSYM (QUOTE (APPLRTN 610 LTSYM))) 54 | (BNOP GTSYM (QUOTE (APPLRTN 570 GTSYM))) 55 | (BNOP CONCSYM (QUOTE (APPLRTN 620 CONCSYM))) 56 | (BNOP PERIOD (QUOTE (APPLRTN 640 PERIOD))) 57 | (BNOP PLUSSYM (QUOTE (APPLRTN 710 PLUSSYM))) 58 | (BNOP MNSSYM (QUOTE (APPLRTN 670 MNSSYM))) 59 | (UNOP MNSSYM (QUOTE (LIST (QUOTE MK/-UNOP) (QUOTE %/-) (POP 760)))) 60 | (BNOP MULSYM (QUOTE (APPLRTN 750 MULSYM))) 61 | (BNOP DIVSYM (QUOTE (APPLRTN 730 DIVSYM))) 62 | (BNOP COLON (QUOTE (MLTYPRTN))) 63 | (UNOP CNRSYM (QUOTE (CNRRTN))) 64 | (PUTPROP TMLSYM 0 LANGLP) 65 | (PUTPROP RPAREN 10 LANGLP) 66 | (PUTPROP (QUOTE EQINDEC) 30 LANGLP) 67 | (PUTPROP (QUOTE in) 60 LANGLP) 68 | (PUTPROP (QUOTE and) 70 LANGLP) 69 | (PUTPROP (QUOTE PERINLAM) 140 LANGLP) 70 | (PUTPROP SCOLON 150 LANGLP) 71 | (PUTPROP RBRKT 110 LANGLP) 72 | (PUTPROP (QUOTE where) 200 LANGLP) 73 | (PUTPROP (QUOTE whereref) 200 LANGLP) 74 | (PUTPROP (QUOTE whererec) 200 LANGLP) 75 | (PUTPROP (QUOTE wheretype) 200 LANGLP) 76 | (PUTPROP (QUOTE whererectype) 200 LANGLP) 77 | (PUTPROP (QUOTE whereabstype) 200 LANGLP) 78 | (PUTPROP (QUOTE whereabsrectype) 200 LANGLP) 79 | (PUTPROP (QUOTE PERINVS) 220 LANGLP) 80 | (PUTPROP TP1SYM 250 LANGLP) 81 | (PUTPROP TP2SYM 250 LANGLP) 82 | (PUTPROP TP3SYM 260 LANGLP) 83 | (PUTPROP TP4SYM 260 LANGLP) 84 | (PUTPROP TP5SYM 260 LANGLP) 85 | (PUTPROP TP6SYM 260 LANGLP) 86 | (PUTPROP (QUOTE loop) 300 LANGLP) 87 | (PUTPROP (QUOTE else) 300 LANGLP) 88 | (PUTPROP (QUOTE then) 300 LANGLP) 89 | (PUTPROP (QUOTE test) 310 LANGLP) 90 | (PUTPROP (QUOTE if) 310 LANGLP) 91 | (PUTPROP ASGNSYM 360 LANGLP) 92 | (PUTPROP COMMA 400 LANGLP) 93 | (PUTPROP ELSESYM 40 LANGLP) 94 | (PUTPROP CONDLSYM 440 LANGLP) 95 | (PUTPROP (QUOTE MLINFIX) 450 LANGLP) 96 | (PUTPROP (QUOTE or) 500 LANGLP) 97 | (PUTPROP CONJSYM 520 LANGLP) 98 | (PUTPROP GTSYM 560 LANGLP) 99 | (PUTPROP LTSYM 600 LANGLP) 100 | (PUTPROP EQSYM 540 LANGLP) 101 | (PUTPROP CONCSYM 630 LANGLP) 102 | (PUTPROP PERIOD 650 LANGLP) 103 | (PUTPROP MNSSYM 660 LANGLP) 104 | (PUTPROP PLUSSYM 700 LANGLP) 105 | (PUTPROP DIVSYM 720 LANGLP) 106 | (PUTPROP MULSYM 740 LANGLP) 107 | (PUTPROP COLON 770 LANGLP) 108 | (PUTPROP (QUOTE PRIMARY) 1010 LANGLP) -------------------------------------------------------------------------------- /src/lcfo: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP PARSEOL 3 | (LAMBDA(PL) 4 | (PROG (LANG1 LANG2 LANGLP ATOMRTN JUXTLEVEL JUXTRTN PARSEDEPTH) 5 | (SETQ LANG1 (QUOTE OL1)) 6 | (SETQ LANG2 (QUOTE OL2)) 7 | (SETQ LANGLP (QUOTE OLLP)) 8 | (SETQ ATOMRTN (QUOTE (OLATOMR))) 9 | (SETQ JUXTLEVEL 80) 10 | (SETQ JUXTRTN (QUOTE (OLJUXT ARG1))) 11 | (SETQ PARSEDEPTH 0) 12 | (RETURN (POP PL)))) 13 | EXPR) 14 | 15 | (DEFPROP OLINFIX 16 | (LAMBDA(X TYP) 17 | (PROG2 (PUTPROP X TYP (QUOTE OLINFIX)) 18 | ((LAMBDA(LANG1 LANG2 LANGLP) 19 | (BINOP X 20 | OLINPREC 21 | (LIST (COND ((EQ TYP (QUOTE PAIRED)) 22 | (QUOTE OLINFRTN)) 23 | (T (QUOTE OLCINFRTN))) 24 | (LIST (QUOTE QUOTE) X)))) 25 | (QUOTE OL1) 26 | (QUOTE OL2) 27 | (QUOTE OLLP)))) 28 | EXPR) 29 | 30 | (DEFPROP OLINFRTN 31 | (LAMBDA(X) 32 | (LIST (QUOTE mk=comb) 33 | (MKOLATOM X) 34 | (LIST (QUOTE mk=pair) 35 | (TERMCHK ARG1 (CONS (QUOTE ARG1) X)) 36 | (TERMCHK (POP OLINPREC) (CONS (QUOTE ARG2) X))))) 37 | EXPR) 38 | 39 | (DEFPROP OLCINFRTN 40 | (LAMBDA(X) 41 | (LIST (QUOTE mk=comb) 42 | (LIST (QUOTE mk=comb) 43 | (MKOLATOM X) 44 | (TERMCHK ARG1 (CONS (QUOTE ARG1) X))) 45 | (TERMCHK (POP OLINPREC) (CONS (QUOTE ARG2) X)))) 46 | EXPR) 47 | 48 | (DEFPROP LPARRTN 49 | (LAMBDA NIL 50 | (COND ((EQ TOKEN RPAREN) (PROG2 (GNT) (QUOTE (mk=tok /(/))))) 51 | (T (CHECK RPAREN (POP 0) (QUOTE (BAD PAREN BALANCE)))))) 52 | EXPR) 53 | 54 | (DEFPROP WFFRTN 55 | (LAMBDA(OPTR CONSTR A B) 56 | (PROG (X) 57 | (SETQ X (CONS (QUOTE OF) (CONS OPTR (QUOTE (IS A TERM))))) 58 | (RETURN 59 | (LIST CONSTR 60 | (WFFCHK A (CONS (QUOTE ARG1) X)) 61 | (WFFCHK B (CONS (QUOTE ARG2) X)))))) 62 | EXPR) 63 | 64 | (DEFPROP WFFCHK 65 | (LAMBDA(WFF MSG) 66 | (COND ((MEMQ (CAR WFF) TERMCONSTRS) (FAIL MSG)) (T WFF))) 67 | EXPR) 68 | 69 | (DEFPROP OLATOMR 70 | (LAMBDA NIL (MKOLATOM PTOKEN)) 71 | EXPR) 72 | 73 | (DEFPROP MKOLATOM 74 | (LAMBDA(X) 75 | (COND ((OR (MEMQ X SPECTOKS) (NUMBERP X)) 76 | (FAIL (CONS X (QUOTE (CANNOT BE A TERM))))) 77 | (T (LIST (QUOTE mk=tok) X)))) 78 | EXPR) 79 | 80 | (DEFPROP OLJUXT 81 | (LAMBDA(X) 82 | (LIST (QUOTE mk=comb) 83 | (TERMCHK X (QUOTE (WFF TERMINATED BY JUNK))) 84 | (TERMCHK (POP 80) (QUOTE (TERM JUXTAPOSED WITH WFF))))) 85 | EXPR) 86 | 87 | (DEFPROP LAMQRTN 88 | (LAMBDA(CONSTR CHK N MSG) 89 | (PROG (X) 90 | (SETQ X 91 | (COND ((EQ TOKEN ANTICNRTOK) (GNT) (METACALL)) 92 | ((NOT (EQUAL TOKTYP 1)) 93 | (FAIL (CONS TOKEN (QUOTE (IN A PREFIX))))) 94 | (T (GNT) (LIST (QUOTE mk=tok) PTOKEN)))) 95 | L (COND 96 | ((NOT (EQ TOKEN COLON)) 97 | (RETURN 98 | (LIST CONSTR 99 | X 100 | (COND ((EQ TOKEN PERIOD) 101 | (GNT) 102 | (APPLY CHK (LIST (POP N) MSG))) 103 | (T (LAMQRTN CONSTR CHK N MSG))))))) 104 | (GNT) 105 | (SETQ X (LIST (QUOTE mk=typed) X (OLT))) 106 | (GO L))) 107 | EXPR) 108 | 109 | (DEFPROP LAMRTN 110 | (LAMBDA NIL 111 | (LAMQRTN (QUOTE mk=abs) 112 | (FUNCTION TERMCHK) 113 | 40 114 | (QUOTE (LAMBDA BODY MUST BE A TERM)))) 115 | EXPR) 116 | 117 | (DEFPROP QUANTRTN 118 | (LAMBDA NIL 119 | (LAMQRTN (QUOTE mk=quant) 120 | (FUNCTION WFFCHK) 121 | 5 122 | (QUOTE (CAN ONLY QUANTIFY FORM)))) 123 | EXPR) 124 | 125 | (DEFPROP TERMRTN 126 | (LAMBDA(OPTR CONSTR A B) 127 | (PROG (X) 128 | (SETQ X 129 | (LIST (QUOTE OF) OPTR (QUOTE IS) (QUOTE A) (QUOTE WFF))) 130 | (RETURN 131 | (LIST CONSTR 132 | (TERMCHK A (CONS (QUOTE ARG1) X)) 133 | (TERMCHK B (CONS (QUOTE ARG2) X)))))) 134 | EXPR) 135 | 136 | (DEFPROP TERMCHK 137 | (LAMBDA(TM MSG) 138 | (COND ((MEMQ (CAR TM) WFFCONSTRS) (FAIL MSG)) (T TM))) 139 | EXPR) 140 | 141 | (DEFPROP CONDLRTN 142 | (LAMBDA(P) 143 | (PROG (X Y) 144 | (SETQ P 145 | (TERMCHK P (QUOTE (CONDITION OF CONDITIONAL NOT TERM)))) 146 | (SETQ X 147 | (TERMCHK (CHECK ELSETOK 148 | (POP 50) 149 | (QUOTE 150 | (NEED 2 ND BRANCH TO CONDITIONAL))) 151 | (QUOTE (1 ST BRANCH OF CONDITIONAL NOT TERM)))) 152 | (SETQ Y 153 | (TERMCHK (POP 50) 154 | (QUOTE (2 ND BRANCH OF CONDITIONAL NOT TERM)))) 155 | (RETURN (LIST (QUOTE mk=cond) P X Y)))) 156 | EXPR) 157 | 158 | (DEFPROP METACALL 159 | (LAMBDA NIL 160 | (LIST (QUOTE mk=antiquot) 161 | (PROG2 (GNT) 162 | (COND ((EQ PTOKEN LPAREN) 163 | (CHECK RPAREN 164 | (PARSEML METAPREC) 165 | (QUOTE (BAD ANTIQUOTATION)))) 166 | ((EQ PTOKTYP 1) (MLATOMR)) 167 | ((FAIL (QUOTE (JUNK IN ANTIQUOTATION)))))))) 168 | EXPR) 169 | 170 | (DEFPROP OLTYPRTN 171 | (LAMBDA NIL 172 | (LIST (QUOTE mk=typed) 173 | (TERMCHK ARG1 (QUOTE (ONLY A TERM CAN HAVE A TYPE))) 174 | (OLT))) 175 | EXPR) 176 | 177 | (DEFPROP OLT 178 | (LAMBDA NIL (OLT1 (OLT2 (OLT3 (OLT4))))) 179 | EXPR) 180 | 181 | (DEFPROP OLT1 182 | (LAMBDA(X) 183 | (COND ((EQ TOKEN ARROWTOK) 184 | (PROG2 (GNT) (LIST (QUOTE mk=funtype) X (OLT)))) 185 | (T X))) 186 | EXPR) 187 | 188 | (DEFPROP OLT2 189 | (LAMBDA(X) 190 | (COND ((EQ TOKEN SUMTOK) 191 | (PROG2 (GNT) 192 | (LIST (QUOTE mk=sumtype) X (OLT2 (OLT3 (OLT4)))))) 193 | (T X))) 194 | EXPR) 195 | 196 | (DEFPROP OLT3 197 | (LAMBDA(X) 198 | (COND ((EQ TOKEN PRODTOK) 199 | (PROG2 (GNT) (LIST (QUOTE mk=prodtype) X (OLT3 (OLT4))))) 200 | (T X))) 201 | EXPR) 202 | 203 | (DEFPROP OLT4 204 | (LAMBDA NIL 205 | (PROG2 (GNT) 206 | (COND ((EQ PTOKEN LPAREN) 207 | (CHECK RPAREN (OLT) (QUOTE (BAD TYPE EXPRESSION)))) 208 | ((EQ PTOKEN ANTICNRTOK) (METACALL)) 209 | ((EQ PTOKEN NULLTYPTOK) (QUOTE (mk=nulltype))) 210 | ((EQ PTOKEN MULSYM) 211 | (LIST (QUOTE mk=vartype) (VARTYPERTN))) 212 | ((NOT (EQ PTOKTYP 1)) 213 | (FAIL (QUOTE (JUNK IN A TYPE EXPRESSION)))) 214 | (T (LIST (QUOTE mk=consttype) PTOKEN))))) 215 | EXPR) 216 | -------------------------------------------------------------------------------- /src/lcfo.lsp: -------------------------------------------------------------------------------- 1 | 2 | (SETQ LANG1 @OL1) 3 | (SETQ LANG2 @OL2) 4 | (SETQ LANGLP @OLLP) 5 | 6 | 7 | (PUTPROP ENDCNRTOK 0 @OLLP) 8 | (PUTPROP RPAREN 0 @OLLP) 9 | (PUTPROP @/; 0 @OLLP) 10 | (UNOP LPAREN @(LPARRTN)) 11 | 12 | 13 | (UNOP TRUTHTOK @(QUOTE (mk=truth))) 14 | (UNOP QUANTTOK @(QUANTRTN)) 15 | (BINOP IMPTOK 10 @(WFFRTN (QUOTE IMPLICATION) (QUOTE mk=imp) 16 | ARG1 (POP 10))) 17 | (BINOP CONJTOK 20 @(WFFRTN (QUOTE CONJUNCTION) (QUOTE mk=conj) 18 | ARG1 (POP 20))) 19 | 20 | 21 | (BINOP EQTOK 30 @(TERMRTN (QUOTE EQUALITY) (QUOTE mk=equiv) ARG1 (POP 30))) 22 | (BINOP INEQTOK 30 @(TERMRTN (QUOTE INEQUALITY) (QUOTE mk=inequiv) 23 | ARG1 (POP 30))) 24 | 25 | 26 | (BINOP COMMA 65 @(TERMRTN (QUOTE TUPLING) (QUOTE mk=pair) 27 | ARG1 (POP 60))) 28 | (UNOP LAMTOK @(LAMRTN)) 29 | (BINOP CONDLTOK 55 @(CONDLRTN ARG1)) 30 | (PUTPROP ELSETOK 50 @OLLP) 31 | 32 | (BINOP COLON 75 @(OLTYPRTN)) 33 | (UNOP ANTICNRTOK @(METACALL)) 34 | 35 | 36 | (UNOP EXFIXSYM @(PROG2 (GNT) (MKOLATOM PTOKEN))) 37 | 38 | (SETQ OLINPREC 70) 39 | -------------------------------------------------------------------------------- /src/lean: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP GNC 3 | (LAMBDA NIL 4 | ((LAMBDA (CH) (COND ((EQ CH CTRLDSYM) (ERR CTRLDSYM)) (T CH))) 5 | (READCH))) 6 | EXPR) 7 | 8 | (DEFPROP INITLEAN 9 | (LAMBDA NIL 10 | (PROG NIL 11 | (SETQ TOKEN NIL) 12 | (SETQ TOKCHS NIL) 13 | (SETQ TOKTYP NIL) 14 | (SETQ CHAR SPACE) 15 | (PUTPROP TOKBEARER NIL (QUOTE TOKVAL)) 16 | (PUTPROP TOKLBEARER NIL (QUOTE TOKLVAL)) 17 | (CLRBFI))) 18 | EXPR) 19 | 20 | (DEFPROP GNT 21 | (LAMBDA NIL 22 | (PROG (X) 23 | (SETQ CFLAG NIL) 24 | TOP (SETQ PTOKEN TOKEN) 25 | (SETQ PTOKCHS TOKCHS) 26 | (SETQ PTOKTYP TOKTYP) 27 | (SETQ PCHAR CHAR) 28 | (COND ((EQ CHAR CMNTCHR) 29 | (PROG NIL L (COND ((NOT (EQ (GNC) CMNTCHR)) (GO L)))) 30 | (SETQ CHAR (GNC)) 31 | (GO TOP)) 32 | ((EQ (SETQ X (LEANPROP CHAR)) 1) 33 | (SETQ CFLAG T) 34 | (SETQ CHAR (GNC)) 35 | (GO TOP)) 36 | ((EQ X 2) (SETQ TOKCHS (LIST CHAR)) 37 | (SETQ TOKTYP 1) 38 | (COND ((NUMBERP CHAR) (NUMB)) (T (IDENT)))) 39 | ((EQ CHAR TOKQTSYM) 40 | (SETQ TOKCHS NIL) 41 | (SETQ TOKTYP 1) 42 | (COND ((EQ (SETQ CHAR (GNC)) TOKQTSYM) (TCNL)) 43 | (T (TCN)))) 44 | (T (SETQ TOKCHS (LIST CHAR)) 45 | (SETQ CHAR (GNC)) 46 | (SETQ TOKTYP 2) 47 | (SETQ TOKEN (CAR TOKCHS)))) 48 | (COND 49 | ((AND (EQ TOKEN SCOLON) (EQ CHAR CR)) 50 | (SETQ CHAR (PROG2 (GNC) (GNC))))) 51 | (COND 52 | ((OR (NUMBERP TOKEN) 53 | (NOT (MEMQ CHAR (GET TOKEN (QUOTE DOUBLE))))) 54 | (RETURN TOKEN))) 55 | (SETQ TOKTYP 2) 56 | (SETQ TOKCHS (APPEND TOKCHS (LIST CHAR))) 57 | (SETQ TOKEN (PACK TOKCHS)) 58 | (SETQ CHAR (GNC)) 59 | (RETURN TOKEN))) 60 | EXPR) 61 | 62 | (DEFPROP NUMB 63 | (LAMBDA NIL 64 | (COND ((NUMBERP (SETQ CHAR (GNC))) 65 | (PROG2 (SETQ TOKCHS (CONS CHAR TOKCHS)) (NUMB))) 66 | (T (SETQ TOKEN (READLIST (REVERSE TOKCHS)))))) 67 | EXPR) 68 | 69 | (DEFPROP IDENT 70 | (LAMBDA NIL 71 | (COND ((EQ (LEANPROP (SETQ CHAR (GNC))) 2) 72 | (PROG2 (SETQ TOKCHS (CONS CHAR TOKCHS)) (IDENT))) 73 | (T (SETQ TOKEN (READLIST (REVERSE TOKCHS)))))) 74 | EXPR) 75 | 76 | (DEFPROP TCN 77 | (LAMBDA NIL 78 | (PROG NIL 79 | L (COND ((EQ CHAR ESCAPESYM) 80 | (SETQ CHAR (GNC)) 81 | (SETQ TOKCHS (APPEND (ESCAPERTN) TOKCHS))) 82 | ((EQ CHAR TOKQTSYM) 83 | (SETQ CHAR (GNC)) 84 | (SETQ TOKEN TOKBEARER) 85 | (PUTPROP 86 | TOKBEARER 87 | (APPEND (GET TOKBEARER (QUOTE TOKVAL)) 88 | (LIST (PACK (REVERSE TOKCHS)))) 89 | (QUOTE TOKVAL)) 90 | (RETURN TOKEN)) 91 | (T (SETQ TOKCHS (CONS CHAR TOKCHS)))) 92 | (SETQ CHAR (GNC)) 93 | (GO L))) 94 | EXPR) 95 | 96 | (DEFPROP TCNL 97 | (LAMBDA NIL 98 | (PROG (TOKL) 99 | (SETQ TOKL NIL) 100 | L1 (SETQ CHAR (GNC)) 101 | L2 (COND 102 | ((EQ CHAR ESCAPESYM) 103 | (SETQ CHAR (GNC)) 104 | (SETQ TOKCHS (APPEND (ESCAPERTN) TOKCHS)) 105 | (GO L1)) 106 | ((EQ CHAR TOKQTSYM) 107 | (COND 108 | ((EQ (SETQ CHAR (GNC)) TOKQTSYM) 109 | (COND 110 | (TOKCHS (SETQ TOKL (CONS (PACK (REVERSE TOKCHS)) TOKL)))) 111 | (SETQ TOKEN TOKLBEARER) 112 | (PUTPROP 113 | TOKLBEARER 114 | (APPEND (GET TOKLBEARER (QUOTE TOKLVAL)) 115 | (LIST (REVERSE TOKL))) 116 | (QUOTE TOKLVAL)) 117 | (SETQ CHAR (GNC)) 118 | (RETURN TOKEN)) 119 | (T (SETQ TOKCHS (CONS TOKQTSYM TOKCHS)) (GO L2)))) 120 | ((EQ (LEANPROP CHAR) 1) 121 | (PROG NIL 122 | L3 (COND ((EQ (LEANPROP (SETQ CHAR (GNC))) 1) (GO L3)))) 123 | (COND 124 | (TOKCHS (SETQ TOKL (CONS (PACK (REVERSE TOKCHS)) TOKL)))) 125 | (SETQ TOKCHS NIL) 126 | (GO L2)) 127 | (T (SETQ TOKCHS (CONS CHAR TOKCHS)) (GO L1))))) 128 | EXPR) 129 | 130 | (DEFPROP ESCAPERTN 131 | (LAMBDA NIL 132 | (COND ((EQ CHAR 0) (CHARSEQ SPACE 12)) 133 | ((NUMBERP CHAR) (CHARSEQ SPACE CHAR)) 134 | ((GET CHAR (QUOTE STRINGMACRO))) 135 | (T (LIST CHAR)))) 136 | EXPR) 137 | 138 | (DEFPROP LEANPROP 139 | (LAMBDA (X) (COND ((NUMBERP X) 2) ((GET X (QUOTE LEANPROP))) (T 3))) 140 | EXPR) 141 | 142 | (DEFPROP VARTYPERTN 143 | (LAMBDA NIL 144 | (PROG (N) 145 | (COND (CFLAG (RETURN MULSYM))) 146 | (SETQ N 1) 147 | LOOP (COND ((OR (NUMBERP TOKEN) (EQ TOKTYP 1) (EQ TOKEN MULSYM))) 148 | (T (RETURN (PACK (CHARSEQ MULSYM N))))) 149 | (GNT) 150 | (COND 151 | ((AND (EQ PTOKEN MULSYM) (NOT CFLAG)) 152 | (SETQ N (ADD1 N)) 153 | (GO LOOP))) 154 | (RETURN (PACK (APPEND (CHARSEQ MULSYM N) (EXPLODE PTOKEN)))))) 155 | EXPR) 156 | -------------------------------------------------------------------------------- /src/leanpr: -------------------------------------------------------------------------------- 1 | (SETQ TOKEN NIL) (SETQ PTOKEN NIL) 2 | (SETQ TOKCHS NIL) (SETQ PTOKCHS NIL) 3 | (SETQ TOKTYP NIL) (SETQ PTOKTYP NIL) 4 | (SETQ CHAR SPACE) 5 | 6 | 7 | 8 | (PUTPROP SPACE 1 @LEANPROP) 9 | (PUTPROP CR 1 @LEANPROP) 10 | (PUTPROP LF 1 @LEANPROP) 11 | (PUTPROP TAB 1 @LEANPROP) 12 | 13 | (PUTPROP @/' 2 @LEANPROP) 14 | 15 | (PUTPROP @a 2 @LEANPROP) (PUTPROP @A 2 @LEANPROP) 16 | (PUTPROP @b 2 @LEANPROP) (PUTPROP @B 2 @LEANPROP) 17 | (PUTPROP @c 2 @LEANPROP) (PUTPROP @C 2 @LEANPROP) 18 | (PUTPROP @d 2 @LEANPROP) (PUTPROP @D 2 @LEANPROP) 19 | (PUTPROP @e 2 @LEANPROP) (PUTPROP @E 2 @LEANPROP) 20 | (PUTPROP @f 2 @LEANPROP) (PUTPROP @F 2 @LEANPROP) 21 | (PUTPROP @g 2 @LEANPROP) (PUTPROP @G 2 @LEANPROP) 22 | (PUTPROP @h 2 @LEANPROP) (PUTPROP @H 2 @LEANPROP) 23 | (PUTPROP @i 2 @LEANPROP) (PUTPROP @I 2 @LEANPROP) 24 | (PUTPROP @j 2 @LEANPROP) (PUTPROP @J 2 @LEANPROP) 25 | (PUTPROP @k 2 @LEANPROP) (PUTPROP @K 2 @LEANPROP) 26 | (PUTPROP @l 2 @LEANPROP) (PUTPROP @L 2 @LEANPROP) 27 | (PUTPROP @m 2 @LEANPROP) (PUTPROP @M 2 @LEANPROP) 28 | (PUTPROP @n 2 @LEANPROP) (PUTPROP @N 2 @LEANPROP) 29 | (PUTPROP @o 2 @LEANPROP) (PUTPROP @O 2 @LEANPROP) 30 | (PUTPROP @p 2 @LEANPROP) (PUTPROP @P 2 @LEANPROP) 31 | (PUTPROP @q 2 @LEANPROP) (PUTPROP @Q 2 @LEANPROP) 32 | (PUTPROP @r 2 @LEANPROP) (PUTPROP @R 2 @LEANPROP) 33 | (PUTPROP @s 2 @LEANPROP) (PUTPROP @S 2 @LEANPROP) 34 | (PUTPROP @t 2 @LEANPROP) (PUTPROP @T 2 @LEANPROP) 35 | (PUTPROP @u 2 @LEANPROP) (PUTPROP @U 2 @LEANPROP) 36 | (PUTPROP @v 2 @LEANPROP) (PUTPROP @V 2 @LEANPROP) 37 | (PUTPROP @w 2 @LEANPROP) (PUTPROP @W 2 @LEANPROP) 38 | (PUTPROP @x 2 @LEANPROP) (PUTPROP @X 2 @LEANPROP) 39 | (PUTPROP @y 2 @LEANPROP) (PUTPROP @Y 2 @LEANPROP) 40 | (PUTPROP @z 2 @LEANPROP) (PUTPROP @Z 2 @LEANPROP) 41 | 42 | 43 | (PUTPROP @L (LIST LF) @STRINGMACRO) 44 | (PUTPROP @R (LIST CR) @STRINGMACRO) 45 | (PUTPROP @S (LIST SPACE) @STRINGMACRO) 46 | (PUTPROP @T (LIST TAB) @STRINGMACRO) 47 | 48 | 49 | 50 | (PUTPROP @/= @(/> /=) @DOUBLE) 51 | (PUTPROP @/- @(/>) @DOUBLE) 52 | (PUTPROP @/< @(/<) @DOUBLE) 53 | (PUTPROP @/: @(/: /=) @DOUBLE) 54 | (PUTPROP @/` @(/`) @DOUBLE) 55 | (PUTPROP @/? @(/? /\) @DOUBLE) 56 | (PUTPROP @/; @(/;) @DOUBLE) 57 | (PUTPROP @/! @(/! /\) @DOUBLE) 58 | 59 | 60 | (SETQ ARG1 NIL) 61 | -------------------------------------------------------------------------------- /src/lesyn: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | newtypes[``NEXP = NCON + NEXP'``; 5 | ``NEXP' = IDEN + CNEXP``; 6 | ``CNEXP = NOP # NEXPPR``; 7 | ``NEXPPR = NEXP # NEXP `` ] ;; 8 | 9 | newtypes[``TEXP = TCON + CTEXP``; 10 | ``CTEXP = TOP # NEXPPR `` ] ;; 11 | 12 | map newconstant[ 13 | `isncon`,":NEXP->TR"; 14 | `isiden`,":NEXP->TR"; 15 | `iscnexp`,":NEXP->TR"; 16 | `mkncon`,":NCON->NEXP"; 17 | `mkiden`,":IDEN->NEXP"; 18 | `mkcnexp`,":CNEXP->NEXP"; 19 | `destncon`,":NEXP->NCON"; 20 | `destiden`,":NEXP->IDEN"; 21 | `destcnexp`,":NEXP->CNEXP"] ;; 22 | 23 | map newaxiom[ 24 | `isn`,"isncon e == ISL e"; 25 | `isi`,"isiden e == ISL e => FF | ISL(OUTR e)"; 26 | `isc`,"iscnexp e == ISL e => FF | ISR(OUTR e)"; 27 | `mkn`,"mkncon n == INL n"; 28 | `mki`,"mkiden i == INR(INL i)"; 29 | `mkc`,"mkcnexp c == INR(INR c)"; 30 | `destn`, "destncon e == OUTL e"; 31 | `desti`, "destiden e == OUTL(OUTR e)"; 32 | `destc`, "destcnexp e == OUTR(OUTR e)"];; 33 | 34 | 35 | 36 | 37 | 38 | newconstant( `expfun`, ":(NEXP->NEXP)->(NEXP->NEXP)");; 39 | 40 | newaxiom(`expax1`, " FIX expfun e == e");; 41 | 42 | newaxiom(`expax2`, 43 | "expfun f e == 44 | isncon e => mkncon(destncon e) | 45 | isiden e => mkiden(destiden e) | 46 | iscnexp e => 47 | mkcnexp(FST(destcnexp e), 48 | f(FST(SND(destcnexp e))),f(SND(SND(destcnexp e)))) 49 | | UU " ) ;; 50 | -------------------------------------------------------------------------------- /src/lesyn.all: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00006 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 % LESYN % 5 | C00005 00003 % LESYN.IND % 6 | C00008 00004 % LESYN.FCT % 7 | C00009 00005 % LESYN.THY % 8 | C00012 00006 % LESYN.TAC % 9 | C00015 ENDMK 10 | C⊗; 11 | % LESYN % 12 | 13 | (TML) 14 | 15 | newtypes[``NEXP = NCON + NEXP'``; 16 | ``NEXP' = IDEN + CNEXP``; 17 | ``CNEXP = NOP # NEXPPR``; 18 | ``NEXPPR = NEXP # NEXP `` ] ;; 19 | 20 | newtypes[``TEXP = TCON + CTEXP``; 21 | ``CTEXP = TOP # NEXPPR `` ] ;; 22 | 23 | map newconstant[ 24 | `isncon`,":NEXP->TR"; 25 | `isiden`,":NEXP->TR"; 26 | `iscnexp`,":NEXP->TR"; 27 | `mkncon`,":NCON->NEXP"; 28 | `mkiden`,":IDEN->NEXP"; 29 | `mkcnexp`,":CNEXP->NEXP"; 30 | `destncon`,":NEXP->NCON"; 31 | `destiden`,":NEXP->IDEN"; 32 | `destcnexp`,":NEXP->CNEXP"] ;; 33 | 34 | map newaxiom[ 35 | `isn`,"isncon e == ISL e"; 36 | `isi`,"isiden e == ISL e => FF | ISL(OUTR e)"; 37 | `isc`,"iscnexp e == ISL e => FF | ISR(OUTR e)"; 38 | `mkn`,"mkncon n == INL n"; 39 | `mki`,"mkiden i == INR(INL i)"; 40 | `mkc`,"mkcnexp c == INR(INR c)"; 41 | `destn`, "destncon e == OUTL e"; 42 | `desti`, "destiden e == OUTL(OUTR e)"; 43 | `destc`, "destcnexp e == OUTR(OUTR e)"];; 44 | 45 | 46 | 47 | 48 | 49 | newconstant( `expfun`, ":(NEXP->NEXP)->(NEXP->NEXP)");; 50 | 51 | newaxiom(`expax1`, " FIX expfun e == e");; 52 | 53 | newaxiom(`expax2`, 54 | "expfun f e == 55 | isncon e => mkncon(destncon e) | 56 | isiden e => mkiden(destiden e) | 57 | iscnexp e => 58 | mkcnexp(FST(destcnexp e), 59 | f(FST(SND(destcnexp e))),f(SND(SND(destcnexp e)))) 60 | | UU " ) ;; 61 | 62 | % LESYN.IND % 63 | 64 | let SIMPCOND eqn th = SIMP (ssadd (ASSUME eqn) BASICSS) th ;; 65 | 66 | let PROC v F Fth instl eqn th = 67 | SUBST [SIMPCOND eqn th, v] F (INST instl Fth);; 68 | 69 | 70 | 71 | let NEXPINDUCT(n,i,nop,e1,e2) e F [uuth;nconth;identh;cnexpth] = 72 | let isncon,isiden,iscnexp = "isncon↑e", "isiden↑e", "iscnexp↑e" 73 | and f = mkvar(gentok(), ":NEXP->NEXP") 74 | in 75 | let G = mkquant(e, substinform[mkcomb(f,e),e] F) 76 | and ax = SYM(SPEC f (SPEC e (AXIOM`LESYN` `expax2`))) 77 | and PROCF = PROC e F 78 | in 79 | SUBST [SPEC e (AXIOM`LESYN` `expax1`) , e] F 80 | (SPEC e (INDUCT ["expfun", f] G (baseth,stepth))) 81 | where baseth = GEN e (SUBST [SYM(MINAP"UU↑e:NEXP") , e] F uuth) 82 | and stepth = GEN e 83 | let ASSG = ASSUME G in CASES isncon 84 | (PROCF nconth ["destncon↑e", n] (eqtt isncon) ax, 85 | casef, 86 | PROCF uuth [] (equu isncon) ax 87 | where casef = 88 | let ax = SIMPCOND(eqff isncon)ax in CASES isiden 89 | (PROCF identh ["destiden↑e", i] (eqtt isiden) ax, 90 | casef, 91 | PROCF uuth [] (equu isiden) ax 92 | where casef = 93 | let ax = SIMPCOND(eqff isiden)ax in CASES iscnexp 94 | (caset, 95 | PROCF uuth [] (eqff iscnexp) ax, 96 | PROCF uuth [] (equu iscnexp) ax 97 | where caset = 98 | let ce = "destcnexp↑e" in 99 | let d1,d2 = "FST(SND↑ce)", "SND(SND↑ce)" in 100 | SUBST [SIMPCOND(eqtt iscnexp)ax , e] F 101 | (MP(MP (INST ["FST↑ce",nop ; "↑f↑d1",e1 ; "↑f↑d2",e2] cnexpth) 102 | (SPEC d1 ASSG))(SPEC d2 ASSG)) 103 | ))) 104 | ;; 105 | % LESYN.FCT % 106 | 107 | inn "!n:NCON. isncon(mkncon n) == TT" 108 | 109 | ini "!i:IDEN. isncon(mkiden i) == FF" 110 | 111 | inc "!c:CNEXP. isncon(mkcnexp c) == FF" 112 | 113 | iin "!n:NCON. isiden(mkncon n) == FF" 114 | 115 | iii "!i:IDEN. isiden(mkiden i) == TT" 116 | 117 | iic "!c:CNEXP. isiden(mkcnexp c) == FF" 118 | 119 | icn "!n:NCON. iscnexp(mkncon n) == FF" 120 | 121 | ici "!i:IDEN. iscnexp(mkiden i) == FF" 122 | 123 | icc "!c:CNEXP. iscnexp(mkcnexp c) == TT" 124 | 125 | dnn "!n:NCON. destncon(mkncon n) == n" 126 | 127 | dii "!i:IDEN. destiden(mkiden i) == i" 128 | 129 | dcc "!c:CNEXP. destcnexp(mkcnexp c) == c" 130 | 131 | % LESYN.THY % 132 | 133 | 134 | THEORY LESYN 135 | 136 | 137 | newtypes [ ``NEXP = NCON + NEXP'`` ; 138 | ``NEXP' = IDEN + CNEXP`` ; 139 | ``CNEXP = NOP # NEXPPR`` ; 140 | ``NEXPPR = NEXP # NEXP`` ] ;; 141 | 142 | newtypes [ ``TEXP = TCON + CTEXP`` ; 143 | ``CTEXP = TOP # NEXPPR`` ] ;; 144 | 145 | newconstant ( `isncon` , ":NEXP->tr" ) ;; 146 | 147 | newconstant ( `isiden` , ":NEXP->tr" ) ;; 148 | 149 | newconstant ( `iscnexp` , ":NEXP->tr" ) ;; 150 | 151 | newconstant ( `mkncon` , ":NCON->NEXP" ) ;; 152 | 153 | newconstant ( `mkiden` , ":IDEN->NEXP" ) ;; 154 | 155 | newconstant ( `mkcnexp` , ":CNEXP->NEXP" ) ;; 156 | 157 | newconstant ( `destncon` , ":NEXP->NCON" ) ;; 158 | 159 | newconstant ( `destiden` , ":NEXP->IDEN" ) ;; 160 | 161 | newconstant ( `destcnexp` , ":NEXP->CNEXP" ) ;; 162 | 163 | newconstant ( `expfun` , ":(NEXP->NEXP)->(NEXP->NEXP)" ) ;; 164 | 165 | NEWAXIOMS();; 166 | 167 | isn "!e:NEXP. isncon e == ISL e :tr" 168 | 169 | isi "!e:NEXP. isiden e == ISL e=>FF|ISL(OUTR e :NEXP') :tr" 170 | 171 | isc "!e:NEXP. iscnexp e == ISL e=>FF|ISR(OUTR e :NEXP') :tr" 172 | 173 | mkn "!n:NCON. mkncon n == INL n :NEXP" 174 | 175 | mki "!i:IDEN. mkiden i == INR(INL i :NEXP') :NEXP" 176 | 177 | mkc "!c:CNEXP. mkcnexp c == INR(INR c :NEXP') :NEXP" 178 | 179 | destn "!e:NEXP. destncon e == OUTL e :NCON" 180 | 181 | desti "!e:NEXP. destiden e == OUTL(OUTR e :NEXP') :IDEN" 182 | 183 | destc "!e:NEXP. destcnexp e == OUTR(OUTR e :NEXP') :CNEXP" 184 | 185 | expax1 "!e:NEXP. FIX expfun e == e" 186 | 187 | expax2 "!e:NEXP. !f:NEXP->NEXP. expfun f e == isncon e=>mkncon(destncon e)|(isiden e=>mkiden(destiden e)|(iscne~ 188 | xp e=>mkcnexp(FST(destcnexp e), (f(FST(SND(destcnexp e) :NEXPPR)), f(SND(SND(destcnexp e) :NEXPPR))))|UU:NEXP))" 189 | 190 | % LESYN.TAC % 191 | 192 | let vary wl v = variant (v, formlfrees wl) ;; 193 | 194 | 195 | let NEXPINDUCTAC e (F,ss,Fl) = 196 | (( [ w "UU:NEXP" , ss , Fl ; w "mkncon↑n" , ss , Fl ; 197 | w "mkiden↑i" , ss , Fl ; 198 | w "mkcnexp(↑nop,↑e1,↑e2)" , ss , w1.w2.Fl ] , 199 | \[th1;th2;th3;th4] . NEXPINDUCT(n,i,nop,e1,e2)e F 200 | [th1;th2;th3;DISCH w1 (DISCH w2 th4)] 201 | ) where w1,w2 = w e1, w e2 ) 202 | where w t = substinform[t,e] F 203 | and [n;i;nop;e1;e2] = map(vary(F.Fl)) 204 | [ "n:NCON" ; "i:IDEN" ; "nop:NOP" ; "e1:NEXP";"e2:NEXP"] ;; 205 | 206 | 207 | 208 | let CONTRTAC g = 209 | (let w1,w2 = destimp(fst g) in 210 | let th = CONTR w2 (ASSUME w1) in [], K(DISCH w1 th) 211 | ) ? 212 | ( [g], hd) ;; 213 | 214 | let ADDSIMPTAC swl (w,ss,wl) = 215 | SIMPTAC(w, itlist f swl ss, wl) where f sw = ssadd(ASSUME sw) ;; 216 | 217 | let ANTETAC(w,ss,wl) = 218 | (let w1,w2 = destimp w in 219 | [ w2, ssadd(ASSUME w1)ss, w1.wl] , DISCH w1 o hd 220 | ) ? 221 | ( [w,ss,wl] , hd ) ;; 222 | 223 | let CONDCASESTAC(fm,ss,fml) = 224 | let tm = findterminform p fm 225 | where p t = iscomb t & 226 | (let t1,t2 = destcomb t in isconst t1 & fst(destconst t1)=`COND` 227 | & freeinform[t2]fm ) 228 | in CASESTAC(snd(destcomb tm))(fm,ss,fml) ;; 229 | 230 | let STEPTAC g = (SIMPTAC THEN (CONDCASESTAC ORELSE IDTAC) THEN SIMPTAC 231 | THEN CONTRTAC THEN ANTETAC 232 | THEN ADDSIMPTAC[w1;w2])g where (),(),w1.w2.() = g ;; 233 | 234 | let SIMPANTETAC = SIMPTAC THEN ANTETAC THEN SIMPTAC ;; 235 | 236 | let NEXPINDUCTAC' e = NEXPINDUCTAC e THENL 237 | [SIMPANTETAC;SIMPANTETAC;SIMPANTETAC; STEPTAC] ;; 238 | 239 | -------------------------------------------------------------------------------- /src/lesyn.ind: -------------------------------------------------------------------------------- 1 | 2 | let SIMPCOND eqn th = SIMP (ssadd (ASSUME eqn) BASICSS) th ;; 3 | 4 | let PROC v F Fth instl eqn th = 5 | SUBST [SIMPCOND eqn th, v] F (INST instl Fth);; 6 | 7 | 8 | 9 | let NEXPINDUCT(n,i,nop,e1,e2) e F [uuth;nconth;identh;cnexpth] = 10 | let isncon,isiden,iscnexp = "isncon↑e", "isiden↑e", "iscnexp↑e" 11 | and f = mkvar(gentok(), ":NEXP->NEXP") 12 | in 13 | let G = mkquant(e, substinform[mkcomb(f,e),e] F) 14 | and ax = SYM(SPEC f (SPEC e (AXIOM`LESYN` `expax2`))) 15 | and PROCF = PROC e F 16 | in 17 | SUBST [SPEC e (AXIOM`LESYN` `expax1`) , e] F 18 | (SPEC e (INDUCT ["expfun", f] G (baseth,stepth))) 19 | where baseth = GEN e (SUBST [SYM(MINAP"UU↑e:NEXP") , e] F uuth) 20 | and stepth = GEN e 21 | let ASSG = ASSUME G in CASES isncon 22 | (PROCF nconth ["destncon↑e", n] (eqtt isncon) ax, 23 | casef, 24 | PROCF uuth [] (equu isncon) ax 25 | where casef = 26 | let ax = SIMPCOND(eqff isncon)ax in CASES isiden 27 | (PROCF identh ["destiden↑e", i] (eqtt isiden) ax, 28 | casef, 29 | PROCF uuth [] (equu isiden) ax 30 | where casef = 31 | let ax = SIMPCOND(eqff isiden)ax in CASES iscnexp 32 | (caset, 33 | PROCF uuth [] (eqff iscnexp) ax, 34 | PROCF uuth [] (equu iscnexp) ax 35 | where caset = 36 | let ce = "destcnexp↑e" in 37 | let d1,d2 = "FST(SND↑ce)", "SND(SND↑ce)" in 38 | SUBST [SIMPCOND(eqtt iscnexp)ax , e] F 39 | (MP(MP (INST ["FST↑ce",nop ; "↑f↑d1",e1 ; "↑f↑d2",e2] cnexpth) 40 | (SPEC d1 ASSG))(SPEC d2 ASSG)) 41 | ))) 42 | ;; 43 | -------------------------------------------------------------------------------- /src/lesyn.tac: -------------------------------------------------------------------------------- 1 | 2 | let vary wl v = variant (v, formlfrees wl) ;; 3 | 4 | 5 | let NEXPINDUCTAC e (F,ss,Fl) = 6 | (( [ w "UU:NEXP" , ss , Fl ; w "mkncon↑n" , ss , Fl ; 7 | w "mkiden↑i" , ss , Fl ; 8 | w "mkcnexp(↑nop,↑e1,↑e2)" , ss , w1.w2.Fl ] , 9 | \[th1;th2;th3;th4] . NEXPINDUCT(n,i,nop,e1,e2)e F 10 | [th1;th2;th3;DISCH w1 (DISCH w2 th4)] 11 | ) where w1,w2 = w e1, w e2 ) 12 | where w t = substinform[t,e] F 13 | and [n;i;nop;e1;e2] = map(vary(F.Fl)) 14 | [ "n:NCON" ; "i:IDEN" ; "nop:NOP" ; "e1:NEXP";"e2:NEXP"] ;; 15 | 16 | 17 | 18 | let CONTRTAC g = 19 | (let w1,w2 = destimp(fst g) in 20 | let th = CONTR w2 (ASSUME w1) in [], K(DISCH w1 th) 21 | ) ? 22 | ( [g], hd) ;; 23 | 24 | let ADDSIMPTAC swl (w,ss,wl) = 25 | SIMPTAC(w, itlist f swl ss, wl) where f sw = ssadd(ASSUME sw) ;; 26 | 27 | let ANTETAC(w,ss,wl) = 28 | (let w1,w2 = destimp w in 29 | [ w2, ssadd(ASSUME w1)ss, w1.wl] , DISCH w1 o hd 30 | ) ? 31 | ( [w,ss,wl] , hd ) ;; 32 | 33 | let CONDCASESTAC(fm,ss,fml) = 34 | let tm = findterminform p fm 35 | where p t = iscomb t & 36 | (let t1,t2 = destcomb t in isconst t1 & fst(destconst t1)=`COND` 37 | & freeinform[t2]fm ) 38 | in CASESTAC(snd(destcomb tm))(fm,ss,fml) ;; 39 | 40 | let STEPTAC g = (SIMPTAC THEN (CONDCASESTAC ORELSE IDTAC) THEN SIMPTAC 41 | THEN CONTRTAC THEN ANTETAC 42 | THEN ADDSIMPTAC[w1;w2])g where (),(),w1.w2.() = g ;; 43 | 44 | let SIMPANTETAC = SIMPTAC THEN ANTETAC THEN SIMPTAC ;; 45 | 46 | let NEXPINDUCTAC' e = NEXPINDUCTAC e THENL 47 | [SIMPANTETAC;SIMPANTETAC;SIMPANTETAC; STEPTAC] ;; 48 | 49 | -------------------------------------------------------------------------------- /src/lesyn1: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | newparent`LESYN` ;; 5 | 6 | newolinfix (`=`, ":IDEN # IDEN ->TR" ) ;; 7 | 8 | newconstant(`occne`, ":IDEN->NEXP->TR" ) ;; 9 | 10 | newconstant(`substne`, ":NEXP->IDEN->NEXP->NEXP") ;; 11 | 12 | map newaxiom[ 13 | `o1` , "occne i UU == UU" ; 14 | `o2` , "occne i (mkncon n) == FF" ; 15 | `o3` , "occne i (mkiden j) == i=j" ; 16 | `o4` , "occne i (mkcnexp(nop,e1,e2)) == occne i e1=>TT|occne i e2" ; 17 | `s1` , "substne d i UU == UU" ; 18 | `s2` , "substne d i (mkncon n) == mkncon n" ; 19 | `s3` , "substne d i (mkiden j) == (i=j)=>d|mkiden j" ; 20 | `s4` , "substne d i (mkcnexp(nop,e1,e2)) == 21 | mkcnexp(nop, substne d i e1, substne d i e2)" ; 22 | `e1` , "(i=i) == TT"] ;; 23 | -------------------------------------------------------------------------------- /src/lesyn1.dft: -------------------------------------------------------------------------------- 1 | 2 | newparent `LESYN` ;; 3 | 4 | newolinfix ( `=` , ":IDEN#IDEN->tr" ) ;; 5 | 6 | newconstant ( `occne` , ":IDEN->(NEXP->tr)" ) ;; 7 | 8 | newconstant ( `substne` , ":NEXP->(IDEN->(NEXP->NEXP))" ) ;; 9 | 10 | NEWAXIOMS();; 11 | 12 | o1 "!i:IDEN. occne i UU == UU:tr" 13 | 14 | o2 "!n:NCON. !i:IDEN. occne i(mkncon n) == FF" 15 | 16 | o3 "!j:IDEN. !i:IDEN. occne i(mkiden j) == i = j" 17 | 18 | o4 "!e2:NEXP. !e1:NEXP. !nop:NOP. !i:IDEN. occne i(mkcnexp(nop, (e1, e2))) == occne i e1=>TT|occne i e2" 19 | 20 | s1 "!i:IDEN. !d:NEXP. substne d i UU == UU:NEXP" 21 | 22 | s2 "!n:NCON. !i:IDEN. !d:NEXP. substne d i(mkncon n) == mkncon n" 23 | 24 | s3 "!j:IDEN. !i:IDEN. !d:NEXP. substne d i(mkiden j) == i = j=>d|mkiden j" 25 | 26 | s4 "!e2:NEXP. !e1:NEXP. !nop:NOP. !i:IDEN. !d:NEXP. substne d i(mkcnexp(nop, (e1, e2))) == mkcnexp(nop, (substn~ 27 | e d i e1, substne d i e2))" 28 | 29 | e1 "!i:IDEN. i = i == TT" 30 | -------------------------------------------------------------------------------- /src/lis: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP twoof 4 | (LAMBDA(L) 5 | (COND ((AND L (CDR L)) (CONS (CAR L) (CADR L))) 6 | ((ERR (QUOTE twoof))))) 7 | EXPR) 8 | 9 | (DEFPROP threeof 10 | (LAMBDA(L) 11 | (COND ((AND L (CDR L) (CDDR L)) 12 | (CONS (CAR L) (CONS (CADR L) (CADDR L)))) 13 | ((ERR (QUOTE threeof))))) 14 | EXPR) 15 | 16 | (DEFPROP flat 17 | (LAMBDA (LL) (APPLY (FUNCTION APPEND) LL)) 18 | EXPR) 19 | 20 | (DEFPROP map 21 | (LAMBDA (%%F L) (MAPCAR (FUNCTION (LAMBDA (X) (AP %%F X))) L)) 22 | EXPR) 23 | 24 | (DEFPROP exists 25 | (LAMBDA(P L) 26 | (PROG NIL 27 | K (COND ((NULL L) (RETURN NIL)) 28 | ((AP P (CAR L)) (RETURN T)) 29 | (T (SETQ L (CDR L)) (GO K))))) 30 | EXPR) 31 | 32 | (DEFPROP forall 33 | (LAMBDA(P L) 34 | (PROG NIL 35 | K (COND ((NULL L) (RETURN T)) 36 | ((AP P (CAR L)) (SETQ L (CDR L)) (GO K)) 37 | ((RETURN NIL))))) 38 | EXPR) 39 | 40 | (DEFPROP revitlist 41 | (LAMBDA(F L X) 42 | (PROG NIL 43 | K (COND ((NULL L) (RETURN X))) 44 | (SETQ X (AP (AP F (CAR L)) X)) 45 | (SETQ L (CDR L)) 46 | (GO K))) 47 | EXPR) 48 | 49 | (DEFPROP find 50 | (LAMBDA(P L) 51 | (PROG NIL 52 | K (COND ((NULL L) (ERR (QUOTE fail))) 53 | ((AP P (CAR L)) (RETURN (CAR L))) 54 | (T (SETQ L (CDR L)) (GO K))))) 55 | EXPR) 56 | 57 | (DEFPROP tryfind 58 | (LAMBDA(%%F %L) 59 | (PROG (B) 60 | K (COND ((NULL %L) (ERR (QUOTE fail)))) 61 | (SETQ B (ERRSET (AP %%F (CAR %L)))) 62 | (COND ((NOT (ATOM B)) (RETURN (CAR B))) 63 | (T (SETQ %L (CDR %L)) (GO K))))) 64 | EXPR) 65 | 66 | (DEFPROP filter 67 | (LAMBDA(P L) 68 | (PROG (R) 69 | K (COND ((NULL L) (RETURN (REVERSE R))) 70 | ((AP P (CAR L)) (SETQ R (CONS (CAR L) R)))) 71 | (SETQ L (CDR L)) 72 | (GO K))) 73 | EXPR) 74 | 75 | (DEFPROP mapfilter 76 | (LAMBDA(%%F %L) 77 | (PROG (B R) 78 | K (COND ((NULL %L) (RETURN (REVERSE R)))) 79 | (SETQ B (ERRSET (AP %%F (CAR %L)))) 80 | (COND ((NOT (ATOM B)) (SETQ R (CONS (CAR B) R)))) 81 | (SETQ %L (CDR %L)) 82 | (GO K))) 83 | EXPR) 84 | -------------------------------------------------------------------------------- /src/lis.lsp: -------------------------------------------------------------------------------- 1 | (DML' length 1 LENGTH ((%a list) /-> int)) 2 | (PUTPROP (QUOTE twoof) 1 (QUOTE NUMARGS)) 3 | (PUTPROP (QUOTE twoof) (MKTIDY (QUOTE ((%a list) /-> (%a # %a)))) (QUOTE MLTYPE)) 4 | (PUTPROP (QUOTE threeof) 1 (QUOTE NUMARGS)) 5 | (PUTPROP (QUOTE threeof) (MKTIDY (QUOTE ((%a list) /-> (%a # (%a # %a))))) (QUOTE MLTYPE)) 6 | (DML' rev 1 REVERSE ((%a list) /-> (%a list))) 7 | (DML' mem 2 MEMBER ((%a # (%a list)) /-> bool)) 8 | (PUTPROP (QUOTE flat) 1 (QUOTE NUMARGS)) 9 | (PUTPROP (QUOTE flat) (MKTIDY (QUOTE (((%a list) list) /-> (%a list)))) (QUOTE MLTYPE)) 10 | (PUTPROP (QUOTE map) 2 (QUOTE NUMARGS)) 11 | (PUTPROP (QUOTE map) (MKTIDY (QUOTE (((%a /-> %b) # (%a list)) /-> (%b list)))) (QUOTE MLTYPE)) 12 | (PUTPROP (QUOTE exists) 2 (QUOTE NUMARGS)) 13 | (PUTPROP (QUOTE exists) (MKTIDY (QUOTE (((%a /-> bool) # (%a list)) /-> bool))) (QUOTE MLTYPE)) 14 | (PUTPROP (QUOTE forall) 2 (QUOTE NUMARGS)) 15 | (PUTPROP (QUOTE forall) (MKTIDY (QUOTE (((%a /-> bool) # (%a list)) /-> bool))) (QUOTE MLTYPE)) 16 | (PUTPROP (QUOTE revitlist) 3 (QUOTE NUMARGS)) 17 | (PUTPROP (QUOTE revitlist) (MKTIDY (QUOTE (((%a /-> (%b /-> %b)) # ((%a list) # %b)) /-> %b))) (QUOTE MLTYPE)) 18 | (PUTPROP (QUOTE find) 2 (QUOTE NUMARGS)) 19 | (PUTPROP (QUOTE find) (MKTIDY (QUOTE (((%a /-> bool) # (%a list)) /-> %a))) (QUOTE MLTYPE)) 20 | (PUTPROP (QUOTE tryfind) 2 (QUOTE NUMARGS)) 21 | (PUTPROP (QUOTE tryfind) (MKTIDY (QUOTE (((%a /-> %b) # (%a list)) /-> %b))) (QUOTE MLTYPE)) 22 | (PUTPROP (QUOTE filter) 2 (QUOTE NUMARGS)) 23 | (PUTPROP (QUOTE filter) (MKTIDY (QUOTE (((%a /-> bool) # (%a list)) /-> (%a list)))) (QUOTE MLTYPE)) 24 | (PUTPROP (QUOTE mapfilter) 2 (QUOTE NUMARGS)) 25 | (PUTPROP (QUOTE mapfilter) (MKTIDY (QUOTE (((%a /-> %b) # (%a list)) /-> (%b list)))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/lis.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let mem x l = mem(x,l);; 5 | 6 | let map f l = map(f,l);; 7 | 8 | let exists p l = exists(p,l);; 9 | let forall p l = forall(p,l);; 10 | 11 | let genmem p x = exists(\y.p(x,y));; 12 | 13 | let itlist f l x = revitlist(f, rev l, x);; 14 | let revitlist f l x = revitlist(f,l,x);; 15 | 16 | let find p l = find(p,l);; 17 | let tryfind f l = tryfind(f,l);; 18 | let filter p l = filter(p,l);; 19 | let mapfilter f l = mapfilter(f,l);; 20 | 21 | let assoc x = find(eqfst x);; 22 | let revassoc x = find(eqsnd x);; 23 | 24 | let intersect(l1,l2) = filter (\x. mem x l2) l1 ;; 25 | let subtract(l1,l2) = filter (\x. not mem x l2) l1 ;; 26 | let union(l1,l2) = l1 @ subtract(l2,l1) ;; 27 | 28 | letrec split l = (let (x1,x2).l' = l in 29 | (x1.l1',x2.l2') where l1',l2' = split l' 30 | )? (nil,nil) ;; 31 | 32 | letrec combine(l1,l2) = (let (x1.l1'),(x2.l2') = l1,l2 in 33 | (x1,x2).combine(l1',l2') 34 | )?(null l1 & null l2 => nil|failwith`combine`);; 35 | -------------------------------------------------------------------------------- /src/lookup: -------------------------------------------------------------------------------- 1 | (DEFPROP LOOKUP 2 | (LAMBDA(MKX) 3 | (PROG (PT) 4 | (SETQ PT PRINTTABLE) 5 | LOOP (COND ((NULL PT) (SYSTEMERROR)) 6 | ((EQ MKX (CAAR PT)) (RETURN (CDAR PT))) 7 | (T (SETQ PT (CDR PT)) (GO LOOP))))) 8 | EXPR) 9 | -------------------------------------------------------------------------------- /src/lpsyn.a: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | newparent`LESYN` ;; 4 | 5 | 6 | newtypes[ 7 | "PROG = ASS + PROG1 " ; 8 | "PROG1 = SEQ + PROG2 " ; 9 | "PROG2 = COND + ITER " ; 10 | "ASS = IDEN # NEXP " ; 11 | "SEQ = PROGPR " ; 12 | "COND = TEXP # PROGPR" ; 13 | "PROGPR = PROG # PROG " ] ;; 14 | 15 | map newconstant (map f ``isass isseq iscond isiter``) 16 | where f x = x, ":PROG->TR" ;; 17 | 18 | let phyla = [ ":ASS" ; ":SEQ" ; ":COND" ; ":ITER" ] ;; 19 | 20 | letrec maptwo f l l' = 21 | null l => [] | f(hd l)(hd l') . maptwo f (tl l)(tl l') ;; 22 | 23 | map newconstant (maptwo f ``mkass mkseq mkcond mkiter`` phyla) 24 | where f x y = x,mkfuntype(y,":PROG") ;; 25 | 26 | map newconstant (maptwo f ``destass destseq destcond destiter``phyla) 27 | where f x y = x, ":PROG->↑y" ;; 28 | 29 | 30 | map newaxiom[ 31 | `isa` , "isass p == ISL p" ; 32 | `iss` , "isseq p == ISL p => FF | ISL(OUTR p)" ; 33 | `isc` , "iscond p == ISL p=>FF|ISL(OUTR p)=>FF|ISL(OUTR(OUTR p))"; 34 | `isi` , "isiter p == ISL p=>FF|ISL(OUTR p)=>FF|ISR(OUTR(OUTR p))"; 35 | `mka` , "mkass a == INL a" ; 36 | `mks` , "mkseq s == INR(INL s)" ; 37 | `mkc` , "mkcond c == INR(INR(INL c))" ; 38 | `mki` , "mkiter i == INR(INR(INR i))" ; 39 | `desta`, "destass p == OUTL p" ; 40 | `dests`, "destseq p == OUTL(OUTR p)" ; 41 | `destc`, "destcond p == OUTL(OUTR(OUTR p))" ; 42 | `desti`, "destiter p == OUTR(OUTR(OUTR p))" ] ;; 43 | newconstant( `progfun` , ":(PROG->PROG)->(PROG->PROG)" ) ;; 44 | 45 | newaxiom( `progax1` , "p == FIX progfun p" ) ;; 46 | 47 | newaxiom( `progax2` , "progfun g p == 48 | isass p => mkass(destass p) | 49 | isseq p => mkseq 50 | (g(FST(destseq p)) , g(SND(destseq p))) | 51 | iscond p=> mkcond 52 | (FST(destcond p),g(FST(SND(destcond p))),g(SND(SND(destcond p)))) | 53 | isiter p=> mkiter 54 | (FST(destiter p), g(SND(destiter p))) | 55 | UU " ) ;; 56 | -------------------------------------------------------------------------------- /src/lpsyn.ind: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let PROGINDUCT (a,te ,p1,p2) p F (uuth, assth,seqth,condth,iterth) = 5 | let isass,isseq,iscond,isiter = "isass↑p","isseq↑p", 6 | "iscond↑p","isiter↑p" 7 | and f = mkvar(gentok(), ":PROG->PROG") 8 | in 9 | let G = mkquant(p, substinform(mkcomb(f,p),p,F)) 10 | and ax = SYM(SPEC f (SPEC p (AXIOM `LPSYN` `progax2`))) 11 | and PROCF = PROC p F 12 | in 13 | SUBST p F (SPEC p (AXIOM `LPSYN` `progax1`)) 14 | (SPEC p (INDUCT "progfun" f G (baseth, stepth))) 15 | where baseth = GEN p (SUBST p F (SYM(MINAP"UU↑p:PROG")) uuth) 16 | and stepth = let ASSG = ASSUME G in CASES isass 17 | (PROCF assth [a,"destass↑p"] (eqtt isass) ax , 18 | casef, 19 | PROCF uuth [] (equu isass) ax 20 | where casef = let ax = SIMPCOND (eqff isass) ax in CASES isseq 21 | (caset,casef,PROCF uuth [] (equu isseq) ax 22 | where caset = 23 | (let s = "destseq↑p" in let q1,q2 = "FST↑s","SND↑s" in 24 | PROCF (MP(MP seqth (SPEC q1 ASSG))(SPEC q2 ASSG)) 25 | [ p1,"↑f↑q1" ; p2,"↑f↑q2" ] (eqtt isseq) ax 26 | ) 27 | and casef = let ax = SIMPCOND (eqff isseq) ax in CASES iscond 28 | (caset,casef,PROCF uuth [] (equu iscond) ax 29 | where caset = 30 | (let c = "destcond↑p" in let q1,q2 = "FST(SND↑c)","SND(SND↑c)" in 31 | PROCF (MP(MP condth (SPEC q1 ASSG)) (SPEC q2 ASSG)) 32 | [ te,"FST↑c" ; p1,"↑f↑q1" ; p2,"↑f↑q2" ] (eqtt iscond) ax 33 | ) 34 | and casef = let ax = SIMPCOND (eqff iscond) ax in CASES isiter 35 | (caset,PROCF uuth[](eqff isiter)ax, PROCF uuth[](equu isiter)ax 36 | where caset = 37 | (let i = "destiter↑p" in let q1 = "SND↑i" in 38 | PROCF (MP iterth (SPEC q1 ASSG)) 39 | [ te,"FST↑i" ; p1,"↑f↑q1" ] (eqtt isiter) ax 40 | ))))) ;; 41 | -------------------------------------------------------------------------------- /src/lspld: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00003 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 (DE ERROR (X) (PROG2 (PRINX CR LF) (SYSTEMERROR))) 5 | C00004 00003 % LSPLD : copied to separate file % 6 | C00006 ENDMK 7 | C⊗; 8 | (DE ERROR (X) (PROG2 (PRINX CR LF) (SYSTEMERROR))) 9 | (DE SPRINT (X Y) (PP X Y)) 10 | (SETQ %MLPRINDEPTH 3) 11 | (DE PROMPT (N) NIL) 12 | 13 | 14 | 15 | 16 | (DIN 17 | GP 18 | GPX 19 | SYMBS 20 | PTBLE 21 | LEAN 22 | LEANPROP 23 | OPP 24 | LCFO 25 | (LCFO.LSP) 26 | LCFM 27 | (LCFM.LSP) 28 | MLPRIN 29 | SHARE 30 | TYPEOL 31 | TYPEML 32 | (TYPEML.LSP) 33 | TRAN 34 | (TRAN.LSP) 35 | DML 36 | (DML.LSP) 37 | WRITML 38 | (WRITML.LSP) 39 | TML 40 | (TML.LSP) 41 | THYFNS 42 | (THYFNS.LSP) 43 | (THYFNS.ML) 44 | (GEN.ML) 45 | LIS 46 | (LIS.LSP) 47 | (LIS.ML) 48 | OL0 49 | (OL0.LSP) 50 | (PPLAMB.LSP) 51 | (PPLAMB.ML) 52 | OL1 53 | (OL1.LSP) 54 | OL2 55 | (OL2.LSP) 56 | (OL2.ML) 57 | OL3 58 | (OL3.LSP) 59 | (OL3.ML) 60 | (PCRUL.ML) 61 | (RUL.ML) 62 | SIMPL 63 | (SIMPL.LSP) 64 | (SIMPL.ML) 65 | (DRUL.ML) 66 | (TAC.ML) 67 | (TCL.ML) 68 | ) 69 | 70 | 71 | % LSPLD : copied to separate file % 72 | 73 | (DE ERROR (X) (PROG2 (PRINX CR LF) (SYSTEMERROR))) 74 | (DE SPRINT (X Y) (PP X Y)) 75 | (SETQ %MLPRINDEPTH 3) 76 | (DE PROMPT (N) NIL) 77 | 78 | 79 | 80 | 81 | (DIN 82 | GP 83 | GPX 84 | SYMBS 85 | PTBLE 86 | LEAN 87 | LEANPROP 88 | OPP 89 | LCFO 90 | (LCFO.LSP) 91 | LCFM 92 | (LCFM.LSP) 93 | MLPRIN 94 | SHARE 95 | TYPEOL 96 | TYPEML 97 | (TYPEML.LSP) 98 | TRAN 99 | (TRAN.LSP) 100 | DML 101 | (DML.LSP) 102 | WRITML 103 | (WRITML.LSP) 104 | TML 105 | (TML.LSP) 106 | THYFNS 107 | (THYFNS.LSP) 108 | (THYFNS.ML) 109 | (GEN.ML) 110 | LIS 111 | (LIS.LSP) 112 | (LIS.ML) 113 | OL0 114 | (OL0.LSP) 115 | (PPLAMB.LSP) 116 | (PPLAMB.ML) 117 | OL1 118 | (OL1.LSP) 119 | OL2 120 | (OL2.LSP) 121 | (OL2.ML) 122 | OL3 123 | (OL3.LSP) 124 | (OL3.ML) 125 | (PCRUL.ML) 126 | (RUL.ML) 127 | SIMPL 128 | (SIMPL.LSP) 129 | (SIMPL.ML) 130 | (DRUL.ML) 131 | (TAC.ML) 132 | (TCL.ML) 133 | ) 134 | 135 | 136 | -------------------------------------------------------------------------------- /src/lspld.mic: -------------------------------------------------------------------------------- 1 | 2 | .R LISP 72 3 | =Y 4 | =3000 5 | = 6 | =2000 7 | =2000 8 | = 9 | =Y 10 | = 11 | = 12 | = 13 | = 14 | =Y 15 | = 16 | 17 | *(INC(INPUT DSK: IOX)) 18 | *(SETQ PRFLAG NIL) 19 | *(DIN LSPLD) 20 | 21 | 22 | .save LSPLCF 23 | -------------------------------------------------------------------------------- /src/misc/dlist.fct: -------------------------------------------------------------------------------- 1 | 2 | STRHD "HD UU == UU:d" 3 | 4 | STRTL "TL UU == UU:dlist" 5 | 6 | HDCONS "!dl:dlist. !d:d. HD(CONS d dl) == d" 7 | 8 | TLCONS "!dl:dlist. !d:d. TL(CONS d dl) == dl" 9 | 10 | HDNIL "HD NIL == UU:d" 11 | 12 | TLNIL "TL NIL == UU:dlist" 13 | 14 | HDLIST "!d:d. HD(LIST d) == d" 15 | 16 | TLLIST "!d:d. TL(LIST d) == NIL" 17 | 18 | LISCNS "!d:d. LIST d == CONS d NIL" 19 | 20 | CNSNIL "!d:d. EQ(CONS d NIL)NIL == FF" 21 | 22 | ls1 "!Exp:(d->d)->((d#d->d)->(d->(d->(dlist->d)))). !F:d->d. !h:d#d->d. !G:d->(d->(dlist->d)). G == FIX(\G':d->~ 23 | (d->(dlist->d)).\x:d.\z:d.\s:dlist.EQ s NIL=>z|G'(HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & Exp == FIX(\Exp'~ 24 | :(d->d)->((d#d->d)->(d->(d->(dlist->d)))).\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)) :(d->d)->(~ 25 | (d#d->d)->(d->(d->(dlist->d)))) IMP G == Exp F h" 26 | 27 | ls2 "!F:d->d. !Exp:(d->d)->((d#d->d)->(d->(d->(dlist->d)))). !g2:d->d. !g1:d->d. !f:d->d. !h:d#d->d. !P:d->tr. ~ 28 | !F1:d->(d->(dlist->d)). F1 == FIX(\F1':d->(d->(dlist->d)).\x:d.\z:d.\s:dlist.EQ s NIL=>z|(P x=>F1'(HD s)(h(z, f ~ 29 | x))(TL s)|F1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) & Exp == FIX(\Exp':(d->d)->((d#d->d)->(d->(d->(dlist->d)~ 30 | ))).\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & F ==~ 31 | FIX(\F':d->d.\x.P x=>f x|h(F'(g1 x), F'(g2 x))) :d->d & (!a:d. !b:d. !c:d. h(h(a, b), c) == h(a, h(b, c))) IMP ~ 32 | F1 << Exp F h" 33 | 34 | ls5 "!g2:d->d. !g1:d->d. !f:d->d. !h:d#d->d. !P:d->tr. !F1:d->(d->(dlist->d)). F1 == FIX(\F1':d->(d->(dlist->d)~ 35 | ).\x:d.\z:d.\s:dlist.EQ s NIL=>z|(P x=>F1'(HD s)(h(z, f x))(TL s)|F1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) ~ 36 | & (!x. h(UU, x) == UU:d) IMP (!x. !s. F1 x UU s == UU:d)" 37 | 38 | ls3 "!F1:d->(d->(dlist->d)). !g2:d->d. !g1:d->d. !f:d->d. !P:d->tr. !F:d->d. !h:d#d->d. !G:d->(d->(dlist->d)). ~ 39 | G == FIX(\G':d->(d->(dlist->d)).\x:d.\z:d.\s:dlist.EQ s NIL=>z|G'(HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & ~ 40 | F == FIX(\F':d->d.\x.P x=>f x|h(F'(g1 x), F'(g2 x))) :d->d & (!x. h(x, UU) == UU:d) & F1 == FIX(\F1':d->(d->(dli~ 41 | st->d)).\x.\z.\s.EQ s NIL=>z|(P x=>F1'(HD s)(h(z, f x))(TL s)|F1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) & (!~ 42 | x. h(UU, x) == UU:d) & (!a:d. !b:d. !c:d. h(h(a, b), c) == h(a, h(b, c))) IMP G << F1" 43 | 44 | ls6 "!x:d. !F:d->d. !e:d. !h:d#d->d. !Exp:(d->d)->((d#d->d)->(d->(d->(dlist->d)))). Exp == FIX(\Exp':(d->d)->((~ 45 | d#d->d)->(d->(d->(dlist->d)))).\F.\h.\x.\z:d.\s:dlist.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)) :(d->d)->((d#~ 46 | d->d)->(d->(d->(dlist->d)))) & (!x. h(e, x) == x) IMP Exp F h x e(LIST dummy) == F x" 47 | 48 | ls4 "!F1:d->(d->(dlist->d)). !g2:d->d. !g1:d->d. !f:d->d. !P:d->tr. !Exp:(d->d)->((d#d->d)->(d->(d->(dlist->d))~ 49 | )). !F:d->d. !h:d#d->d. !G:d->(d->(dlist->d)). G == FIX(\G':d->(d->(dlist->d)).\x:d.\z:d.\s:dlist.EQ s NIL=>z|G'~ 50 | (HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & Exp == FIX(\Exp':(d->d)->((d#d->d)->(d->(d->(dlist->d)))).\F.\h.\~ 51 | x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & G == FIX(\G'.\x~ 52 | .\z.\s.EQ s NIL=>z|G'(HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & F == FIX(\F':d->d.\x.P x=>f x|h(F'(g1 x), F'~ 53 | (g2 x))) :d->d & (!x. h(x, UU) == UU:d) & F1 == FIX(\F1':d->(d->(dlist->d)).\x.\z.\s.EQ s NIL=>z|(P x=>F1'(HD s)~ 54 | (h(z, f x))(TL s)|F1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) & (!x. h(UU, x) == UU:d) & (!a:d. !b:d. !c:d. h(~ 55 | h(a, b), c) == h(a, h(b, c))) & F1 == FIX(\F1'.\x.\z.\s.EQ s NIL=>z|(P x=>F1'(HD s)(h(z, f x))(TL s)|F1'(g1 x)z(~ 56 | CONS(g2 x)s))) :d->(d->(dlist->d)) & Exp == FIX(\Exp'.\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)~ 57 | ) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & F == FIX(\F'.\x.P x=>f x|h(F'(g1 x), F'(g2 x))) :d->d & (!a. !b. !~ 58 | c. h(h(a, b), c) == h(a, h(b, c))) IMP F1 == Exp F h" 59 | 60 | ls7 "!x:d. !e:d. !F1:d->(d->(dlist->d)). !g2:d->d. !g1:d->d. !f:d->d. !P:d->tr. !Exp:(d->d)->((d#d->d)->(d->(d-~ 61 | >(dlist->d)))). !F:d->d. !h:d#d->d. !G:d->(d->(dlist->d)). G == FIX(\G':d->(d->(dlist->d)).\x.\z:d.\s:dlist.EQ s~ 62 | NIL=>z|G'(HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & Exp == FIX(\Exp':(d->d)->((d#d->d)->(d->(d->(dlist->d))~ 63 | )).\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F x))(TL s)) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & G == ~ 64 | FIX(\G'.\x.\z.\s.EQ s NIL=>z|G'(HD s)(h(z, F x))(TL s)) :d->(d->(dlist->d)) & F == FIX(\F':d->d.\x.P x=>f x|h(F'~ 65 | (g1 x), F'(g2 x))) :d->d & (!x. h(x, UU) == UU:d) & F1 == FIX(\F1':d->(d->(dlist->d)).\x.\z.\s.EQ s NIL=>z|(P x=~ 66 | >F1'(HD s)(h(z, f x))(TL s)|F1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) & (!x. h(UU, x) == UU:d) & (!a:d. !b:d~ 67 | . !c:d. h(h(a, b), c) == h(a, h(b, c))) & F1 == FIX(\F1'.\x.\z.\s.EQ s NIL=>z|(P x=>F1'(HD s)(h(z, f x))(TL s)|F~ 68 | 1'(g1 x)z(CONS(g2 x)s))) :d->(d->(dlist->d)) & Exp == FIX(\Exp'.\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F~ 69 | x))(TL s)) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & F == FIX(\F'.\x.P x=>f x|h(F'(g1 x), F'(g2 x))) :d->d & ~ 70 | (!a. !b. !c. h(h(a, b), c) == h(a, h(b, c))) & Exp == FIX(\Exp'.\F.\h.\x.\z.\s.EQ s NIL=>z|Exp' F h(HD s)(h(z, F~ 71 | x))(TL s)) :(d->d)->((d#d->d)->(d->(d->(dlist->d)))) & (!x. h(e, x) == x) IMP F1 x e(LIST dummy) == F x" 72 | -------------------------------------------------------------------------------- /src/misc/equt.fct: -------------------------------------------------------------------------------- 1 | α~∃ ∃ b@@λCrtT8@Cpt(\A "↓pAr@tzA)(↓∪≠ A∃"ArAd@zzAQ(D~∀4∃ _d@@D¬rtT\CptT8A "A`Ar@ztA A%≠ A DArArzzA)PD~∀ -------------------------------------------------------------------------------- /src/misc/equt.fct.~1~: -------------------------------------------------------------------------------- 1 | 2 | FDEF1 "!y:*. !x:*. EQ x y == TT IMP EQ y y == TT" 3 | 4 | FDEF2 "!y:*. !x:*. EQ x y == FF IMP EQ y y == TT" 5 | -------------------------------------------------------------------------------- /src/misc/equt.thy: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | THEORY EQUT 8 | 9 | 10 | newparent `PROPT` ;; 11 | 12 | newconstant ( `EQ` , ":*->(*->tr)" ) ;; 13 | 14 | NEWAXIOMS();; 15 | 16 | AXSTR1 "!x:*. EQ x (UU:*) == UU:tr" 17 | 18 | AXSTR2 "!y:*. !x:*. EQ x y == UU:tr & (x == UU:* IMP TT == FF) IMP y == UU:*" 19 | 20 | AXREFL "!x:*. (x == UU:* IMP TT == FF) IMP EQ x x == TT" 21 | 22 | AXEQ1 "!y:*. !x:*. EQ x y == TT IMP x == y" 23 | 24 | AXEQ2 "!y:*. !x:*. EQ x y == FF & x == y IMP TT == FF" 25 | 26 | AXEQ3 "!y:*. !x:*. EQ x x == TT & EQ y y == TT & x == y IMP EQ x y == TT" 27 | 28 | AXEQ4 "!y:*. !x:*. EQ x x == TT & EQ y y == TT & (x == y IMP TT == FF) IMP EQ x y == FF" 29 | 30 | AXCOMT "!y:*. !x:*. EQ x y == EQ y x :tr" 31 | 32 | AXFLAT "!y:*. !x:*. EQ x y == FF & x << y IMP TT == FF" 33 | -------------------------------------------------------------------------------- /src/misc/equt.thy.~1~: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | THEORY EQUT 8 | 9 | 10 | newparent `PROPT` ;; 11 | 12 | newconstant ( `EQ` , ":*->(*->tr)" ) ;; 13 | 14 | NEWAXIOMS();; 15 | 16 | AXSTR1 "!x:*. EQ x (UU:*) == UU:tr" 17 | 18 | AXSTR2 "!y:*. !x:*. EQ x y == UU:tr & (x == UU:* IMP TT == FF) IMP y == UU:*" 19 | 20 | AXREFL "!x:*. (x == UU:* IMP TT == FF) IMP EQ x x == TT" 21 | 22 | AXEQ1 "!y:*. !x:*. EQ x y == TT IMP x == y" 23 | 24 | AXEQ2 "!y:*. !x:*. EQ x y == FF & x == y IMP TT == FF" 25 | 26 | AXEQ3 "!y:*. !x:*. EQ x x == TT & EQ y y == TT & x == y IMP EQ x y == TT" 27 | 28 | AXEQ4 "!y:*. !x:*. EQ x x == TT & EQ y y == TT & (x == y IMP TT == FF) IMP EQ x y == FF" 29 | 30 | AXCOMT "!y:*. !x:*. EQ x y == EQ y x :tr" 31 | 32 | AXFLAT "!y:*. !x:*. EQ x y == FF & x << y IMP TT == FF" 33 | -------------------------------------------------------------------------------- /src/misc/fixt.fct: -------------------------------------------------------------------------------- 1 | 2 | Fdist "!fun1:(*->**)->(*->**). !fun2:(***->****)->(***->****). FIX(\f':(*->**)#(***->****).fun1(FST f'), fun2(S~ 3 | ND f')) == FIX fun1 :*->**, FIX fun2 :***->****" 4 | 5 | Flfp "!F:*->*. !x:*. F x == x IMP FIX F << x" 6 | 7 | Fpthm1 "!t:*. !u:**. !t':*. !u':**. t, u == t', u' IMP t == t' & u == u'" 8 | 9 | Fbasic "!F:(*->**)->(*->**). !f:*->**. f == FIX F :*->** IMP F f == f" 10 | 11 | Fdist1 "!fun1:*->*. !fun2:**->**. FIX(\f':*#**.fun1(FST f'), fun2(SND f')) == FIX fun1 :*, FIX fun2 :**" 12 | -------------------------------------------------------------------------------- /src/misc/fixt.thy: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | THEORY FIXT 8 | 9 | -------------------------------------------------------------------------------- /src/misc/lesyn.fct: -------------------------------------------------------------------------------- 1 | 2 | inn "!n:NCON. isncon(mkncon n) == TT" 3 | 4 | ini "!i:IDEN. isncon(mkiden i) == FF" 5 | 6 | inc "!c:CNEXP. isncon(mkcnexp c) == FF" 7 | 8 | iin "!n:NCON. isiden(mkncon n) == FF" 9 | 10 | iii "!i:IDEN. isiden(mkiden i) == TT" 11 | 12 | iic "!c:CNEXP. isiden(mkcnexp c) == FF" 13 | 14 | icn "!n:NCON. iscnexp(mkncon n) == FF" 15 | 16 | ici "!i:IDEN. iscnexp(mkiden i) == FF" 17 | 18 | icc "!c:CNEXP. iscnexp(mkcnexp c) == TT" 19 | 20 | dnn "!n:NCON. destncon(mkncon n) == n" 21 | 22 | dii "!i:IDEN. destiden(mkiden i) == i" 23 | 24 | dcc "!c:CNEXP. destcnexp(mkcnexp c) == c" 25 | -------------------------------------------------------------------------------- /src/misc/lesyn.thy: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | THEORY LESYN 8 | 9 | 10 | newtypes [ ``NEXP = NCON + NEXP'`` ; 11 | ``NEXP' = IDEN + CNEXP`` ; 12 | ``CNEXP = NOP # NEXPPR`` ; 13 | ``NEXPPR = NEXP # NEXP`` ] ;; 14 | 15 | newtypes [ ``TEXP = TCON + CTEXP`` ; 16 | ``CTEXP = TOP # NEXPPR`` ] ;; 17 | 18 | newconstant ( `isncon` , ":NEXP->tr" ) ;; 19 | 20 | newconstant ( `isiden` , ":NEXP->tr" ) ;; 21 | 22 | newconstant ( `iscnexp` , ":NEXP->tr" ) ;; 23 | 24 | newconstant ( `mkncon` , ":NCON->NEXP" ) ;; 25 | 26 | newconstant ( `mkiden` , ":IDEN->NEXP" ) ;; 27 | 28 | newconstant ( `mkcnexp` , ":CNEXP->NEXP" ) ;; 29 | 30 | newconstant ( `destncon` , ":NEXP->NCON" ) ;; 31 | 32 | newconstant ( `destiden` , ":NEXP->IDEN" ) ;; 33 | 34 | newconstant ( `destcnexp` , ":NEXP->CNEXP" ) ;; 35 | 36 | newconstant ( `expfun` , ":(NEXP->NEXP)->(NEXP->NEXP)" ) ;; 37 | 38 | NEWAXIOMS();; 39 | 40 | isn "!e:NEXP. isncon e == ISL e :tr" 41 | 42 | isi "!e:NEXP. isiden e == ISL e=>FF|ISL(OUTR e :NEXP') :tr" 43 | 44 | isc "!e:NEXP. iscnexp e == ISL e=>FF|ISR(OUTR e :NEXP') :tr" 45 | 46 | mkn "!n:NCON. mkncon n == INL n :NEXP" 47 | 48 | mki "!i:IDEN. mkiden i == INR(INL i :NEXP') :NEXP" 49 | 50 | mkc "!c:CNEXP. mkcnexp c == INR(INR c :NEXP') :NEXP" 51 | 52 | destn "!e:NEXP. destncon e == OUTL e :NCON" 53 | 54 | desti "!e:NEXP. destiden e == OUTL(OUTR e :NEXP') :IDEN" 55 | 56 | destc "!e:NEXP. destcnexp e == OUTR(OUTR e :NEXP') :CNEXP" 57 | 58 | expax1 "!e:NEXP. FIX expfun e == e" 59 | 60 | expax2 "!e:NEXP. !f:NEXP->NEXP. expfun f e == isncon e=>mkncon(destncon e)|(isiden e=>mkiden(destiden e)|(iscne~ 61 | xp e=>mkcnexp(FST(destcnexp e), (f(FST(SND(destcnexp e) :NEXPPR)), f(SND(SND(destcnexp e) :NEXPPR))))|UU:NEXP))" 62 | -------------------------------------------------------------------------------- /src/misc/lesyn1.fct: -------------------------------------------------------------------------------- 1 | 2 | sub1 "!d:NEXP. !e:NEXP. !i:IDEN. occne i e == FF IMP substne d i e == e" 3 | 4 | sub2 "!i':IDEN. !d':NEXP. !d:NEXP. !e:NEXP. !i:IDEN. occne i e == FF IMP substne d i(substne d' i' e) == substn~ 5 | e(substne d i d')i' e" 6 | 7 | rather boring theorem "!i:IDEN. !e:NEXP. !d:NEXP. occne i e == FF IMP substne d i e == e" 8 | -------------------------------------------------------------------------------- /src/misc/parent.xtr: -------------------------------------------------------------------------------- 1 | 2 | newparent `LESYN` ;; 3 | -------------------------------------------------------------------------------- /src/misc/propt.fct: -------------------------------------------------------------------------------- 1 | 2 | AXMPP "!q:tr. !p:tr. ORP(NOTP p)q == TT & p == TT IMP q == TT" 3 | 4 | FNOTP1 "!p:tr. p == TT IMP NOTP p == FF" 5 | 6 | FNOTP2 "!p:tr. p == FF IMP NOTP p == TT" 7 | 8 | FNOTP3 "!p:tr. NOTP(NOTP p) == p" 9 | 10 | AXMPP1 "!q:tr. !p:tr. ORP p q == TT & p == FF IMP q == TT" 11 | 12 | FCONT1 "TT == UU:tr IMP TT == FF" 13 | 14 | FCONT2 "FF == UU:tr IMP TT == FF" 15 | -------------------------------------------------------------------------------- /src/misc/propt.thy: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | THEORY PROPT 8 | 9 | 10 | newconstant ( `NOTP` , ":tr->tr" ) ;; 11 | 12 | newconstant ( `ORP` , ":tr->(tr->tr)" ) ;; 13 | 14 | NEWAXIOMS();; 15 | 16 | AXNOTP "NOTP == \p:tr.p=>FF|TT" 17 | 18 | AXORP "ORP == \p:tr.\q:tr.p=>(q=>TT|TT)|q" 19 | -------------------------------------------------------------------------------- /src/mlprin: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP PP 4 | (LAMBDA(%EX %PPDEPTH) 5 | (COND ((ATOM %EX) (PRINC %EX)) 6 | (T (PPRINT %EX (LOOKUP (CAR %EX)) %PPDEPTH)))) 7 | EXPR) 8 | 9 | (DEFPROP PPRINT 10 | (LAMBDA(%EX F %PPDEPTH) 11 | (PROG (X) 12 | (COND ((ZEROP %PPDEPTH) (RETURN (PRINC PPSYM)))) 13 | LOOP (COND ((NULL F) (RETURN NIL))) 14 | (SETQ X (CAR F)) 15 | (COND ((NUMBERP X) (PP (GETNTH X (CDR %EX)) (SUB1 %PPDEPTH))) 16 | ((ATOM X) (PRINC X)) 17 | (T 18 | ((LAMBDA (%PP %PPL) (EVAL X)) 19 | (FUNCTION (LAMBDA (EX) (PP EX %PPDEPTH))) 20 | (FUNCTION 21 | (LAMBDA(L OPEN SEP CLOSE) 22 | (PPL L %PPDEPTH OPEN SEP CLOSE)))))) 23 | (SETQ F (CDR F)) 24 | (GO LOOP))) 25 | EXPR) 26 | 27 | (DEFPROP PPL 28 | (LAMBDA(L %PPDEPTH OPEN SEP CLOSE) 29 | (PROG (XL) 30 | (SETQ XL L) 31 | (PRINC OPEN) 32 | (COND ((NULL XL) (GO END))) 33 | LOOP (PP (CAR XL) %PPDEPTH) 34 | (SETQ XL (CDR XL)) 35 | (COND ((NULL XL) (GO END)) (T (PRINC SEP) (GO LOOP))) 36 | END (PRINC CLOSE))) 37 | EXPR) 38 | 39 | (DEFPROP LOOKUP 40 | 41 | (LAMBDA(MKX) 42 | (PROG (PT) 43 | (SETQ PT PRINTTABLE) 44 | LOOP (COND ((NULL PT) (SYSTEMERROR)) 45 | ((EQ MKX (CAAR PT)) (RETURN (CDAR PT))) 46 | (T (SETQ PT (CDR PT)) (GO LOOP))))) 47 | EXPR) 48 | 49 | (DEFPROP GETNTH 50 | (LAMBDA(N L) 51 | (COND ((OR (ZEROP N) (NULL L)) (SYSTEMERROR)) 52 | ((EQ N 1) (CAR L)) 53 | (T (GETNTH (SUB1 N) (CDR L))))) 54 | EXPR) 55 | 56 | (DEFPROP TESTTRAPFN 57 | (LAMBDA(ISTEST F) 58 | (PROG (XL X) 59 | (SETQ XL (CAR F)) 60 | L1 (COND 61 | ((NULL XL) 62 | (COND ((NULL (CDR F)) (RETURN NIL)) 63 | (T (SETQ X (CADR F)) (GO L2))))) 64 | (SETQ X (CAR XL)) 65 | (PRINC 66 | (COND (ISTEST (QUOTE "if ")) 67 | (T 68 | (COND ((EQ (CAR X) (QUOTE ONCE)) TP3SYM) 69 | (T TP4SYM))))) 70 | (PP (CADR X) %PPDEPTH) 71 | (COND (ISTEST 72 | (PRINC 73 | (COND ((EQ (CAR X) (QUOTE ONCE)) (QUOTE " then ")) 74 | (T (QUOTE " loop "))))) 75 | (T (PRINC (QUOTE / )))) 76 | (PP (CDDR X) %PPDEPTH) 77 | (SETQ XL (CDR XL)) 78 | (GO L1) 79 | L2 (COND (ISTEST 80 | (PRINC 81 | (COND ((EQ (CAR X) (QUOTE ONCE)) (QUOTE " else ")) 82 | (T (QUOTE " loop "))))) 83 | (T 84 | (COND ((ATOM (CAR X)) 85 | (PRINC 86 | (COND ((EQ (CAR X) (QUOTE ONCE)) TP1SYM) 87 | (T TP2SYM)))) 88 | (T (PRINC 89 | (COND ((EQ (CAAR X) (QUOTE ONCE)) TP5SYM) 90 | (T TP6SYM))) 91 | (PRINC (CDAR X)) 92 | (PRINC (QUOTE / )))))) 93 | (PP (CDR X) %PPDEPTH))) 94 | EXPR) 95 | -------------------------------------------------------------------------------- /src/ol0: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP NEWBVL 4 | (LAMBDA(OB) 5 | (SELECTQ (CAR OB) 6 | (mk=tok 7 | (COND ((CONSTP (CADR OB)) (CONS (CADR OB) %BVL)) (%BVL))) 8 | (mk=typed (NEWBVL (CADR OB))) 9 | %BVL)) 10 | EXPR) 11 | 12 | (DEFPROP mk=quant 13 | (LAMBDA(tw) 14 | ((LAMBDA (%BVL) (mkquant (EVAL (CAR tw)) (EVAL (CADR tw)))) 15 | (NEWBVL (CAR tw)))) 16 | FEXPR) 17 | 18 | (DEFPROP mkquant 19 | (LAMBDA(t w) 20 | (COND ((EQ (CAR t) (QUOTE var)) 21 | (SELECTQ (CAR w) (truth w) (TRIPLE (QUOTE quant) t w))) 22 | ((ERR (QUOTE mkquant))))) 23 | EXPR) 24 | 25 | (DEFPROP mk=imp 26 | (LAMBDA(w1 w2) 27 | (SELECTQ (CAR w1) 28 | (truth w2) 29 | (SELECTQ (CAR w2) 30 | (truth w2) 31 | (imp 32 | (TRIPLE (QUOTE imp) 33 | (mk=conj w1 (CADR w2)) 34 | (CDDR w2))) 35 | (TRIPLE (QUOTE imp) w1 w2)))) 36 | EXPR) 37 | 38 | (DEFPROP mk=conj 39 | (LAMBDA(w1 w2) 40 | (SELECTQ (CAR w2) 41 | (truth w1) 42 | (SELECTQ (CAR w1) 43 | (truth w2) 44 | (conj 45 | (TRIPLE (QUOTE conj) 46 | (CADR w1) 47 | (mk=conj (CDDR w1) w2))) 48 | (TRIPLE (QUOTE conj) w1 w2)))) 49 | EXPR) 50 | 51 | (DEFPROP mk=equiv 52 | (LAMBDA(t1 t2) 53 | (COND ((UNIFY (CDDR t1) (CDDR t2)) (TRIPLE (QUOTE equiv) t1 t2)) 54 | ((ERR (QUOTE mkequiv))))) 55 | EXPR) 56 | 57 | (DEFPROP mkequiv 58 | (LAMBDA(t1 t2) 59 | (COND ((EQ (CDDR t1) (CDDR t2)) (TRIPLE (QUOTE equiv) t1 t2)) 60 | ((ERR (QUOTE mkequiv))))) 61 | EXPR) 62 | 63 | (DEFPROP mk=inequiv 64 | (LAMBDA(t1 t2) 65 | (COND ((UNIFY (CDDR t1) (CDDR t2)) (TRIPLE (QUOTE inequiv) t1 t2)) 66 | ((ERR (QUOTE mkinequiv))))) 67 | EXPR) 68 | 69 | (DEFPROP mkinequiv 70 | (LAMBDA(t1 t2) 71 | (COND ((EQ (CDDR t1) (CDDR t2)) (TRIPLE (QUOTE inequiv) t1 t2)) 72 | ((ERR (QUOTE mkinequiv))))) 73 | EXPR) 74 | 75 | (DEFPROP mk=truth 76 | (LAMBDA NIL (QUOTE (truth))) 77 | EXPR) 78 | 79 | (DEFPROP destquant 80 | (LAMBDA (w) (STRIP (QUOTE quant) w)) 81 | EXPR) 82 | 83 | (DEFPROP destimp 84 | (LAMBDA (w) (STRIP (QUOTE imp) w)) 85 | EXPR) 86 | 87 | (DEFPROP destconj 88 | (LAMBDA (w) (STRIP (QUOTE conj) w)) 89 | EXPR) 90 | 91 | (DEFPROP destequiv 92 | (LAMBDA (w) (STRIP (QUOTE equiv) w)) 93 | EXPR) 94 | 95 | (DEFPROP destinequiv 96 | (LAMBDA (w) (STRIP (QUOTE inequiv) w)) 97 | EXPR) 98 | 99 | (DEFPROP desttruth 100 | (LAMBDA (w) (STRIP (QUOTE truth) w)) 101 | EXPR) 102 | 103 | (DEFPROP mk=abs 104 | (LAMBDA(vt) 105 | ((LAMBDA(%BVL) 106 | ((LAMBDA(v t) 107 | (SELECTQ 108 | (CAR v) 109 | (var 110 | (TRIPLE (QUOTE abs) 111 | (CONS v t) 112 | (TRIPLE (QUOTE funtype) (CDDR v) (CDDR t)))) 113 | (ERR (QUOTE mkabs)))) 114 | (EVAL (CAR vt)) 115 | (EVAL (CADR vt)))) 116 | (NEWBVL (CAR vt)))) 117 | FEXPR) 118 | 119 | (DEFPROP mkabs 120 | (LAMBDA(v t) 121 | (SELECTQ (CAR v) 122 | (var 123 | (TRIPLE (QUOTE abs) 124 | (CONS v t) 125 | (mk=funtype (CDDR v) (CDDR t)))) 126 | (ERR (QUOTE mkabs)))) 127 | EXPR) 128 | 129 | (DEFPROP mk=comb 130 | (LAMBDA(t1 t2) 131 | (TRIPLE 132 | (QUOTE comb) 133 | (CONS t1 t2) 134 | ((LAMBDA(TY) 135 | (COND ((UNIFY (CDDR t1) (TRIPLE (QUOTE funtype) (CDDR t2) TY)) 136 | TY) 137 | ((ERR (QUOTE mkcomb))))) 138 | (GENLINK)))) 139 | EXPR) 140 | 141 | (DEFPROP mkcomb 142 | (LAMBDA(%t1 %t2) 143 | (TRIPLE (QUOTE comb) 144 | (CONS %t1 %t2) 145 | ((LAMBDA(X) 146 | (COND ((ATOM X) (ERR (QUOTE mkcomb))) 147 | ((EQ (CAAR X) (CDDR %t2)) (CDAR X)) 148 | ((ERR (QUOTE mkcomb))))) 149 | (ERRSET (destfuntype (CDDR %t1)))))) 150 | EXPR) 151 | 152 | (DEFPROP mk=tok 153 | (LAMBDA(OB) 154 | ((LAMBDA(tok) 155 | (COND 156 | ((OR (MEMQ tok %BVL) (NOT (CONSTP tok))) 157 | (TRIPLE 158 | (QUOTE var) 159 | tok 160 | (COND 161 | ((GET tok (QUOTE STICKYTYPE))) 162 | ((ASSOC1 tok %VTYL)) 163 | ((CDAR (SETQ %VTYL (CONS (CONS tok (GENLINK)) %VTYL))))))) 164 | ((MUTCONST tok)))) 165 | (CAR OB))) 166 | FEXPR) 167 | 168 | (DEFPROP mkvar 169 | (LAMBDA(tok ty) 170 | (COND ((CONSTP tok) (ERR (QUOTE mkvar))) ((mkrealvar tok ty)))) 171 | EXPR) 172 | 173 | (DEFPROP mkrealvar 174 | (LAMBDA(tok ty) 175 | (COND ((ASSOC1 ty (GET tok (QUOTE mkvar)))) 176 | ((CDR 177 | (ADDPROP tok 178 | (CONS ty (TRIPLE (QUOTE var) tok ty)) 179 | (QUOTE mkvar)))))) 180 | EXPR) 181 | 182 | (DEFPROP mkconst 183 | (LAMBDA(tok ty) 184 | (COND ((ASSOC1 ty (GET tok (QUOTE mkconst)))) 185 | ((AND (CONSTP tok) (UNIFY ty (OMUTANT (CONSTP tok)))) 186 | (CDR 187 | (ADDPROP tok 188 | (CONS ty (TRIPLE (QUOTE const) tok ty)) 189 | (QUOTE mkconst)))) 190 | ((ERR (QUOTE mkconst))))) 191 | EXPR) 192 | 193 | (DEFPROP destabs 194 | (LAMBDA (t) (CAR (STRIP (QUOTE abs) t))) 195 | EXPR) 196 | 197 | (DEFPROP destcomb 198 | (LAMBDA (t) (CAR (STRIP (QUOTE comb) t))) 199 | EXPR) 200 | 201 | (DEFPROP destvar 202 | (LAMBDA (t) (STRIP (QUOTE var) t)) 203 | EXPR) 204 | 205 | (DEFPROP destconst 206 | (LAMBDA (t) (STRIP (QUOTE const) t)) 207 | EXPR) 208 | 209 | (DEFPROP typeof 210 | (LAMBDA (t) (CDDR t)) 211 | EXPR) 212 | 213 | (DEFPROP mk=sumtype 214 | (LAMBDA (ty1 ty2) (mktype (QUOTE sumtype) ty1 ty2)) 215 | EXPR) 216 | 217 | (DEFPROP mk=prodtype 218 | (LAMBDA (ty1 ty2) (mktype (QUOTE prodtype) ty1 ty2)) 219 | EXPR) 220 | 221 | (DEFPROP mk=funtype 222 | (LAMBDA (ty1 ty2) (mktype (QUOTE funtype) ty1 ty2)) 223 | EXPR) 224 | 225 | (DEFPROP mkconsttype 226 | (LAMBDA (tok) (COND ((TYCONSTP tok)) ((ERR (QUOTE mkconsttype))))) 227 | EXPR) 228 | 229 | (DEFPROP mk=consttype 230 | (LAMBDA (OB) (mkconsttype (CAR OB))) 231 | FEXPR) 232 | 233 | (DEFPROP mk=nulltype 234 | (LAMBDA (OB) (mkconsttype (QUOTE /.))) 235 | FEXPR) 236 | 237 | (DEFPROP mkvartype 238 | (LAMBDA(tok) 239 | (COND ((GET tok (QUOTE mkvartype))) 240 | ((EQ (CAR (EXPLODE tok)) (QUOTE *)) 241 | (PUTPROP tok (CONS (QUOTE vartype) tok) (QUOTE mkvartype))) 242 | ((ERR (QUOTE mkvartype))))) 243 | EXPR) 244 | 245 | (DEFPROP mk=vartype 246 | (LAMBDA (OB) (mkvartype (CAR OB))) 247 | FEXPR) 248 | 249 | (DEFPROP destsumtype 250 | (LAMBDA (ty) (desttype (QUOTE sumtype) ty)) 251 | EXPR) 252 | 253 | (DEFPROP destprodtype 254 | (LAMBDA (ty) (desttype (QUOTE prodtype) ty)) 255 | EXPR) 256 | 257 | (DEFPROP destfuntype 258 | (LAMBDA (ty) (desttype (QUOTE funtype) ty)) 259 | EXPR) 260 | 261 | (DEFPROP destconsttype 262 | (LAMBDA(ty) 263 | (SELECTQ (CAR ty) (consttype (CDR ty)) (ERR (QUOTE destconsttype)))) 264 | EXPR) 265 | 266 | (DEFPROP destvartype 267 | (LAMBDA(ty) 268 | (SELECTQ (CAR ty) (vartype (CDR ty)) (ERR (QUOTE destvartype)))) 269 | EXPR) 270 | 271 | (DEFPROP mkthm 272 | (LAMBDA (sq) sq) 273 | EXPR) 274 | 275 | (DEFPROP destthm 276 | (LAMBDA (sq) sq) 277 | EXPR) 278 | 279 | (DEFPROP MUTCONST 280 | (LAMBDA (tok) (TRIPLE (QUOTE const) tok (OMUTANT (CONSTP tok)))) 281 | EXPR) 282 | 283 | (DEFPROP mk=typed 284 | (LAMBDA(tmty) 285 | (PROG (t ty) 286 | (SETQ ty (EVAL (CADR tmty))) 287 | (SETQ t (CAR tmty)) 288 | (AND (EQ (CAR t) (QUOTE mk=tok)) 289 | (OR (MEMQ (CADR t) %BVL) (NOT (CONSTP (CADR t)))) 290 | (PUTPROP (CADR t) ty (QUOTE STICKYTYPE))) 291 | (SETQ t (EVAL t)) 292 | (COND ((UNIFY (CDDR t) ty) (RETURN t))) 293 | (ERR (QUOTE types)))) 294 | FEXPR) 295 | 296 | (DEFPROP mk=pair 297 | (LAMBDA (t1 t2) (mk=comb (mk=comb (MUTCONST (QUOTE PAIR)) t1) t2)) 298 | EXPR) 299 | 300 | (DEFPROP mk=cond 301 | (LAMBDA(t1 t2 t3) 302 | (mk=comb (mk=comb (mk=comb (MUTCONST (QUOTE COND)) t1) t2) t3)) 303 | EXPR) 304 | 305 | (DEFPROP mktype 306 | (LAMBDA(prop ty1 ty2) 307 | (COND ((AND (EQ (CAR ty1) (QUOTE consttype)) 308 | (EQ (CAR ty2) (QUOTE consttype))) 309 | (COND ((ASSOC1 (CDR ty2) (GET (CDR ty1) prop))) 310 | ((SHARETRIPLE prop ty1 ty2)))) 311 | ((SHARETRIPLE prop ty1 ty2)))) 312 | EXPR) 313 | 314 | (DEFPROP desttype 315 | (LAMBDA(prop ty) 316 | (COND ((EQ (CAR ty) prop) (CDR ty)) 317 | ((EQ (CAR ty) (QUOTE consttype)) 318 | (desttype 319 | prop 320 | (COND ((GET (CDR ty) (QUOTE EQTYPE))) ((QUOTE (fail)))))) 321 | ((ERR 322 | (READLIST 323 | (APPEND (EXPLODE (QUOTE dest)) (EXPLODE prop))))))) 324 | EXPR) 325 | 326 | (DEFPROP mk=antiquot 327 | (LAMBDA (ob) ob) 328 | EXPR) 329 | -------------------------------------------------------------------------------- /src/ol0.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE mkquant) 2 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE mkquant) (MKTIDY (QUOTE ((term # form) /-> form))) (QUOTE MLTYPE)) 3 | (DML' mkimp 2 mk=imp ((form # form) /-> form)) 4 | (DML' mkconj 2 mk=conj ((form # form) /-> form)) 5 | (PUTPROP (QUOTE mkequiv) 2 (QUOTE NUMARGS)) 6 | (PUTPROP (QUOTE mkequiv) (MKTIDY (QUOTE ((term # term) /-> form))) (QUOTE MLTYPE)) 7 | (PUTPROP (QUOTE mkinequiv) 2 (QUOTE NUMARGS)) 8 | (PUTPROP (QUOTE mkinequiv) (MKTIDY (QUOTE ((term # term) /-> form))) (QUOTE MLTYPE)) 9 | (DML' mktruth 0 mk=truth (/. /-> form)) 10 | (PUTPROP (QUOTE destquant) 1 (QUOTE NUMARGS)) 11 | (PUTPROP (QUOTE destquant) (MKTIDY (QUOTE (form /-> (term # form)))) (QUOTE MLTYPE)) 12 | (PUTPROP (QUOTE destimp) 1 (QUOTE NUMARGS)) 13 | (PUTPROP (QUOTE destimp) (MKTIDY (QUOTE (form /-> (form # form)))) (QUOTE MLTYPE)) 14 | (PUTPROP (QUOTE destconj) 1 (QUOTE NUMARGS)) 15 | (PUTPROP (QUOTE destconj) (MKTIDY (QUOTE (form /-> (form # form)))) (QUOTE MLTYPE)) 16 | (PUTPROP (QUOTE destequiv) 1 (QUOTE NUMARGS)) 17 | (PUTPROP (QUOTE destequiv) (MKTIDY (QUOTE (form /-> (term # term)))) (QUOTE MLTYPE)) 18 | (PUTPROP (QUOTE destinequiv) 1 (QUOTE NUMARGS)) 19 | (PUTPROP (QUOTE destinequiv) (MKTIDY (QUOTE (form /-> (term # term)))) (QUOTE MLTYPE)) 20 | (PUTPROP (QUOTE desttruth) 1 (QUOTE NUMARGS)) 21 | (PUTPROP (QUOTE desttruth) (MKTIDY (QUOTE (form /-> /.))) (QUOTE MLTYPE)) 22 | (PUTPROP (QUOTE mkabs) 2 (QUOTE NUMARGS)) 23 | (PUTPROP (QUOTE mkabs) (MKTIDY (QUOTE ((term # term) /-> term))) (QUOTE MLTYPE)) 24 | (PUTPROP (QUOTE mkcomb) 2 (QUOTE NUMARGS)) 25 | (PUTPROP (QUOTE mkcomb) (MKTIDY (QUOTE ((term # term) /-> term))) (QUOTE MLTYPE)) 26 | (PUTPROP (QUOTE mkvar) 2 (QUOTE NUMARGS)) 27 | (PUTPROP (QUOTE mkvar) (MKTIDY (QUOTE ((token # type) /-> term))) (QUOTE MLTYPE)) 28 | (PUTPROP (QUOTE mkconst) 2 (QUOTE NUMARGS)) 29 | (PUTPROP (QUOTE mkconst) (MKTIDY (QUOTE ((token # type) /-> term))) (QUOTE MLTYPE)) 30 | (PUTPROP (QUOTE destabs) 1 (QUOTE NUMARGS)) 31 | (PUTPROP (QUOTE destabs) (MKTIDY (QUOTE (term /-> (term # term)))) (QUOTE MLTYPE)) 32 | (PUTPROP (QUOTE destcomb) 1 (QUOTE NUMARGS)) 33 | (PUTPROP (QUOTE destcomb) (MKTIDY (QUOTE (term /-> (term # term)))) (QUOTE MLTYPE)) 34 | (PUTPROP (QUOTE destvar) 1 (QUOTE NUMARGS)) 35 | (PUTPROP (QUOTE destvar) (MKTIDY (QUOTE (term /-> (token # type)))) (QUOTE MLTYPE)) 36 | (PUTPROP (QUOTE destconst) 1 (QUOTE NUMARGS)) 37 | (PUTPROP (QUOTE destconst) (MKTIDY (QUOTE (term /-> (token # type)))) (QUOTE MLTYPE)) 38 | (PUTPROP (QUOTE typeof) 1 (QUOTE NUMARGS)) 39 | (PUTPROP (QUOTE typeof) (MKTIDY (QUOTE (term /-> type))) (QUOTE MLTYPE)) 40 | (DML' mksumtype 2 mk=sumtype ((type # type) /-> type)) 41 | (DML' mkprodtype 2 mk=prodtype ((type # type) /-> type)) 42 | (DML' mkfuntype 2 mk=funtype ((type # type) /-> type)) 43 | (PUTPROP (QUOTE mkconsttype) 1 (QUOTE NUMARGS)) 44 | (PUTPROP (QUOTE mkconsttype) (MKTIDY (QUOTE (token /-> type))) (QUOTE MLTYPE)) 45 | (PUTPROP (QUOTE mkvartype) 1 (QUOTE NUMARGS)) 46 | (PUTPROP (QUOTE mkvartype) (MKTIDY (QUOTE (token /-> type))) (QUOTE MLTYPE)) 47 | (PUTPROP (QUOTE destsumtype) 1 (QUOTE NUMARGS)) 48 | (PUTPROP (QUOTE destsumtype) (MKTIDY (QUOTE (type /-> (type # type)))) (QUOTE MLTYPE)) 49 | (PUTPROP (QUOTE destprodtype) 1 (QUOTE NUMARGS)) 50 | (PUTPROP (QUOTE destprodtype) (MKTIDY (QUOTE (type /-> (type # type)))) (QUOTE MLTYPE)) 51 | (PUTPROP (QUOTE destfuntype) 1 (QUOTE NUMARGS)) 52 | (PUTPROP (QUOTE destfuntype) (MKTIDY (QUOTE (type /-> (type # type)))) (QUOTE MLTYPE)) 53 | (PUTPROP (QUOTE destconsttype) 1 (QUOTE NUMARGS)) 54 | (PUTPROP (QUOTE destconsttype) (MKTIDY (QUOTE (type /-> token))) (QUOTE MLTYPE)) 55 | (PUTPROP (QUOTE destvartype) 1 (QUOTE NUMARGS)) 56 | (PUTPROP (QUOTE destvartype) (MKTIDY (QUOTE (type /-> token))) (QUOTE MLTYPE)) 57 | (PUTPROP (QUOTE mkthm) 1 (QUOTE NUMARGS)) 58 | (PUTPROP (QUOTE mkthm) (MKTIDY (QUOTE (((form list) # form) /-> thm))) (QUOTE MLTYPE)) 59 | (PUTPROP (QUOTE destthm) 1 (QUOTE NUMARGS)) 60 | (PUTPROP (QUOTE destthm) (MKTIDY (QUOTE (thm /-> ((form list) # form)))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/ol1: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP isquant 4 | (LAMBDA (w) (EQ (CAR w) (QUOTE quant))) 5 | EXPR) 6 | 7 | (DEFPROP isimp 8 | (LAMBDA (w) (EQ (CAR w) (QUOTE imp))) 9 | EXPR) 10 | 11 | (DEFPROP isconj 12 | (LAMBDA (w) (EQ (CAR w) (QUOTE conj))) 13 | EXPR) 14 | 15 | (DEFPROP isequiv 16 | (LAMBDA (w) (EQ (CAR w) (QUOTE equiv))) 17 | EXPR) 18 | 19 | (DEFPROP isinequiv 20 | (LAMBDA (w) (EQ (CAR w) (QUOTE inequiv))) 21 | EXPR) 22 | 23 | (DEFPROP istruth 24 | (LAMBDA (w) (EQ (CAR w) (QUOTE truth))) 25 | EXPR) 26 | 27 | (DEFPROP istype 28 | (LAMBDA(prop ty) 29 | (COND ((EQ (CAR ty) prop)) 30 | ((EQ (CAR ty) (QUOTE consttype)) 31 | (AND (SETQ ty (GET (CDR ty) (QUOTE EQTYPE))) 32 | (istype prop ty))))) 33 | EXPR) 34 | 35 | (DEFPROP issumtype 36 | (LAMBDA (ty) (istype (QUOTE sumtype) ty)) 37 | EXPR) 38 | 39 | (DEFPROP isprodtype 40 | (LAMBDA (ty) (istype (QUOTE prodtype) ty)) 41 | EXPR) 42 | 43 | (DEFPROP isfuntype 44 | (LAMBDA (ty) (istype (QUOTE funtype) ty)) 45 | EXPR) 46 | 47 | (DEFPROP isconsttype 48 | (LAMBDA (ty) (EQ (CAR ty) (QUOTE consttype))) 49 | EXPR) 50 | 51 | (DEFPROP isvartype 52 | (LAMBDA (ty) (EQ (CAR ty) (QUOTE vartype))) 53 | EXPR) 54 | 55 | (DEFPROP isabs 56 | (LAMBDA (t) (EQ (CAR t) (QUOTE abs))) 57 | EXPR) 58 | 59 | (DEFPROP iscomb 60 | (LAMBDA (t) (EQ (CAR t) (QUOTE comb))) 61 | EXPR) 62 | 63 | (DEFPROP isvar 64 | (LAMBDA (t) (EQ (CAR t) (QUOTE var))) 65 | EXPR) 66 | 67 | (DEFPROP isconst 68 | (LAMBDA (t) (EQ (CAR t) (QUOTE const))) 69 | EXPR) 70 | 71 | (DEFPROP destaform 72 | (LAMBDA(w) 73 | (SELECTQ (CAR w) 74 | (equiv (CONS %mkequivclosure (CDR w))) 75 | (inequiv (CONS %mkinequivclosure (CDR w))) 76 | (ERR (QUOTE destaform)))) 77 | EXPR) 78 | 79 | (DEFPROP mkCOND 80 | (LAMBDA(ty) 81 | (mkconst (QUOTE COND) 82 | (mk=funtype (GET (QUOTE trtype) (QUOTE MLVAL)) 83 | (mk=funtype ty (mk=funtype ty ty))))) 84 | EXPR) 85 | 86 | (DEFPROP mkcond 87 | (LAMBDA(tr t1 t2) 88 | (COND ((AND (EQ (CDDR tr) (GET (QUOTE trtype) (QUOTE MLVAL))) 89 | (EQ (CDDR t1) (CDDR t2))) 90 | (mkcomb (mkcomb (mkcomb (mkCOND (CDDR t1)) tr) t1) t2)) 91 | ((ERR (QUOTE mkcond))))) 92 | EXPR) 93 | 94 | (DEFPROP mkPAIR 95 | (LAMBDA(ty1 ty2) 96 | (mkconst (QUOTE PAIR) 97 | (mk=funtype ty1 (mk=funtype ty2 (mk=prodtype ty1 ty2))))) 98 | EXPR) 99 | 100 | (DEFPROP mkpair 101 | (LAMBDA (t1 t2) (mkcomb (mkcomb (mkPAIR (CDDR t1) (CDDR t2)) t1) t2)) 102 | EXPR) 103 | 104 | (DEFPROP destcond 105 | (LAMBDA(t) 106 | (PROG (tr t1 t2) 107 | (COND 108 | ((AND (iscomb t) 109 | (PROG2 (SETQ t2 (CDADR t)) (iscomb (SETQ t (CAADR t)))) 110 | (PROG2 (SETQ t1 (CDADR t)) (iscomb (SETQ t (CAADR t)))) 111 | (PROG2 (SETQ tr (CDADR t)) 112 | (EQ (CADR (CAADR t)) (QUOTE COND)))) 113 | (RETURN (CONS tr (CONS t1 t2))))) 114 | (ERR (QUOTE destcond)))) 115 | EXPR) 116 | 117 | (DEFPROP destpair 118 | (LAMBDA(t) 119 | (PROG (t1 t2 ty) 120 | (SETQ ty (CDDR t)) 121 | (COND ((NOT (isprodtype ty)) (ERR (QUOTE destpair))) 122 | ((isUU t) (SETQ ty (destprodtype ty)) 123 | (SETQ t1 (mkconst (QUOTE UU) (CAR ty))) 124 | (SETQ t2 (mkconst (QUOTE UU) (CDR ty)))) 125 | ((AND (iscomb t) 126 | (PROG2 (SETQ t2 (CDADR t)) 127 | (iscomb (SETQ t (CAADR t)))) 128 | (PROG2 (SETQ t1 (CDADR t)) 129 | (EQ (CADR (CAADR t)) (QUOTE PAIR))))) 130 | ((ERR (QUOTE destpair)))) 131 | (RETURN (CONS t1 t2)))) 132 | EXPR) 133 | 134 | (DEFPROP isUU 135 | (LAMBDA (t) (EQ (CADR t) (QUOTE UU))) 136 | EXPR) 137 | 138 | (DEFPROP lhs 139 | (LAMBDA(w) 140 | (SELECTQ (CAR w) ((equiv inequiv) (CADR w)) (ERR (QUOTE lhs)))) 141 | EXPR) 142 | 143 | (DEFPROP rhs 144 | (LAMBDA(w) 145 | (SELECTQ (CAR w) ((equiv inequiv) (CDDR w)) (ERR (QUOTE rhs)))) 146 | EXPR) 147 | 148 | (DEFPROP mkfreethm 149 | (LAMBDA (w) (CONS NIL w)) 150 | EXPR) 151 | 152 | (DEFPROP eqtt 153 | (LAMBDA (t) (mkequiv t (GET (QUOTE tt) (QUOTE MLVAL)))) 154 | EXPR) 155 | 156 | (DEFPROP eqff 157 | (LAMBDA (t) (mkequiv t (GET (QUOTE ff) (QUOTE MLVAL)))) 158 | EXPR) 159 | 160 | (DEFPROP equu 161 | (LAMBDA (t) (mkequiv t (GET (QUOTE uutr) (QUOTE MLVAL)))) 162 | EXPR) 163 | -------------------------------------------------------------------------------- /src/ol1.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE isquant) 1 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE isquant) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 3 | (PUTPROP (QUOTE isimp) 1 (QUOTE NUMARGS)) 4 | (PUTPROP (QUOTE isimp) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 5 | (PUTPROP (QUOTE isconj) 1 (QUOTE NUMARGS)) 6 | (PUTPROP (QUOTE isconj) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 7 | (PUTPROP (QUOTE isequiv) 1 (QUOTE NUMARGS)) 8 | (PUTPROP (QUOTE isequiv) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 9 | (PUTPROP (QUOTE isinequiv) 1 (QUOTE NUMARGS)) 10 | (PUTPROP (QUOTE isinequiv) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 11 | (PUTPROP (QUOTE istruth) 1 (QUOTE NUMARGS)) 12 | (PUTPROP (QUOTE istruth) (MKTIDY (QUOTE (form /-> bool))) (QUOTE MLTYPE)) 13 | (PUTPROP (QUOTE issumtype) 1 (QUOTE NUMARGS)) 14 | (PUTPROP (QUOTE issumtype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 15 | (PUTPROP (QUOTE isprodtype) 1 (QUOTE NUMARGS)) 16 | (PUTPROP (QUOTE isprodtype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 17 | (PUTPROP (QUOTE isfuntype) 1 (QUOTE NUMARGS)) 18 | (PUTPROP (QUOTE isfuntype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 19 | (PUTPROP (QUOTE isconsttype) 1 (QUOTE NUMARGS)) 20 | (PUTPROP (QUOTE isconsttype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 21 | (PUTPROP (QUOTE isvartype) 1 (QUOTE NUMARGS)) 22 | (PUTPROP (QUOTE isvartype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 23 | (PUTPROP (QUOTE isabs) 1 (QUOTE NUMARGS)) 24 | (PUTPROP (QUOTE isabs) (MKTIDY (QUOTE (term /-> bool))) (QUOTE MLTYPE)) 25 | (PUTPROP (QUOTE iscomb) 1 (QUOTE NUMARGS)) 26 | (PUTPROP (QUOTE iscomb) (MKTIDY (QUOTE (term /-> bool))) (QUOTE MLTYPE)) 27 | (PUTPROP (QUOTE isvar) 1 (QUOTE NUMARGS)) 28 | (PUTPROP (QUOTE isvar) (MKTIDY (QUOTE (term /-> bool))) (QUOTE MLTYPE)) 29 | (PUTPROP (QUOTE isconst) 1 (QUOTE NUMARGS)) 30 | (PUTPROP (QUOTE isconst) (MKTIDY (QUOTE (term /-> bool))) (QUOTE MLTYPE)) 31 | (DML' phylumofterm 1 CAR (term /-> token)) 32 | (DML' phylumofform 1 CAR (form /-> token)) 33 | (DML' phylumoftype 1 CAR (type /-> token)) 34 | (DMLC dottype (GET (QUOTE /.) (QUOTE CANON)) type) 35 | (DMLC trtype (GET (QUOTE TR) (QUOTE CANON)) type) 36 | (DMLC tt (mkconst (QUOTE TT) (GET (QUOTE trtype) (QUOTE MLVAL))) term) 37 | (DMLC ff (mkconst (QUOTE FF) (GET (QUOTE trtype) (QUOTE MLVAL))) term) 38 | (DMLC uutr (mkconst (QUOTE UU) (GET (QUOTE trtype) (QUOTE MLVAL))) term) 39 | (DMLC uudot (mkconst (QUOTE UU) (GET (QUOTE dottype) (QUOTE MLVAL))) term) 40 | (DMLC truth (mk=truth) form) 41 | (SETQ %mkequivclosure (CLOSURE (QUOTE mkequiv))) 42 | (SETQ %mkinequivclosure (CLOSURE (QUOTE mkinequiv))) 43 | (PUTPROP (QUOTE destaform) 1 (QUOTE NUMARGS)) 44 | (PUTPROP (QUOTE destaform) (MKTIDY (QUOTE (form /-> (((term # term) /-> form) # (term # term))))) (QUOTE MLTYPE)) 45 | (PUTPROP (QUOTE mkcond) 3 (QUOTE NUMARGS)) 46 | (PUTPROP (QUOTE mkcond) (MKTIDY (QUOTE ((term # (term # term)) /-> term))) (QUOTE MLTYPE)) 47 | (PUTPROP (QUOTE mkpair) 2 (QUOTE NUMARGS)) 48 | (PUTPROP (QUOTE mkpair) (MKTIDY (QUOTE ((term # term) /-> term))) (QUOTE MLTYPE)) 49 | (PUTPROP (QUOTE destcond) 1 (QUOTE NUMARGS)) 50 | (PUTPROP (QUOTE destcond) (MKTIDY (QUOTE (term /-> (term # (term # term))))) (QUOTE MLTYPE)) 51 | (PUTPROP (QUOTE destpair) 1 (QUOTE NUMARGS)) 52 | (PUTPROP (QUOTE destpair) (MKTIDY (QUOTE (term /-> (term # term)))) (QUOTE MLTYPE)) 53 | (PUTPROP (QUOTE isUU) 1 (QUOTE NUMARGS)) 54 | (PUTPROP (QUOTE isUU) (MKTIDY (QUOTE (term /-> bool))) (QUOTE MLTYPE)) 55 | (PUTPROP (QUOTE lhs) 1 (QUOTE NUMARGS)) 56 | (PUTPROP (QUOTE lhs) (MKTIDY (QUOTE (form /-> term))) (QUOTE MLTYPE)) 57 | (PUTPROP (QUOTE rhs) 1 (QUOTE NUMARGS)) 58 | (PUTPROP (QUOTE rhs) (MKTIDY (QUOTE (form /-> term))) (QUOTE MLTYPE)) 59 | (DML' hyp 1 CAR (thm /-> (form list))) 60 | (DML' concl 1 CDR (thm /-> form)) 61 | (PUTPROP (QUOTE mkfreethm) 1 (QUOTE NUMARGS)) 62 | (PUTPROP (QUOTE mkfreethm) (MKTIDY (QUOTE (form /-> thm))) (QUOTE MLTYPE)) 63 | (PUTPROP (QUOTE eqtt) 1 (QUOTE NUMARGS)) 64 | (PUTPROP (QUOTE eqtt) (MKTIDY (QUOTE (term /-> form))) (QUOTE MLTYPE)) 65 | (PUTPROP (QUOTE eqff) 1 (QUOTE NUMARGS)) 66 | (PUTPROP (QUOTE eqff) (MKTIDY (QUOTE (term /-> form))) (QUOTE MLTYPE)) 67 | (PUTPROP (QUOTE equu) 1 (QUOTE NUMARGS)) 68 | (PUTPROP (QUOTE equu) (MKTIDY (QUOTE (term /-> form))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/ol2.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE variant) 2 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE variant) (MKTIDY (QUOTE ((term # (term list)) /-> term))) (QUOTE MLTYPE)) 3 | (DML' aconvform 2 ALPHACONV ((form # form) /-> bool)) 4 | (DML' aconvterm 2 ALPHACONV ((term # term) /-> bool)) 5 | (DML' termfrees 1 FREEVARS (term /-> (term list))) 6 | (DML' formfrees 1 FREEVARS (form /-> (term list))) 7 | (DML' substinterm 2 SUBSTITUTE ((((term # term) list) # term) /-> term)) 8 | (DML' substinform 2 SUBSTITUTE ((((term # term) list) # form) /-> form)) 9 | (DML' substoccsinterm 2 SUBSTITUTEOCCS ((((term # ((int list) # term)) list) # term) /-> term)) 10 | (DML' substoccsinform 2 SUBSTITUTEOCCS ((((term # ((int list) # term)) list) # form) /-> form)) 11 | (DML' freeinterm 2 FREEIN (((term list) # term) /-> bool)) 12 | (DML' freeinform 2 FREEIN (((term list) # form) /-> bool)) -------------------------------------------------------------------------------- /src/ol2.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let substinterm l t = substinterm(l,t) 5 | and substinform l f = substinform(l,f) 6 | and substoccsinterm l t = substoccsinterm(l,t) 7 | and substoccsinform l f = substoccsinform(l,f) 8 | and freeinterm l t = freeinterm(l,t) 9 | and freeinform l f = freeinform(l,f) ;; 10 | 11 | -------------------------------------------------------------------------------- /src/ol3: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP eqtype 4 | (LAMBDA (T1 T2) (EQ (CDDR T1) (CDDR T2))) 5 | EXPR) 6 | 7 | (DEFPROP genvar 8 | (LAMBDA (TY) (mkvar (GENSYM) TY)) 9 | EXPR) 10 | 11 | (DEFPROP equivpair 12 | (LAMBDA (TH) (destequiv (CDR TH))) 13 | EXPR) 14 | 15 | (DEFPROP inequivpair 16 | (LAMBDA (TH) (destinequiv (CDR TH))) 17 | EXPR) 18 | 19 | (DEFPROP tmfmvars 20 | (LAMBDA (TMFM) (ALLVARS (CDR TMFM))) 21 | EXPR) 22 | 23 | (DEFPROP TYPESIN 24 | (LAMBDA (%TYL OB) (%TYLIN1 OB)) 25 | EXPR) 26 | 27 | (DEFPROP %TYLIN1 28 | (LAMBDA(OB) 29 | (OR (MEMQ OB %TYL) 30 | (SELECTQ (CAR OB) 31 | ((vartype consttype truth) NIL) 32 | ((var const) (%TYLIN1 (CDDR OB))) 33 | ((comb abs) (%TYLIN2 (CADR OB))) 34 | ((quant conj 35 | imp 36 | equiv 37 | inequiv 38 | funtype 39 | prodtype 40 | sumtype) 41 | (%TYLIN2 (CDR OB))) 42 | (ERROR (QUOTE TYPESIN))))) 43 | EXPR) 44 | 45 | (DEFPROP %TYLIN2 46 | (LAMBDA (X) (OR (%TYLIN1 (CAR X)) (%TYLIN1 (CDR X)))) 47 | EXPR) 48 | 49 | (DEFPROP TYVARS 50 | (LAMBDA (OB) (PROG (%TYVL) (TYVARS1 OB) (RETURN (REVERSE %TYVL)))) 51 | EXPR) 52 | 53 | (DEFPROP TYVARS1 54 | (LAMBDA(OB) 55 | (SELECTQ (CAR OB) 56 | ((truth consttype)) 57 | (vartype (OR (MEMQ OB %TYVL) (SETQ %TYVL (CONS OB %TYVL)))) 58 | ((var const) (TYVARS1 (CDDR OB))) 59 | ((comb abs) (TYVARS2 (CADR OB))) 60 | ((quant conj imp equiv inequiv funtype prodtype sumtype) 61 | (TYVARS2 (CDR OB))) 62 | (ERROR (QUOTE TYVARS)))) 63 | EXPR) 64 | 65 | (DEFPROP TYVARS2 66 | (LAMBDA (OB) (PROG2 (TYVARS1 (CAR OB)) (TYVARS1 (CDR OB)))) 67 | EXPR) 68 | -------------------------------------------------------------------------------- /src/ol3.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE eqtype) 2 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE eqtype) (MKTIDY (QUOTE ((term # term) /-> bool))) (QUOTE MLTYPE)) 3 | (PUTPROP (QUOTE genvar) 1 (QUOTE NUMARGS)) 4 | (PUTPROP (QUOTE genvar) (MKTIDY (QUOTE (type /-> term))) (QUOTE MLTYPE)) 5 | (PUTPROP (QUOTE equivpair) 1 (QUOTE NUMARGS)) 6 | (PUTPROP (QUOTE equivpair) (MKTIDY (QUOTE (thm /-> (term # term)))) (QUOTE MLTYPE)) 7 | (PUTPROP (QUOTE inequivpair) 1 (QUOTE NUMARGS)) 8 | (PUTPROP (QUOTE inequivpair) (MKTIDY (QUOTE (thm /-> (term # term)))) (QUOTE MLTYPE)) 9 | (DML' termvars 1 ALLVARS (term /-> (term list))) 10 | (DML' formvars 1 ALLVARS (form /-> (term list))) 11 | (PUTPROP (QUOTE tmfmvars) 1 (QUOTE NUMARGS)) 12 | (PUTPROP (QUOTE tmfmvars) (MKTIDY (QUOTE ((term /+ form) /-> (term list)))) (QUOTE MLTYPE)) 13 | (DML' typesinterm 2 TYPESIN (((type list) # term) /-> bool)) 14 | (DML' typesinform 2 TYPESIN (((type list) # form) /-> bool)) 15 | (DML' typesintype 2 TYPESIN (((type list) # type) /-> bool)) 16 | (DML' typetyvars 1 TYVARS (type /-> (type list))) 17 | (DML' termtyvars 1 TYVARS (term /-> (type list))) 18 | (DML' formtyvars 1 TYVARS (form /-> (type list))) -------------------------------------------------------------------------------- /src/ol3.ml: -------------------------------------------------------------------------------- 1 | (TML) 2 | 3 | let typesinterm tyl t = typesinterm(tyl,t) 4 | and typesinform tyl w = typesinform(tyl,w) 5 | and typesintype tyl ty = typesintype(tyl,ty) ;; 6 | 7 | let formlfrees,formlvars,formltyvars = 8 | fun formfrees , fun formvars , fun formtyvars 9 | where fun f wl = itlist (\w.\xl.union(f w, xl)) wl nil ;; 10 | 11 | let instintype insttylist ty = inst ty whererec inst ty = 12 | fst(revassoc ty insttylist) 13 | ?(failwith phylumoftype ty 14 | ??``consttype vartype`` ty 15 | ??``funtype`` mkfuntype((inst # inst)(destfuntype ty)) 16 | ??``sumtype`` mksumtype((inst # inst)(destsumtype ty)) 17 | ??``prodtype`` mkprodtype((inst # inst)(destprodtype ty)) 18 | ) ;; 19 | 20 | 21 | let geninstintmfm vars insttylist tmfm = 22 | 23 | let insttylist' = filter ($not o $=) insttylist 24 | in 25 | let insttokty = I # instintype insttylist' 26 | in 27 | let instvar = 28 | (\x.snd(assoc x changedpairs) ? x) 29 | where changedpairs = 30 | let unchangedvars,changedvars = 31 | itlist (f (map snd insttylist')) 32 | (tmfmvars tmfm) 33 | (nil,nil) 34 | where f tyl x (l1,l2) = typesinterm tyl x 35 | => (l1, x.l2) 36 | | (x.l1, l2) 37 | in 38 | letref vars' = union(unchangedvars,vars) 39 | in 40 | let instvariant x = 41 | let xinst = mkvar(insttokty(destvar(variant(x,nil)))) 42 | in hd(vars' := variant(xinst,vars').vars') 43 | in 44 | map (\x.(x, instvariant x)) changedvars 45 | in 46 | letrec insttm t = 47 | failwith phylumofterm t 48 | ??``var`` instvar t 49 | ??``const`` mkconst(insttokty(destconst t)) 50 | ??``comb`` mkcomb((insttm # insttm)(destcomb t)) 51 | ??``abs`` mkabs((instvar # insttm)(destabs t)) 52 | in 53 | isl tmfm => inl(insttm(outl tmfm)) 54 | |letrec instfm w = 55 | failwith phylumofform w 56 | ??``truth`` w 57 | ??``quant`` mkquant((instvar # instfm)(destquant w)) 58 | ??``conj`` mkconj((instfm # instfm)(destconj w)) 59 | ??``imp`` mkimp((instfm # instfm)(destimp w)) 60 | ??``equiv`` mkequiv((insttm # insttm)(destequiv w)) 61 | ??``inequiv`` mkinequiv((insttm # insttm)(destinequiv w)) 62 | in inr(instfm(outr tmfm)) ;; 63 | 64 | let instinterm insttylist t = 65 | outl(geninstintmfm nil insttylist (inl t)) 66 | and instinform insttylist w = 67 | outr(geninstintmfm nil insttylist (inr w)) ;; 68 | 69 | 70 | let disch(w,wl) = filter (\w'.not aconvform(w,w')) wl ;; 71 | 72 | let lhsxpairs = map (\(th,x).(fst(equivpair th),x)) 73 | and rhsxpairs = map (\(th,x).(snd(equivpair th),x)) 74 | and xlhspairs = map (\(th,x).(x,fst(equivpair th))) 75 | and xrhspairs = map (\(th,x).(x,snd(equivpair th))) ;; 76 | 77 | let uupairs = map (\(fun,x).(mkconst(`UU`,typeof x),x)) 78 | and steppairs = map (\(fun,x).(mkcomb(fun,x),x)) 79 | and fixpairs = map (\(fun,x).("FIX ↑fun",x)) ;; 80 | 81 | let thxpairs = map (\th.(th,genvar(typeof(fst(equivpair th))))) ;; 82 | -------------------------------------------------------------------------------- /src/opp: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP POP 3 | (LAMBDA(CPL) 4 | (PROG (X) 5 | (SETQ PARSEDEPTH (ADD1 PARSEDEPTH)) 6 | (GNT) 7 | (SETQ ARG1 8 | (COND ((NOT 9 | (OR (NUMBERP PTOKEN) 10 | (NULL (SETQ X (GET PTOKEN LANG1))))) 11 | (EVAL X)) 12 | (T (EVAL ATOMRTN)))) 13 | L (SETQ X (COND ((NUMBERP TOKEN) NIL) (T (GET TOKEN LANGLP)))) 14 | (COND ((AND (NULL X) (NOT (LESSP CPL JUXTLEVEL))) 15 | (SETQ PARSEDEPTH (SUB1 PARSEDEPTH)) 16 | (RETURN ARG1)) 17 | ((NULL X) (PROG2 (SETQ ARG1 (EVAL JUXTRTN)) (GO L))) 18 | ((NOT (LESSP CPL X)) 19 | (SETQ PARSEDEPTH (SUB1 PARSEDEPTH)) 20 | (RETURN ARG1)) 21 | (T NIL)) 22 | (COND 23 | ((MEMQ (CAR ARG1) DECLNCONSTRS) 24 | (FAIL (QUOTE (NON TOP LEVEL DECLN MUST HAVE in CLAUSE))))) 25 | (SETQ X (GET TOKEN LANG2)) 26 | (COND 27 | ((NULL X) 28 | (FAIL 29 | (CONS TOKEN (QUOTE (IS UNDEFINED OPTR (SYSTEM ERROR))))))) 30 | (GNT) 31 | (SETQ ARG1 (EVAL X)) 32 | (GO L))) 33 | EXPR) 34 | 35 | (DEFPROP UNOP 36 | (LAMBDA (OP CODE) (PUTPROP OP CODE LANG1)) 37 | EXPR) 38 | 39 | (DEFPROP BNOP 40 | (LAMBDA (OP CODE) (PUTPROP OP CODE LANG2)) 41 | EXPR) 42 | 43 | (DEFPROP BINOP 44 | (LAMBDA(OP LP CODE) 45 | (PROG2 (PUTPROP OP CODE LANG2) (PUTPROP OP LP LANGLP))) 46 | EXPR) 47 | 48 | (DEFPROP CHECK 49 | (LAMBDA(TOK RSLT MSG) 50 | (COND ((EQ TOK TOKEN) (PROG2 (GNT) RSLT)) (T (FAIL MSG)))) 51 | EXPR) 52 | 53 | (DEFPROP FAIL 54 | (LAMBDA(MSG) 55 | (PROG NIL 56 | (PRINT MSG) 57 | (PRINT (QUOTE SKIPPING:)) 58 | (PRINC PTOKEN) 59 | (PRINC SPACE) 60 | (PRINC TOKEN) 61 | (PRINC SPACE) 62 | L (COND 63 | ((EQ TOKEN TMLSYM) 64 | (INITLEAN) 65 | (EQSETUP) 66 | (PERSETUP) 67 | (ERR (QUOTE ***)))) 68 | (PRINC (GNT)) 69 | (PRINC SPACE) 70 | (GO L))) 71 | EXPR) 72 | -------------------------------------------------------------------------------- /src/pcrul.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let CONJ(th1,th2) = mkthm( union(hyp th1, hyp th2) , 5 | mkconj(concl th1, concl th2) ) ;; 6 | 7 | let SEL1 , SEL2 = SEL 1 , SEL 2 8 | where SEL n th = 9 | let w1,w2 = destconj(concl th) 10 | ? failwith (n=1=>`SEL1`|`SEL2`) 11 | in mkthm(hyp th, (n=1=>w1|w2)) ;; 12 | 13 | let DISCH w th = mkthm( disch(w,hyp th) , mkimp(w,concl th) ) ;; 14 | 15 | let destconj1 w = destconj w ? (istruth w => fail | (w,truth) ) ;; 16 | 17 | let destconjimp w = 18 | let w,w' = destimp w in 19 | let w1,w2 = destconj1 w in 20 | w1,mkimp(w2,w') ;; 21 | 22 | letrec wmp wi w : form = 23 | (let (wa,wc),(w1,w2) = (destconjimp wi, destconj1 w) 24 | ? failwith `dest` 25 | in aconvform(wa,w1) => wmp wc w2 | failwith `MP` 26 | )??``dest`` wi ;; 27 | 28 | let MP thi th = mkthm( union(hyp thi, hyp th) , 29 | wmp(concl thi)(concl th) ) ;; 30 | 31 | let GEN x th = exists (freeinform[x]) (hyp th) => failwith `GEN` 32 | | mkthm( hyp th , mkquant(x, concl th) ) ;; 33 | 34 | let SPEC t th = let x,w = destquant(concl th) ? failwith `SPEC` 35 | in mkthm( hyp th , substinform[t,x]w ) ;; 36 | 37 | let ASSUME w = mkthm([w],w);; 38 | 39 | let AXTRUTH = mkfreethm truth ;; 40 | 41 | let INSTTYPE insttylist th = null insttylist => th | 42 | (let wl,w = destthm th 43 | and tyvl = map (assert isvartype o snd) insttylist in 44 | exists (typesinform tyvl) wl => fail 45 | | mkthm(wl, outr(geninstintmfm(formlvars wl)insttylist(inr w))) 46 | ) ? failwith `INSTTYPE` ;; 47 | 48 | let INST instlist th = null instlist => th | 49 | (let wl,w = destthm th 50 | and xl = map (assert isvar o snd) instlist in 51 | exists (freeinform xl) wl => fail 52 | | mkthm(wl, substinform instlist w) 53 | ) ? failwith `INST` ;; 54 | -------------------------------------------------------------------------------- /src/pplamb.lsp: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP /. FINITE TYPECLASS) 3 | (DEFPROP tr FINITE TYPECLASS) 4 | (DEFPROP TR FINITE TYPECLASS) 5 | 6 | (SETQ %CURRENT COR) 7 | 8 | -------------------------------------------------------------------------------- /src/pplamb.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | newtypes [``.``; ``TR = tr``] ;; 5 | 6 | map newconstant [ 7 | `()` , ":." ; 8 | `TT` , ":TR"; 9 | `FF` , ":TR"; 10 | `UU` , ":*" ; 11 | `FIX`, ":(*->*)->*" ; 12 | `COND`, ":TR->*->*->*" ; 13 | `PAIR`, ":*->**->(*#**)" ; 14 | `FST` , ":*#**->*" ; 15 | `SND` , ":*#**->**" ; 16 | `INL` , ":*->*+**" ; 17 | `INR` , ":**->*+**" ; 18 | `OUTL`, ":*+**->*" ; 19 | `OUTR`, ":*+**->**" ; 20 | `ISL` , ":*+**->TR"; 21 | `ISR` , ":*+**->TR" 22 | ] ;; 23 | -------------------------------------------------------------------------------- /src/prompt: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP PROMPT 4 | (LAMBDA (N) ((LAMBDA (N X) (PROG2 (DEPOSIT 6453 N) X)) N (EXAMINE 6453))) 5 | EXPR) 6 | -------------------------------------------------------------------------------- /src/ptble: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP PRINTTABLE 4 | (PRINTTABLE 5 | (MK-NULLTYP /.) 6 | (MK-INTTYP int) 7 | (MK-BOOLTYP bool) 8 | (MK-TOKTYP tok) 9 | (MK-TERMTYP term) 10 | (MK-FORMTYP form) 11 | (MK-TYPETYP type) 12 | (MK-THMTYP thm) 13 | (MK-VARTYP 1) 14 | (MK-CONSTTYP 15 | (COND ((NULL (CDDR %EX)) (PRINC (CADR %EX))) 16 | ((NULL (CDDDR %EX)) (%PP (CADDR %EX)) (PRINC (CADR %EX))) 17 | (T (%PPL (CDDR %EX) (QUOTE /() (QUOTE /,) (QUOTE /))) 18 | (PRINC (CADR %EX))))) 19 | (MK-LISTTYP 1 list) 20 | (MK-PRODTYP /( 1 # 2 /)) 21 | (MK-SUMTYP /( 1 + 2 /)) 22 | (MK-FUNTYP /( 1 -> 2 /)) 23 | (MK-BOOLCONST 24 | (PRINC (COND ((CADR %EX) (QUOTE true)) (T (QUOTE false))))) 25 | (MK-INTCONST 1) 26 | (MK-TOKCONST ` 1 `) 27 | (MK-TYQUOT /" : (PRINC PPSYM) /") 28 | (MK-QUOT /" (PRINC PPSYM) /") 29 | (MK-VAR 1) 30 | (MK-FAIL fail) 31 | (MK-FAILWITH failwith / 1) 32 | (MK-EMPTY /(/)) 33 | (MK-DUPL /( 1 /, 2 /)) 34 | (MK-LIST (%PPL (CDR %EX) (QUOTE /[) (QUOTE ;) (QUOTE /]))) 35 | (MK-STRAINT /( 1 : 2 /)) 36 | (MK-APPN /( 1 / 2 /)) 37 | (MK-BINOP /( 38 | 2 39 | (PRINC 40 | (COND ((EQ (CADR %EX) (QUOTE %&)) (QUOTE &)) 41 | ((EQ (CADR %EX) (QUOTE %or)) (QUOTE " or ")) 42 | (T (CADR %EX)))) 43 | 3 44 | /)) 45 | (MK-UNOP (COND ((EQ (CADR %EX) (QUOTE %-)) (PRINC (QUOTE -))) 46 | (T (PRINC (CADR %EX)) (PRINC (QUOTE / )))) 47 | 2) 48 | (MK-DO do 1) 49 | (MK-SEQ 50 | (%PPL (APPEND (CADR %EX) (CDDR %EX)) 51 | (QUOTE / ) 52 | (QUOTE ;) 53 | (QUOTE / ))) 54 | (MK-ASSIGN 1 := 2) 55 | (MK-TEST (TESTTRAPFN T (CDR %EX))) 56 | (MK-TRAP 1 (TESTTRAPFN NIL (CDDR %EX))) 57 | (MK-ABSTR /( \ 1 /. 2 /)) 58 | (MK-IN 1 / in/ 2) 59 | (MK-IND 1 / in/ 2) 60 | (MK-INA 1 / in/ 2) 61 | (MK-LET let/ 1 / =/ 2) 62 | (MK-LETREC letrec / 1 / =/ 2) 63 | (MK-LETREF letref / 1 / =/ 2) 64 | (MK-DEFTYPE lettype / (PRINC PPSYM)) 65 | (MK-ABSTYPE abstype / (PRINC PPSYM)) 66 | (MK-ABSRECTYPE absrectype / (PRINC PPSYM)) 67 | (MK-BEGIN begin/ 1) 68 | (MK-END end/ 1)) 69 | VALUE) 70 | -------------------------------------------------------------------------------- /src/restor: -------------------------------------------------------------------------------- 1 | COMMENT ⊗ VALID 00002 PAGES 2 | C REC PAGE DESCRIPTION 3 | C00001 00001 4 | C00002 00002 ∂24-Jan-79 2012 Great Pumpkin Restored Files 5 | C00004 ENDMK 6 | C⊗; 7 | ∂24-Jan-79 2012 Great Pumpkin Restored Files 8 | Here is a status report on your PUMPKIN requests: 9 | 10 | Tape File Status 11 | 12 | P1061 WRITML.LAP[LCF,FWH] Restored 13 | P1061 TYPEOL.LAP[LCF,FWH] Restored 14 | P1061 TYPEML.LAP[LCF,FWH] Restored 15 | P1061 TRAN.LAP[LCF,FWH] Restored 16 | P1061 TRACE.LAP[LCF,FWH] Restored 17 | P1061 TML.LAP[LCF,FWH] Restored 18 | P1061 THYFNS.LAP[LCF,FWH] Restored 19 | P1061 SIMPL.LAP[LCF,FWH] Restored 20 | P1061 SHARE.LAP[LCF,FWH] Restored 21 | P1061 PROMPT.LAP[LCF,FWH] Restored 22 | P1061 OPP.LAP[LCF,FWH] Restored 23 | P1061 OL3.LAP[LCF,FWH] Restored 24 | P1061 OL2.LAP[LCF,FWH] Restored 25 | P1061 OL1.LAP[LCF,FWH] Restored 26 | P1061 OL0.LAP[LCF,FWH] Restored 27 | P1061 MLPRIN.LAP[LCF,FWH] Restored 28 | P1061 LIS.LAP[LCF,FWH] Restored 29 | P1061 LEAN.LAP[LCF,FWH] Restored 30 | P1061 LCFO.LAP[LCF,FWH] Restored 31 | P1061 LCFM.LAP[LCF,FWH] Restored 32 | P1061 IOX.LAP[LCF,FWH] Restored 33 | P1061 GP.LAP[LCF,FWH] Restored 34 | P1061 DML.LAP[LCF,FWH] Restored 35 | P1061 CLRBFI.LAP[LCF,FWH] Restored 36 | P1061 LCFM.LAP[LCF,FWH] Not found on tape 37 | P1061 IOX.LAP[LCF,FWH] Not found on tape 38 | 39 | -------------------------------------------------------------------------------- /src/share: -------------------------------------------------------------------------------- 1 | 2 | (DEFPROP SHAREPAIR 3 | (LAMBDA (SORT PR) (SHARECONS' SORT (CAR PR) (CDR PR) PR)) 4 | EXPR) 5 | 6 | (DEFPROP FORCESHARE 7 | (LAMBDA(SORT PR) 8 | ((LAMBDA(XREC) 9 | (COND 10 | (XREC 11 | ((LAMBDA(Z) 12 | (COND (Z (COND ((EQ Z PR)) ((ERR (QUOTE FORCESHARE))))) 13 | ((RPLACD XREC (CONS (CONS (CDR PR) PR) (CDR XREC)))))) 14 | (ASSOC1 (CDR PR) (CDR XREC)))) 15 | ((ADDPROP SORT 16 | (LIST (CAR PR) (CONS (CDR PR) PR)) 17 | (QUOTE SHARECONS))))) 18 | (ASSOC (CAR PR) (GET SORT (QUOTE SHARECONS))))) 19 | EXPR) 20 | 21 | (DEFPROP SHARECONS 22 | (LAMBDA (SORT X Y) (SHARECONS' SORT X Y (CONS X Y))) 23 | EXPR) 24 | 25 | (DEFPROP SHARECONS' 26 | (LAMBDA(SORT X Y CELL) 27 | (PROG (XREC Z) 28 | (SETQ XREC (ASSOC X (GET SORT (QUOTE SHARECONS)))) 29 | (COND 30 | (XREC 31 | (RETURN 32 | (COND ((ASSOC1 Y (CDR XREC))) 33 | ((SETQ Z (CONS' X Y CELL)) 34 | (RPLACD XREC (CONS (CONS Y Z) (CDR XREC))) 35 | Z))))) 36 | (SETQ Z (CONS' X Y CELL)) 37 | (ADDPROP SORT (LIST X (CONS Y Z)) (QUOTE SHARECONS)) 38 | (RETURN Z))) 39 | EXPR) 40 | 41 | (DEFPROP CONS' 42 | (LAMBDA(X Y CELL) 43 | (COND ((AND (EQ X (CAR CELL)) (EQ Y (CDR CELL))) CELL) 44 | (T (CONS X Y)))) 45 | EXPR) 46 | 47 | (DEFPROP CONDSHAREOB 48 | (LAMBDA(SORT OB) 49 | (COND ((GET SORT (QUOTE SHARE)) (SHAREOB SORT OB)) (OB))) 50 | EXPR) 51 | 52 | (DEFPROP SHAREOB 53 | (LAMBDA(SORT OB) 54 | (COND ((DONTSHAREPRED OB) OB) 55 | ((SHAREPRED OB) (SHAREOB1 SORT OB)) 56 | (T 57 | (CONS' (SHAREOB SORT (CAR OB)) (SHAREOB SORT (CDR OB)) OB)))) 58 | EXPR) 59 | 60 | (DEFPROP SHAREOB1 61 | (LAMBDA(SORT OB) 62 | (COND ((DONTSHAREPRED OB) OB) 63 | (T 64 | (SHARECONS' SORT 65 | (SHAREOB1 SORT (CAR OB)) 66 | (SHAREOB1 SORT (CDR OB)) 67 | OB)))) 68 | EXPR) 69 | 70 | (DEFPROP SHAREPRED 71 | (LAMBDA (OB) (DEPTHCHK OB 0 SHAREDEPTH)) 72 | EXPR) 73 | 74 | (DEFPROP DONTSHAREPRED 75 | (LAMBDA (OB) (OR (ATOM OB) (EQ (CAR OB) (QUOTE QUOTE)))) 76 | EXPR) 77 | 78 | (DEFPROP SHARETRIPLE 79 | (LAMBDA(SORT X Y) 80 | (PROG (XREC Z) 81 | (SETQ XREC (ASSOC X (GET SORT (QUOTE SHARETRIPLE)))) 82 | (COND 83 | (XREC 84 | (RETURN 85 | (COND ((ASSOC1 Y (CDR XREC))) 86 | ((SETQ Z (TRIPLE SORT X Y)) 87 | (RPLACD XREC (CONS (CONS Y Z) (CDR XREC))) 88 | Z))))) 89 | (SETQ Z (TRIPLE SORT X Y)) 90 | (ADDPROP SORT (LIST X (CONS Y Z)) (QUOTE SHARETRIPLE)) 91 | (RETURN Z))) 92 | EXPR) 93 | 94 | (DEFPROP DEPTHCHK 95 | (LAMBDA(OB N1 N2) 96 | (COND ((NOT (LESSP N1 N2)) NIL) 97 | ((ATOM OB) N1) 98 | (((LAMBDA (X) (COND (X (DEPTHCHK (CDR OB) (ADD1 X) N2)))) 99 | (DEPTHCHK (CAR OB) N1 N2))))) 100 | EXPR) 101 | -------------------------------------------------------------------------------- /src/simpl: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP MARK 4 | (LAMBDA(vars %TYVL p) 5 | ((LAMBDA (%L) (MARK1 p)) 6 | (MAPCAR (FUNCTION (LAMBDA (X) (varPAIR (QUOTE noninstvar) X))) 7 | vars))) 8 | EXPR) 9 | 10 | (DEFPROP MARK1 11 | (LAMBDA(p) 12 | (SELECTQ 13 | (CAR p) 14 | (const (TRIPLE (QUOTE const) (CADR p) (MARKTY (CDDR p)))) 15 | (var 16 | (COND ((ASSOC1 p %L)) 17 | (T (CDAR (SETQ %L (CONS (varPAIR (QUOTE instvar) p) %L)))))) 18 | (comb (MARK2 p)) 19 | (abs 20 | ((LAMBDA (%L) (MARK2 p)) 21 | (CONS (varPAIR (QUOTE bvar) (CAADR p)) %L))) 22 | (ERROR (QUOTE MARK)))) 23 | EXPR) 24 | 25 | (DEFPROP MARK2 26 | (LAMBDA(p) 27 | (TRIPLE (CAR p) 28 | (CONS (MARK1 (CAADR p)) (MARK1 (CDADR p))) 29 | (MARKTY (CDDR p)))) 30 | EXPR) 31 | 32 | (DEFPROP varPAIR 33 | (LAMBDA (TOK X) (CONS X (TRIPLE TOK X (MARKTY (CDDR X))))) 34 | EXPR) 35 | 36 | (DEFPROP MARKTY 37 | (LAMBDA (TY) (CONSMONOP (MTY TY) TY)) 38 | EXPR) 39 | 40 | (DEFPROP CONSMONOP 41 | (LAMBDA(MTY TY) 42 | (COND ((EQ MTY (QUOTE mono)) (CONS (QUOTE mono) TY)) (T MTY))) 43 | EXPR) 44 | 45 | (DEFPROP MTY 46 | (LAMBDA(TY) 47 | (SELECTQ 48 | (CAR TY) 49 | (consttype (QUOTE mono)) 50 | (vartype (COND ((MEMQ TY %TYVL) (QUOTE mono)) (T TY))) 51 | ((sumtype prodtype funtype) 52 | ((LAMBDA(MTY1 MTY2) 53 | (COND ((AND (EQ MTY1 (QUOTE mono)) (EQ MTY2 (QUOTE mono))) 54 | (QUOTE mono)) 55 | (T 56 | (TRIPLE (CAR TY) 57 | (CONSMONOP MTY1 (CADR TY)) 58 | (CONSMONOP MTY2 (CDDR TY)))))) 59 | (MTY (CADR TY)) 60 | (MTY (CDDR TY)))) 61 | (ERROR (QUOTE MARKTY)))) 62 | EXPR) 63 | 64 | (DEFPROP ISMONO 65 | (LAMBDA (p) (EQ (CADDR p) (QUOTE mono))) 66 | EXPR) 67 | 68 | (DEFPROP MATCH 69 | (LAMBDA(p t) 70 | (SELECTQ 71 | (CAR p) 72 | (const (AND (EQ (CADR p) (CADR t)) (TYMATCH (CDDR p) (CDDR t)))) 73 | (comb 74 | (AND (EQ (CAR t) (QUOTE comb)) 75 | (OR (NOT (ISMONO p)) (EQ (CDDDR p) (CDDR t))) 76 | (MATCH (CAADR p) (CAADR t)) 77 | (MATCH (CDADR p) (CDADR t)))) 78 | (abs 79 | (AND (EQ (CAR t) (QUOTE abs)) 80 | (COND ((ISMONO p) (EQ (CDDDR p) (CDDR t))) 81 | (T (TYMATCH (CDDR (CAADR p)) (CDDR (CAADR t))))) 82 | ((LAMBDA (BVPAIRS CBL) (MATCH (CDADR p) (CDADR t))) 83 | (CONS (CONS (CAADR p) (CAADR t)) BVPAIRS) 84 | (CONS (CAADR t) CBL)))) 85 | (bvar (EQ (ASSOC p BVPAIRS) (REVASSOC t BVPAIRS))) 86 | (noninstvar (AND (EQ (CADR p) t) (NOT (MEMQ t CBL)))) 87 | (instvar 88 | (COND 89 | ((NOT (FREEIN CBL t)) 90 | ((LAMBDA(u) 91 | (COND 92 | (u (ALPHACONV t u)) 93 | ((TYMATCH (CDDR p) (CDDR t)) 94 | (SETQ INSTLIST (CONS (CONS t p) INSTLIST))))) 95 | (REVASSOC1 p INSTLIST))))) 96 | (ERROR (QUOTE MATCH)))) 97 | EXPR) 98 | 99 | (DEFPROP TYMATCH 100 | (LAMBDA(MTY TY) 101 | (SELECTQ 102 | (CAR MTY) 103 | (mono (EQ (CDR MTY) TY)) 104 | (vartype 105 | ((LAMBDA(TY') 106 | (COND (TY' (EQ TY TY')) 107 | (T (SETQ INSTTYLIST (CONS (CONS TY MTY) INSTTYLIST))))) 108 | (REVASSOC1 MTY INSTTYLIST))) 109 | (sumtype (TYMATCH2 (CDR MTY) (destsumtype TY))) 110 | (prodtype (TYMATCH2 (CDR MTY) (destprodtype TY))) 111 | (funtype (TYMATCH2 (CDR MTY) (destfuntype TY))) 112 | (ERROR (QUOTE TYMATCH)))) 113 | EXPR) 114 | 115 | (DEFPROP TYMATCH2 116 | (LAMBDA(X Y) 117 | (AND (TYMATCH (CAR X) (CAR Y)) (TYMATCH (CDR X) (CDR Y)))) 118 | EXPR) 119 | 120 | (DEFPROP MATCHFN 121 | (LAMBDA(%E) 122 | (PROG (INSTLIST INSTTYLIST BVPAIRS CBL) 123 | (OR (MATCH (CDR %E) (CAR %E)) (ERR (QUOTE termmatch))) 124 | (MAPC 125 | (FUNCTION 126 | (LAMBDA(tp) 127 | (RPLACD 128 | tp 129 | ((LAMBDA(t x) 130 | (COND ((eqtype t x) x) 131 | (T (mkvar (CADR (variant x NIL)) (CDDR t))))) 132 | (CAR tp) 133 | (CADR (CDR tp)))))) 134 | INSTLIST) 135 | (RETURN (CONS INSTLIST INSTTYLIST)))) 136 | EXPR) 137 | 138 | (DEFPROP MATCHCLOSURE 139 | (LAMBDA(vars tyvars p) 140 | (CONS (FUNCTION MATCHFN) (MARK vars tyvars p))) 141 | EXPR) 142 | -------------------------------------------------------------------------------- /src/simpl.lsp: -------------------------------------------------------------------------------- 1 | (DML' termmatch 2 | 3 3 | MATCHCLOSURE 4 | (((term list) # ((type list) # term)) /-> (term /-> (((term # term) list) # ((type # type) list))))) -------------------------------------------------------------------------------- /src/symbs: -------------------------------------------------------------------------------- 1 | 2 | (SETQ CMNTCHR (QUOTE %)) 3 | (SETQ CTRLDSYM @∧) 4 | 5 | (SETQ SPACE (QUOTE / )) 6 | (SETQ CR @/ 7 | ) 8 | (SETQ LF @/ 9 | ) 10 | (SETQ TAB @/ ) 11 | (SETQ LPAREN @/() 12 | (SETQ RPAREN @/)) 13 | (SETQ PERIOD @/.) 14 | (SETQ COMMA @/,) 15 | (SETQ COLON @/:) 16 | (SETQ SCOLON @/;) 17 | (SETQ LBRKT @/[) 18 | (SETQ RBRKT @/]) 19 | 20 | (SETQ ENDCNRTOK @/") 21 | (SETQ ANTICNRTOK @/↑) 22 | (SETQ CONDLTOK @/=/>) 23 | (SETQ ELSETOK @/|) 24 | (SETQ LAMTOK @/\) 25 | (SETQ EQTOK @/=/=) 26 | (SETQ INEQTOK @/) 36 | (SETQ SUMTOK @/+) 37 | (SETQ PRODTOK @/#) 38 | (SETQ NULLTYPTOK @/.) 39 | 40 | 41 | (SETQ SPECTOKS @(/: /( /) /' /↑ /=/> /, /\ /. /=/= /) 52 | (SETQ PRODSYM @/#) 53 | (SETQ SUMSYM @/+) 54 | (SETQ LISTSYM @list) 55 | (SETQ NULLSYM @/.) 56 | (SETQ CNRSYM @/") 57 | (SETQ ENDCNRSYM @/") 58 | (SETQ QUOTESYM @/`/`) 59 | (SETQ TCNSTSYM @/←) 60 | (SETQ MULSYM @/*) 61 | (SETQ DIVSYM @//) 62 | (SETQ PLUSSYM @/+) 63 | (SETQ MNSSYM @/-) 64 | (SETQ CONCSYM @/@) 65 | (SETQ EQSYM @/=) 66 | (SETQ LTSYM @/<) 67 | (SETQ GTSYM @/>) 68 | (SETQ CONJSYM @/&) 69 | (SETQ DISJSYM @or) 70 | (SETQ CONDLSYM @/=/>) 71 | (SETQ LAMSYM @/\) 72 | (SETQ ASGNSYM @/:/=) 73 | (SETQ LABSYM @/:/:) 74 | (SETQ ELSESYM @/|) 75 | (SETQ TP1SYM @/?) 76 | (SETQ TP3SYM @/?/?) 77 | (SETQ TP5SYM @/?/\) 78 | (SETQ TP2SYM @/!) 79 | (SETQ TP4SYM @/!/!) 80 | (SETQ TP6SYM @/!/\) 81 | 82 | (SETQ TPSYMS (LIST TP1SYM TP2SYM TP3SYM TP4SYM TP5SYM TP6SYM)) 83 | 84 | 85 | (SETQ SPECSYMS @(/: /( /) /# /-/> /, /. /[ /] /; /;/; /:/= /:/: /| 86 | /" /% /$ /` /`/` /← /* // /+ /- /@ /= /< /> /& /=/> /\ 87 | /? /?/? /?/\ /! /!/! /!\)) 88 | 89 | (SETQ RSVDWDS @(let letref letrec 90 | deftype lettype letrectype abstype absrectype 91 | where whereref whererec and with in 92 | fail failwith or not 93 | test then loop else)) 94 | 95 | 96 | 97 | (SETQ TERMCONSTRS @(mk=vartok mk=consttok mk=comb mk=pair mk=abs 98 | mk=empty mk=cond mk=typed)) 99 | 100 | (SETQ WFFCONSTRS @(mk=equiv mk=inequiv mk=imp mk=conj mk=quant 101 | mk=truth)) 102 | 103 | (SETQ DECLNCONSTRS @(MK-LET MK-LETREC MK-LETREF MK-DEFTYPE 104 | MK-DEFRECTYPE MK-ABSTYPE MK-ABSRECTYPE)) 105 | 106 | (SETQ EXPRCONSTRS @(MK-BOOLCONST MK-INTCONST MK-TOKCONST MK-VAR 107 | MK-APPN MK-ABSTR MK-DUPL MK-EMPTY MK-NIL MK-CONDE 108 | MK-FAIL MK-BINOP MK-UNOP 109 | MK-ASSIGN MK-LIST MK-SEQ MK-DO MK-TRAP MK-TEST 110 | MK-STRAINT MK-IN MK-IND MK-QUOT MK-TYQUOT)) 111 | 112 | 113 | (SETQ TOKBEARER @"") 114 | (SETQ TOKLBEARER @"") 115 | (SETQ NILREP @/%NIL) 116 | (SETQ LASTVALNAME @it) 117 | (SETQ LINKCOUNT 0) 118 | (SETQ PPSYM @" ... ") 119 | -------------------------------------------------------------------------------- /src/tac.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | deftype goal = form # ( simpset # form list) 5 | and proof = thm list -> thm ;; 6 | 7 | deftype tactic = goal -> goal list # proof ;; 8 | 9 | let CASESTAC tm :tactic (fm,ss,fml) = 10 | (let asstt,assff,assuu = eqtt tm, eqff tm, equu tm in 11 | ([fm, ssadd(ASSUME asstt)ss, asstt.fml 12 | ;fm, ssadd(ASSUME assff)ss, assff.fml 13 | ;fm, ssadd(ASSUME assuu)ss, assuu.fml 14 | ], 15 | (CASES tm o threeof) 16 | )) ? failwith `CASESTAC` ;; 17 | 18 | let findterminterm p = 19 | letrec findtm tm = 20 | p tm => tm | 21 | ((let (),tm = destabs tm in findtm tm ) 22 | ?? ``destabs`` 23 | ((let tm,tm'= destcomb tm in (findtm tm ? findtm tm') ) 24 | ?? ``destcomb`` 25 | failwith `findterminterm` 26 | )) 27 | in findtm ;; 28 | 29 | let findterminform p = 30 | letrec findtm fm = 31 | ((let (),fm = destquant fm in findtm fm) 32 | ?? ``destquant`` 33 | ((let fm,fm' = destimp fm ? destconj fm in(findtm fm ? findtm fm')) 34 | ?? ``destconj`` 35 | let tm,tm' = destequiv fm ? destinequiv fm in 36 | (findterminterm p tm ? findterminterm p tm') 37 | ) 38 | ) ? failwith `findterminform` 39 | in findtm;; 40 | 41 | let ANYCASESTAC :tactic (fm, ss,fml) = 42 | let tm = findterminform(\tm. typeof tm = ":TR" & freeinform[tm]fm)fm 43 | ? failwith `ANYCASESTAC` 44 | in CASESTAC tm (fm, ss,fml) ;; 45 | 46 | 47 | let GENTAC:tactic (fm, ss,fml) = 48 | let x,fm' = destquant fm ? failwith `GENTAC` in 49 | let x' = variant(x, formlfrees(fm.fml)) in 50 | ( [ substinform[x',x]fm', ss,fml ] , (GEN x' o hd) ) ;; 51 | 52 | 53 | let SIMPTAC:tactic (fm, ss,fml) = 54 | let fm',(),pr' = simpform ss fm in 55 | (fm'="TRUTH" 56 | => ( [], K(pr' AXTRUTH) ) 57 | | ( [ fm', ss,fml ] , (pr' o hd) ) 58 | ) ;; 59 | 60 | 61 | let GSUBSTAC substfn thl :tactic (fm,ss,fml) = 62 | let thxl = thxpairs thl in 63 | let w = substfn (xlhspairs thxl) fm in 64 | [ substinform(rhsxpairs thxl)w, ss,fml ] , 65 | (SUBST(map(SYM # I)thxl)w o hd) ;; 66 | 67 | let SUBSTAC thl g = GSUBSTAC substinform thl g ? failwith `SUBSTAC` 68 | 69 | and SUBSOCCSTAC nlthl g = 70 | let nll,thl = split nlthl in 71 | GSUBSTAC (suboccs nll) thl g ? failwith `SUBSOCCSTAC` ;; 72 | 73 | % Alternative definitions: 74 | 75 | let SUBSTAC thl (fm,ss,fml) = 76 | (let fm' = substinform(map equivpair thl)fm in 77 | [fm',ss,fml], (SUBS(map SYM thl) o hd) 78 | ) ? failwith `SUBSTAC` 79 | 80 | and SUBSOCCSTAC nlthl (fm,ss,fml) = 81 | (let nll,thl = split nlthl in 82 | let fm' = suboccs nll (map equivpair thl fm in 83 | [fm',ss,fml], (SUBSOCCS(map(I # SYM)nlthl) o hd) ;; 84 | % 85 | 86 | 87 | 88 | letref genindvarprefix = `INDVAR` ;; 89 | 90 | let genindvar(n,ty) = mkvar(juxt(genindvarprefix,tokofint n), ty) ;; 91 | 92 | let GINDUCTAC substfn thl :tactic (fm,ss,fml) = 93 | let goalfrees = formlfrees(fm.fml) 94 | in 95 | let x'of = letref n=0 in 96 | \t.(n := n+1 ; 97 | let x = isvar t => t | genindvar(n,typeof t) 98 | in variant(x,goalfrees) ) 99 | in 100 | let thx'l = map (\th.(th, x'of(lhs(concl th)))) thl 101 | in 102 | let fm' = substfn (xlhspairs thx'l) fm 103 | and funx'l = map (\(th,x').(funof th, x')) thx'l 104 | where funof th = 105 | let fix,fun = destcomb(snd(destequiv(concl th))) 106 | in fst(destconst fix)=`FIX` => fun | fail 107 | in 108 | [ substinform(uupairs funx'l)fm', ss, fml 109 | ; substinform(steppairs funx'l)fm', ss, fm'.fml 110 | ] , 111 | (SUBST(map(SYM # I)thx'l)fm' o INDUCT funx'l fm' o twoof) ;; 112 | 113 | let INDUCTAC thl g = GINDUCTAC substinform thl g ? failwith `INDUCTAC` 114 | 115 | and INDUCOCCSTAC nlthl g = 116 | let nll,thl = split nlthl in 117 | GINDUCTAC (suboccs nll) thl g ? failwith `INDUCOCCSTACS` ;; 118 | -------------------------------------------------------------------------------- /src/tcl.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | 5 | letrec chop(n,l) = n=0 => (nil,l) 6 | | let m,l' = chop(n-1, tl l) in hd l . m , l' ;; 7 | 8 | letrec mapshape nl fl l = null nl => nil 9 | | let m,l = chop(hd nl,l) in (hd fl)m . mapshape(tl nl)(tl fl)l ;; 10 | 11 | mlinfix`THEN` ;; 12 | mlinfix`THENL` ;; 13 | mlinfix`ORELSE` ;; 14 | 15 | let $THEN (f1,f2) g = 16 | let gl,p=f1 g in 17 | let gll,pl = split(map f2 gl) in 18 | flat gll , (p o mapshape(map length gll)pl) ;; 19 | 20 | let $THENL (f1,f2l) g = 21 | let gl,p = f1 g in 22 | let gll,pl = split(map (\(f2,g).f2 g) f2gl) 23 | where f2gl = combine(f2l,gl) ? failwith `THENL` 24 | in 25 | flat gll , (p o mapshape(map length gll)pl) ;; 26 | 27 | let $ORELSE (f1,f2) g = f1 g ? f2 g ;; 28 | 29 | let IDTAC g = [g],hd;; 30 | 31 | letrec REPEAT f g = ((f THEN REPEAT f) ORELSE IDTAC ) g ;; 32 | -------------------------------------------------------------------------------- /src/thyfns.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE easytype) 1 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE easytype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 3 | (PUTPROP (QUOTE finitetype) 1 (QUOTE NUMARGS)) 4 | (PUTPROP (QUOTE finitetype) (MKTIDY (QUOTE (type /-> bool))) (QUOTE MLTYPE)) 5 | (SETQ COR (SETQ DASH (QUOTE /-))) 6 | (PUTPROP (QUOTE draftin) 1 (QUOTE NUMARGS)) 7 | (PUTPROP (QUOTE draftin) (MKTIDY (QUOTE (token /-> /.))) (QUOTE MLTYPE)) 8 | (PUTPROP (QUOTE newparent) 1 (QUOTE NUMARGS)) 9 | (PUTPROP (QUOTE newparent) (MKTIDY (QUOTE (token /-> /.))) (QUOTE MLTYPE)) 10 | (PUTPROP (QUOTE newtypes) 1 (QUOTE NUMARGS)) 11 | (PUTPROP (QUOTE newtypes) (MKTIDY (QUOTE (((token list) list) /-> /.))) (QUOTE MLTYPE)) 12 | (PUTPROP (QUOTE newconstant) 2 (QUOTE NUMARGS)) 13 | (PUTPROP (QUOTE newconstant) (MKTIDY (QUOTE ((token # type) /-> /.))) (QUOTE MLTYPE)) 14 | (PUTPROP (QUOTE newolinfix) 2 (QUOTE NUMARGS)) 15 | (PUTPROP (QUOTE newolinfix) (MKTIDY (QUOTE ((token # type) /-> /.))) (QUOTE MLTYPE)) 16 | (PUTPROP (QUOTE newolcinfix) 2 (QUOTE NUMARGS)) 17 | (PUTPROP (QUOTE newolcinfix) (MKTIDY (QUOTE ((token # type) /-> /.))) (QUOTE MLTYPE)) 18 | (PUTPROP (QUOTE NEWAXIOMS) 0 (QUOTE NUMARGS)) 19 | (PUTPROP (QUOTE NEWAXIOMS) (MKTIDY (QUOTE (/. /-> /.))) (QUOTE MLTYPE)) 20 | (PUTPROP (QUOTE newaxiom) 2 (QUOTE NUMARGS)) 21 | (PUTPROP (QUOTE newaxiom) (MKTIDY (QUOTE ((token # form) /-> thm))) (QUOTE MLTYPE)) 22 | (PUTPROP (QUOTE newfact) 2 (QUOTE NUMARGS)) 23 | (PUTPROP (QUOTE newfact) (MKTIDY (QUOTE ((token # thm) /-> thm))) (QUOTE MLTYPE)) 24 | (PUTPROP (QUOTE AXIOM) 2 (QUOTE NUMARGS)) 25 | (PUTPROP (QUOTE AXIOM) (MKTIDY (QUOTE ((token # token) /-> thm))) (QUOTE MLTYPE)) 26 | (PUTPROP (QUOTE FACT) 2 (QUOTE NUMARGS)) 27 | (PUTPROP (QUOTE FACT) (MKTIDY (QUOTE ((token # token) /-> thm))) (QUOTE MLTYPE)) 28 | (PUTPROP (QUOTE firm) 0 (QUOTE NUMARGS)) 29 | (PUTPROP (QUOTE firm) (MKTIDY (QUOTE (/. /-> /.))) (QUOTE MLTYPE)) 30 | (PUTPROP (QUOTE maketheory) 1 (QUOTE NUMARGS)) 31 | (PUTPROP (QUOTE maketheory) (MKTIDY (QUOTE (token /-> /.))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/thyfns.ml: -------------------------------------------------------------------------------- 1 | 2 | (TML) 3 | 4 | let AXIOM tok1 tok2 = AXIOM(tok1,tok2);; 5 | let FACT tok1 tok2 = FACT (tok1,tok2);; 6 | 7 | -------------------------------------------------------------------------------- /src/tml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP RCONS 4 | (LAMBDA (X R) (RCONS2 X (RCONS1 R))) 5 | EXPR) 6 | 7 | (DEFPROP RCONS1 8 | (LAMBDA(R) 9 | (COND ((ATOM R) (ERROR (QUOTE "BAD TOP/-LEVEL ENV"))) 10 | ((FULL (CAR R) (CAR R)) (CONS (CONS SECRET (CAR R)) (CDR R))) 11 | (T R))) 12 | EXPR) 13 | 14 | (DEFPROP FULL 15 | (LAMBDA(Y Z) 16 | (COND ((OR (ATOM Y) (ATOM Z)) (NOT (EQ Y SECRET))) 17 | ((FULL (CAR Y) (CDR Z))))) 18 | EXPR) 19 | 20 | (DEFPROP RCONS2 21 | (LAMBDA(X R) 22 | (PROG (Y YD Z ZD) 23 | (SETQ Y (SETQ YD (CAR R))) 24 | L (COND ((ATOM YD) (GO M))) 25 | (COND ((EQ (CAR Y) SECRET) 26 | (SETQ Z Y) 27 | (SETQ ZD YD) 28 | (SETQ Y (CDR Y))) 29 | (T (SETQ Y (CAR Y)))) 30 | (SETQ YD (CDR YD)) 31 | (GO L) 32 | M (SETQ ZD (CDR ZD)) 33 | (COND ((ATOM ZD) (RPLACA Z X) (RETURN R))) 34 | (SETQ X (CONS SECRET X)) 35 | (GO M))) 36 | EXPR) 37 | 38 | (DEFPROP DECPT 39 | (LAMBDA NIL 40 | (MEMQ (CAR %PT) 41 | (QUOTE 42 | (MK/-LET MK/-LETREF MK/-LETREC MK/-ABSTYPE MK/-ABSRECTYPE)))) 43 | EXPR) 44 | 45 | (DEFPROP DEFTYPT 46 | (LAMBDA NIL (EQ (CAR %PT) (QUOTE MK/-DEFTYPE))) 47 | EXPR) 48 | 49 | (DEFPROP MLEVAL 50 | (LAMBDA(%PR) 51 | (PROG (V) 52 | (SETQ V ((LAMBDA (%E) (EVAL %PR)) %%E)) 53 | (UPDATETYPES) 54 | (COND ((DEFTYPT)) 55 | ((DECPT) (SETQ V (CONS (BVPAT %PT) V)) 56 | (SETQ %%P (RCONS (CAR V) %%P)) 57 | (SETQ %%E (RCONS (CDR V) %%E))) 58 | (T (PUTPROP LASTVALNAME V (QUOTE MLVAL)) 59 | (PUTPROP LASTVALNAME %TY (QUOTE MLTYPE)))) 60 | (RETURN V))) 61 | EXPR) 62 | 63 | (DEFPROP TML 64 | (LAMBDA NIL 65 | (PROG (B) 66 | (INITFN 67 | (FUNCTION (LAMBDA NIL (PROG2 (PROMPT 52) (INITFN NIL))))) 68 | (PROMPT 43) 69 | (SETQ B (ERRSET (TMLLOOPBODY))) 70 | (PROMPT 52) 71 | (INITFN NIL) 72 | (ERR B))) 73 | EXPR) 74 | 75 | (DEFPROP TMLTILLEOF 76 | (LAMBDA NIL (OR (EQ (ERRSET (TMLLOOP)) (QUOTE $EOF$)) (ERR %F))) 77 | EXPR) 78 | 79 | (DEFPROP TMLLOOP 80 | (LAMBDA NIL (PROG (%PT %TY %PR %VAL) (TMLLOOPBODY))) 81 | EXPR) 82 | 83 | (DEFPROP TMLLOOPBODY 84 | (LAMBDA NIL 85 | (PROG (IBASE BASE *NOPOINT) 86 | (SETQ IBASE 12) 87 | (SETQ BASE 12) 88 | (SETQ *NOPOINT T) 89 | L (AND PRFLAG (TOP%F) (TERPRI)) 90 | (AND (TOP1 (FUNCTION PARSEML)) (TOP%F) (PRML1)) 91 | (GO L))) 92 | EXPR) 93 | 94 | (DEFPROP TOP%F 95 | (LAMBDA NIL (MEMQ %F (QUOTE (NIL mlin)))) 96 | EXPR) 97 | 98 | (DEFPROP THEORYLD%F 99 | (LAMBDA NIL (MEMQ %F (QUOTE (newparent draftin)))) 100 | EXPR) 101 | 102 | (DEFPROP READQUOT 103 | (LAMBDA NIL 104 | (PROG (%PT %TY %PR %VAL) 105 | (COND ((NOT (EQ (READCH) (QUOTE /"))) 106 | (ERROR (QUOTE READQUOT))) 107 | ((TOP1 (FUNCTION PARSEQUOT)) (RETURN (CONS %VAL %TY))) 108 | ((ERR (QUOTE READOL)))))) 109 | EXPR) 110 | 111 | (DEFPROP PARSEQUOT 112 | (LAMBDA (N) (LIST (QUOTE MK/-QUOT) (PARSEOL N))) 113 | EXPR) 114 | 115 | (DEFPROP PRML1 116 | (LAMBDA NIL 117 | (COND ((NULL PRFLAG) (PRINC (QUOTE /.))) 118 | ((DEFTYPT)) 119 | ((DECPT) (PRLET (CAR %VAL) (CDR %VAL) %TY)) 120 | (T (PRVALTY %VAL %TY)))) 121 | EXPR) 122 | 123 | (DEFPROP TOP1 124 | (LAMBDA(PARSEFN) 125 | (PROG2 (INITLEAN) 126 | (AND ((LAMBDA(B) 127 | (COND ((NOT (ATOM B))) 128 | ((EQ B CTRLDSYM) NIL) 129 | ((ERR B)))) 130 | (ERRSET (GNT))) 131 | (ERRTRAP (QUOTE %PT) PARSEFN 0) 132 | (OR (NOT (ISTMLOP %PT)) 133 | (PROG2 (ERRTRAP (QUOTE %VAL) (FUNCTION EVTMLOP) %PT) 134 | NIL)) 135 | (OR (THEORYLD%F) 136 | (ERRTRAP (QUOTE %TY) (FUNCTION TYPECHECK) %PT)) 137 | (ERRTRAP (QUOTE %PR) (FUNCTION TRAN) %PT) 138 | (ERRTRAP (QUOTE %VAL) (FUNCTION MLEVAL) %PR)))) 139 | EXPR) 140 | 141 | (DEFPROP ERRTRAP 142 | (LAMBDA(ID %FN %ARG) 143 | (PROG (B) 144 | (SETQ B (ERRSET (APPLY %FN (LIST %ARG)))) 145 | (COND ((NOT (ATOM B)) (SET ID (CAR B)) (RETURN T)) 146 | ((AND (EQ ID (QUOTE %PT)) (EQ B CTRLDSYM)) (RETURN NIL)) 147 | ((THEORYLD%F) (ERR (SELECTQ B ($EOF$ B) %F))) 148 | ((EQ %F (QUOTE mlin)) 149 | (AND (EQ B (QUOTE mlin)) (ERR B)))) 150 | (PRINC 151 | (ASSOC1 ID 152 | (QUOTE 153 | ((%PT . PARSE) (%TY . TYPECHECK) 154 | (%PR . TRANSLATION) 155 | (%VAL . EVALUATION))))) 156 | (PRINX (QUOTE / FAILED/ ) (AND B (PRINC B))) 157 | (AND (EQ %F (QUOTE mlin)) 158 | (ERR (PRINC (QUOTE / DURING/ mlin/ )))) 159 | (TERPRI))) 160 | EXPR) 161 | 162 | (DEFPROP ISTMLOP 163 | (LAMBDA (%PT) (GET (CAR %PT) (QUOTE TMLOP))) 164 | EXPR) 165 | 166 | (DEFPROP EVTMLOP 167 | (LAMBDA(%PT) 168 | (SELECTQ 169 | (CAR %PT) 170 | (MK/-BEGIN 171 | (begin (COND ((NULL (CDR %PT)) (QUOTE %NONAME)) ((CADR %PT))))) 172 | (MK/-END 173 | (end 174 | (COND ((NULL (CDR %PT)) 175 | (COND (%DUMP (CDAR %DUMP)) ((ERR (QUOTE end))))) 176 | ((ASSOC1 (CADR %PT) %DUMP)) 177 | ((ERR (JUXT (QUOTE end/ ) (CADR %PT))))))) 178 | (ERROR (CONS (CAR %PT) (QUOTE (NOT A TMLOP)))))) 179 | EXPR) 180 | 181 | (DEFPROP begin 182 | (LAMBDA(TOK) 183 | (PROG NIL 184 | (PUSHQ (LIST TOK %SECTIONS %%P %%E %EMT %TEMT %DUMP) %DUMP) 185 | (SETQ %SECTIONS T) 186 | (SETQ %%P (CONS INITSECTION %%P)) 187 | (SETQ %%E (CONS INITSECTION %%E)))) 188 | EXPR) 189 | 190 | (DEFPROP end 191 | (LAMBDA(SEC) 192 | (PROG (TENV) 193 | (SETQ TENV (CAR (CDDDDR SEC))) 194 | (COND 195 | ((ATOM 196 | (ERRSET (ABSSCOPECHK (GET LASTVALNAME (QUOTE MLTYPE))))) 197 | (ERR (QUOTE end)))) 198 | (SETQ %SECTIONS (CAR SEC)) 199 | (SETQ %%P (CADR SEC)) 200 | (SETQ %%E (CADDR SEC)) 201 | (SETQ %EMT (CADDDR SEC)) 202 | (SETQ %TEMT (CAR (CDDDDR SEC))) 203 | (SETQ %DUMP (CADR (CDDDDR SEC))))) 204 | EXPR) 205 | -------------------------------------------------------------------------------- /src/tml.lsp: -------------------------------------------------------------------------------- 1 | (SETQ INITSECTION (QUOTE %MUSTBEATOM)) 2 | (SETQ %%P (SETQ %%E (SETQ INITENV (CONS INITSECTION NILL)))) 3 | (SETQ SECRET (ASCII 52)) 4 | (DEFPROP MK/-BEGIN begin TMLOP) 5 | (DEFPROP MK/-END end TMLOP) 6 | (SETQ %DUMP NIL) -------------------------------------------------------------------------------- /src/tmlini: -------------------------------------------------------------------------------- 1 | 2 | (DE TML () (PROG () 3 | (TERPRI) 4 | (PRINC 5 | @"LCF version 5 issued 27-oct-77 6 | (with simultaneous substitution and new simplification)" ) 7 | (TERPRI) (TERPRI) 8 | (INITC) 9 | (REMPROP @TML @EXPR) 10 | (TML) 11 | )) 12 | 13 | (INITFN NIL) 14 | -------------------------------------------------------------------------------- /src/trace.lsp: -------------------------------------------------------------------------------- 1 | (SETQ TRACELIST NIL) 2 | (PUTPROP (QUOTE TRACE) 1 (QUOTE NUMARGS)) 3 | (PUTPROP (QUOTE TRACE) 4 | (MKTIDY (QUOTE (((%a /-> %b) /-> ((%a /-> %b) # %c)) /-> ((%a /-> %b) /-> %c)))) 5 | (QUOTE MLTYPE)) 6 | (PUTPROP (QUOTE UNTRACE) 1 (QUOTE NUMARGS)) 7 | (PUTPROP (QUOTE UNTRACE) (MKTIDY (QUOTE ((%a /-> %b) /-> bool))) (QUOTE MLTYPE)) -------------------------------------------------------------------------------- /src/tran.lsp: -------------------------------------------------------------------------------- 1 | (SETQ ISOMCLOSURE (CONS (FUNCTION CAR) (QUOTE ISOMCLOSURE))) 2 | (SETQ ISOM (QUOTE %ISOM)) 3 | (SETQ DUMMY (QUOTE %DUMMY)) 4 | (SETQ EMPTY (QUOTE %EMPTY)) 5 | (SETQ NILL (QUOTE %NIL)) 6 | (SETQ TZERO 7 | (QUOTE 8 | (NIL (CAR (CAAR (CAAAR (CAAAAR) (CDAAAR)) (CDAAR (CADAAR) (CDDAAR))) 9 | (CDAR (CADAR (CAADAR) (CDADAR)) (CDDAR (CADDAR) (CDDDAR)))) 10 | (CDR (CADR (CAADR (CAAADR) (CDAADR)) (CDADR (CADADR) (CDDADR))) 11 | (CDDR (CADDR (CAADDR) (CDADDR)) (CDDDR (CADDDR) (CDDDDR))))))) -------------------------------------------------------------------------------- /src/typeml.lsp: -------------------------------------------------------------------------------- 1 | (INITMLTYPENV) -------------------------------------------------------------------------------- /src/typeol: -------------------------------------------------------------------------------- 1 | 2 | 3 | (DEFPROP UNIFY 4 | (LAMBDA (TY1 TY2) (UNIFYB (TRUNC TY1) (TRUNC TY2))) 5 | EXPR) 6 | 7 | (DEFPROP UNIFYB 8 | (LAMBDA(BTY1 BTY2) 9 | (COND ((EQUAL BTY1 BTY2)) 10 | ((EQ (CAR BTY1) (QUOTE link)) 11 | (COND ((OCCB BTY1 BTY2) NIL) ((RPLACD BTY1 BTY2)))) 12 | ((EQ (CAR BTY2) (QUOTE link)) 13 | (COND ((OCCB BTY2 BTY1) NIL) ((RPLACD BTY2 BTY1)))) 14 | ((EQ (CAR BTY1) (CAR BTY2)) 15 | (SELECTQ (CAR BTY1) 16 | ((consttype vartype) (EQ (CDR BTY1) (CDR BTY2))) 17 | (AND (UNIFY (CADR BTY1) (CADR BTY2)) 18 | (UNIFY (CDDR BTY1) (CDDR BTY2))))) 19 | ((EQ (CAR BTY1) (QUOTE consttype)) 20 | ((LAMBDA (BTY) (AND BTY (UNIFYB BTY BTY2))) 21 | (GET (CDR BTY1) (QUOTE EQTYPE)))) 22 | ((EQ (CAR BTY2) (QUOTE consttype)) 23 | ((LAMBDA (BTY) (AND BTY (UNIFYB BTY1 BTY))) 24 | (GET (CDR BTY2) (QUOTE EQTYPE)))))) 25 | EXPR) 26 | 27 | (DEFPROP TRUNC 28 | (LAMBDA(TY) 29 | (COND ((AND (EQ (CAR TY) (QUOTE link)) (NOT (ATOM (CDR TY)))) 30 | (TRUNC (CDR TY))) 31 | (TY))) 32 | EXPR) 33 | 34 | (DEFPROP OCC 35 | (LAMBDA (V TY) (OCCB V (TRUNC TY))) 36 | EXPR) 37 | 38 | (DEFPROP OCCB 39 | (LAMBDA(V BTY) 40 | (OR (EQ V BTY) 41 | (SELECTQ (CAR BTY) 42 | ((link consttype vartype) NIL) 43 | (OR (OCC V (CADR BTY)) (OCC V (CDDR BTY)))))) 44 | EXPR) 45 | 46 | (DEFPROP QUOTCH 47 | (LAMBDA(%OB) 48 | (PROG (X %BVL %VTYL) 49 | (SETQ X (QTRAP (ERRSET (QTCH (EVAL (CAR %OB)))))) 50 | (MAPC (FUNCTION 51 | (LAMBDA(VTY) 52 | (OR (GET (CAR VTY) (QUOTE STICKYTYPE)) 53 | (PUTPROP (CAR VTY) 54 | (CANONTY (CDR VTY)) 55 | (QUOTE STICKYTYPE))))) 56 | %VTYL) 57 | (RETURN X))) 58 | FEXPR) 59 | 60 | (DEFPROP TYQUOTCH 61 | (LAMBDA (%OB) (QTRAP (ERRSET (EVAL (CAR %OB))))) 62 | FEXPR) 63 | 64 | (DEFPROP QTRAP 65 | (LAMBDA(X) 66 | (COND ((ATOM X) (ERR (JUXT X (QUOTE / IN/ QUOTATION)))) ((CAR X)))) 67 | EXPR) 68 | 69 | (DEFPROP QTCH 70 | (LAMBDA(OB) 71 | (SELECTQ (CAR OB) 72 | (antiquot (CDR OB)) 73 | ((quant imp conj equiv inequiv) 74 | (TRIPLE (CAR OB) (QTCH (CADR OB)) (QTCH (CDDR OB)))) 75 | (truth OB) 76 | ((abs comb) 77 | (TRIPLE (CAR OB) 78 | (CONS (QTCH (CAADR OB)) (QTCH (CDADR OB))) 79 | (CANONTY (CDDR OB)))) 80 | (var (mkrealvar (CADR OB) (CANONTY (CDDR OB)))) 81 | (const (mkconst (CADR OB) (CANONTY (CDDR OB)))) 82 | (ERR (QUOTE JUNKOB)))) 83 | EXPR) 84 | 85 | (DEFPROP CANONTY 86 | (LAMBDA(TY) 87 | (SELECTQ (CAR TY) 88 | (link 89 | (COND ((ATOM (CDR TY)) (ERR (QUOTE TYPES/ INDETERMINATE))) 90 | ((CANONTY (CDR TY))))) 91 | ((consttype vartype) TY) 92 | ((sumtype prodtype funtype) 93 | (mktype (CAR TY) (CANONTY (CADR TY)) (CANONTY (CDDR TY)))) 94 | (ERR (QUOTE JUNKTYPE)))) 95 | EXPR) 96 | 97 | (DEFPROP OMUTANT 98 | (LAMBDA (TY) (PROG (%L) (RETURN (OMUTANT1 TY)))) 99 | EXPR) 100 | 101 | (DEFPROP OMUTANT1 102 | (LAMBDA(TY) 103 | (SELECTQ 104 | (CAR TY) 105 | (vartype 106 | (COND ((ASSOC1 TY %L)) ((CDAR (PUSHQ (CONS TY (GENLINK)) %L))))) 107 | ((vartype consttype) TY) 108 | (TRIPLE (CAR TY) (OMUTANT1 (CADR TY)) (OMUTANT1 (CDDR TY))))) 109 | EXPR) 110 | -------------------------------------------------------------------------------- /src/writml.lsp: -------------------------------------------------------------------------------- 1 | (PUTPROP (QUOTE typemode) 1 (QUOTE NUMARGS)) 2 | (PUTPROP (QUOTE typemode) (MKTIDY (QUOTE (bool /-> bool))) (QUOTE MLTYPE)) 3 | (PUTPROP (QUOTE printint) 1 (QUOTE NUMARGS)) 4 | (PUTPROP (QUOTE printint) (MKTIDY (QUOTE (int /-> int))) (QUOTE MLTYPE)) 5 | (PUTPROP (QUOTE printtok) 1 (QUOTE NUMARGS)) 6 | (PUTPROP (QUOTE printtok) (MKTIDY (QUOTE (token /-> token))) (QUOTE MLTYPE)) 7 | (PUTPROP (QUOTE printbool) 1 (QUOTE NUMARGS)) 8 | (PUTPROP (QUOTE printbool) (MKTIDY (QUOTE (bool /-> bool))) (QUOTE MLTYPE)) 9 | (PUTPROP (QUOTE printdot) 1 (QUOTE NUMARGS)) 10 | (PUTPROP (QUOTE printdot) (MKTIDY (QUOTE (/. /-> /.))) (QUOTE MLTYPE)) 11 | (PUTPROP (QUOTE printterm) 1 (QUOTE NUMARGS)) 12 | (PUTPROP (QUOTE printterm) (MKTIDY (QUOTE (term /-> term))) (QUOTE MLTYPE)) 13 | (PUTPROP (QUOTE printform) 1 (QUOTE NUMARGS)) 14 | (PUTPROP (QUOTE printform) (MKTIDY (QUOTE (form /-> form))) (QUOTE MLTYPE)) 15 | (PUTPROP (QUOTE printthm) 1 (QUOTE NUMARGS)) 16 | (PUTPROP (QUOTE printthm) (MKTIDY (QUOTE (thm /-> thm))) (QUOTE MLTYPE)) 17 | (PUTPROP (QUOTE printtype) 1 (QUOTE NUMARGS)) 18 | (PUTPROP (QUOTE printtype) (MKTIDY (QUOTE (type /-> type))) (QUOTE MLTYPE)) 19 | (MAPCAR (FUNCTION (LAMBDA (X) (PUTPROP (CAR X) (CDR X) (QUOTE CLOSES)))) 20 | (QUOTE 21 | ((imp quant1 imp) (conj quant1 imp) 22 | (pair abs1 pair) 23 | (cond1 cond1) 24 | (cond2 abs1 cond1 pair) 25 | (listcomb abs1 listcomb infcomb cond1 pair typed) 26 | (infcomb abs1 listcomb infcomb cond1 pair typed) 27 | (funtype funtype) 28 | (sumtype sumtype funtype) 29 | (prodtype prodtype sumtype funtype)))) 30 | (MAPCAR (FUNCTION (LAMBDA (X) (PUTPROP (CAR X) (CDR X) (QUOTE PRINFIX)))) 31 | (LIST (CONS (QUOTE typed) COLON) 32 | (CONS (QUOTE quant1) (RSPACED PERIOD)) 33 | (CONS (QUOTE abs1) PERIOD) 34 | (CONS (QUOTE imp) (SPACED IMPTOK)) 35 | (CONS (QUOTE conj) (SPACED CONJTOK)) 36 | (CONS (QUOTE equiv) (SPACED EQTOK)) 37 | (CONS (QUOTE inequiv) (SPACED INEQTOK)) 38 | (CONS (QUOTE pair) (RSPACED COMMA)) 39 | (CONS (QUOTE cond1) CONDLTOK) 40 | (CONS (QUOTE cond2) ELSETOK) 41 | (CONS (QUOTE funtype) ARROWTOK) 42 | (CONS (QUOTE prodtype) PRODTOK) 43 | (CONS (QUOTE sumtype) SUMTOK))) 44 | (SETQ EMPTYPRINT EMPTYTOK) 45 | (SETQ %PRINTTYPES NIL) --------------------------------------------------------------------------------