--- /dev/null
+<COND (<LOOKUP "COMPDEC" <MOBLIST PACKAGE!- >>
+ <USE "COMPDEC" "CHKDCL">)>
+
+; "CHKDCL Diagnostic program."
+
+<SETG NUMBER 0>
+
+<DEFINE CHECKIT ('A 'B 'C 'TST OP "AUX" RES)
+ <PRINT <SETG NUMBER <+ ,NUMBER 1>>>
+ <COND (<NOT <APPLY .OP <SET RES <APPLY <EVAL .TST> .A .B>> .C>>
+ <PRINC "Loser: ">
+ <PRIN1 .TST>
+ <PRINC " applied to ">
+ <PRIN1 .A>
+ <PRINC " ">
+ <PRIN1 .B>
+ <PRINC " resulted in ">
+ <PRIN1 .RES>
+ <PRINC " instead of ">
+ <PRIN1 .C>
+ <CRLF>
+ <ERROR>)>>
+
+<CHECKIT FIX FIX FIX ,TYPE-AND ,==?>
+
+<CHECKIT FIX FIX FIX ,TYPE-MERGE ,==?>
+
+<CHECKIT <PRIMTYPE FIX> FIX FIX ,TYPE-AND ,==?>
+
+<CHECKIT <PRIMTYPE FIX> FIX <PRIMTYPE FIX> ,TYPE-MERGE ,=?>
+
+<CHECKIT FIX FLOAT #FALSE () ,TYPE-AND ,==?>
+
+<CHECKIT FIX FLOAT (<OR FIX FLOAT> <OR FLOAT FIX>) ,TYPE-MERGE ,MEMBER>
+
+<CHECKIT <PRIMTYPE VECTOR> <OR FIX <VECTOR FIX>> <VECTOR FIX> ,TYPE-AND ,=?>
+
+<CHECKIT <PRIMTYPE VECTOR> <OR FIX <VECTOR FIX>> (<OR FIX <PRIMTYPE VECTOR>>
+ <OR <PRIMTYPE VECTOR> FIX>)
+ ,TYPE-MERGE ,MEMBER>
+
+<CHECKIT <LIST ANY> <LIST [REST <LIST [REST ATOM]> ATOM]>
+ <LIST <LIST [REST ATOM]> [REST ATOM <LIST [REST ATOM]>]>
+ ,TYPE-AND ,=?>
+
+<CHECKIT <LIST [REST FIX FLOAT]> <LIST [REST FIX ATOM]> #FALSE () ,TYPE-AND ,==?>
+
+<CHECKIT <LIST [REST FIX FLOAT]> <LIST [REST FIX ATOM]>
+ (<LIST [REST FIX <OR ATOM FLOAT>]> <LIST [REST FIX <OR FLOAT ATOM>]>)
+ ,TYPE-MERGE ,MEMBER>
+<CHECKIT <NOT <LIST FIX FIX>> <LIST [2 FIX]> #FALSE () ,TYPE-AND ,==?>
+
+<CHECKIT <NOT <LIST [2 FIX]>> <LIST FIX FIX> #FALSE () ,TYPE-AND ,==?>
+
+<CHECKIT <UVECTOR FIX [REST FIX]> <UVECTOR FIX FIX [REST FIX]> <UVECTOR FIX [REST FIX]>
+ ,TYPE-MERGE ,=?>
+
+<CHECKIT <NOT LIST> <LIST <LIST ANY ANY ANY FIX>> #FALSE () ,TYPE-AND ,==?>
+
+'<CHECKIT STRUCTURED APPLICABLE <OR RSUBR RSUBR-ENTRY FUNCTION> ,TYPE-AND ,=?>
+
+<CHECKIT STRUCTURED APPLICABLE <OR APPLICABLE STRUCTURED> ,TYPE-MERGE ,=?>
+
+<CHECKIT <<OR FALSE LIST> [REST FIX]> <NOT <<OR LIST FALSE> [REST FIX]>> #FALSE ()
+ ,TYPE-AND ,==?>
+
+<CHECKIT <LIST <OR STRING ATOM VECTOR>> <NOT <LIST <OR STRING VECTOR ATOM>>> #FALSE ()
+ ,TYPE-AND ,==?>
+
+<CHECKIT <LIST FIX> <LIST [REST FIX]> (LIST <LIST [OPTIONAL FIX]> <LIST [OPT FIX]>) ,TYPE-MERGE ,MEMBER>
+
+<CHECKIT <LIST FIX> <LIST [REST FIX]> <LIST FIX [REST FIX]> ,TYPE-AND ,=?>
+
+<CHECKIT <OR <LIST [REST <NOT ANY>]>
+ <LIST FIX FLOAT [REST <NOT ANY>]>>
+ <STRUCTURED ANY ANY> <LIST FIX FLOAT [REST <NOT ANY>]> ,TYPE-AND ,=?>
+
+<CHECKIT <OR <LIST [REST <NOT ANY>]>
+ <LIST FIX FLOAT [REST <NOT ANY>]>>
+ <STRUCTURED ANY> <LIST FIX FLOAT [REST <NOT ANY>]> ,TYPE-AND ,=?>
+
+<CHECKIT <OR <LIST [REST <NOT ANY>]>
+ <LIST FIX FLOAT [REST <NOT ANY>]>>
+ <STRUCTURED ANY [REST <NOT ANY>]>
+ #FALSE () ,TYPE-AND ,==?>
+<CHECKIT <OR FIX FALSE LIST> <LIST FIX> <OR FALSE FIX LIST> ,TYPE-MERGE ,=?>
+
+<PUT-DECL STRING '<STRING [REST CHARACTER]>>
+
+<CHECKIT <OR FIX STRING <LIST [REST STRING]>> STRING
+ <OR FIX STRING <LIST [REST STRING]>> ,TYPE-MERGE ,=?>
+
+
+
+<CHECKIT ANY <PRIMTYPE FIX> ANY ,TYPE-MERGE ,=?>
+
+<CHECKIT <PRIMTYPE LIST> <OR <PRIMTYPE ATOM> <PRIMTYPE LIST>>
+ <OR <PRIMTYPE ATOM> <PRIMTYPE LIST>>
+ ,TYPE-MERGE ,=?>
+
+
+<NEWTYPE SPACE VECTOR '<VECTOR <LIST [REST PBLOCK]> WORD WORD WORD LIST>>
+
+<NEWTYPE AREAX VECTOR>
+
+<NEWTYPE PBLOCK VECTOR>
+
+<CHECKIT <OR <AREAX [2 ANY] WORD> <SPACE <LIST [REST PBLOCK]> [3 WORD] LIST>>
+ <OR SPACE AREAX> <OR AREAX SPACE> ,TYPE-MERGE ,=?>
+
+<CHECKIT <OR <VECTOR [REST <OR ATOM FALSE LOSE>]>
+ <VECTOR <OR ATOM FALSE>
+ FIX
+ <OR ATOM FALSE LOSE>
+ FIX
+ [REST <OR ATOM FALSE LOSE>]>>
+ <VECTOR [REST <OR ATOM FALSE LOSE>]>
+ <OR <VECTOR [REST <OR ATOM FALSE LOSE>]>
+ <VECTOR <OR ATOM FALSE>
+ FIX
+ <OR ATOM FALSE LOSE>
+ FIX
+ [REST <OR ATOM FALSE LOSE>]>>
+ ,TYPE-MERGE ,=?>
+
+<CHECKIT <PRIMTYPE LIST> <<PRIMTYPE LIST> ANY> <PRIMTYPE LIST> ,TYPE-MERGE ,=?>
+
+<CHECKIT <VECTOR FIX FIX> <VECTOR FIX FLOAT> <VECTOR FIX <OR FIX FLOAT>>
+ ,TYPE-MERGE ,=?>
+
+<CHECKIT <VECTOR FIX FIX> <VECTOR FLOAT FLOAT>
+ <OR <VECTOR FIX FIX> <VECTOR FLOAT FLOAT>> ,TYPE-MERGE ,=?>
+
+<CHECKIT <OR LIST <VECTOR FIX FIX>> <OR <LIST [2 ANY]> <VECTOR [2 FIX]>>
+ <OR LIST <VECTOR [2 FIX]>> ,TYPE-MERGE ,=?>
+
+<CHECKIT <OR <LIST [2 ANY]> <VECTOR [2 FIX]>> <OR LIST <VECTOR FIX FIX>>
+ <OR LIST <VECTOR [2 FIX]>> ,TYPE-MERGE ,=?>
+
+<PUT-DECL NUMBER '<OR FIX FLOAT>>
+
+<CHECKIT NUMBER FIX <OR FIX FLOAT> ,TYPE-MERGE ,=?>
+
+<CHECKIT FIX NUMBER <OR FIX FLOAT> ,TYPE-MERGE ,=?>
+
+<CHECKIT <LIST FIX FLOAT> <LIST [REST FIX FLOAT]>
+ (LIST <LIST [OPTIONAL FIX FLOAT]>) ,TYPE-MERGE ,MEMBER>
+
+<CHECKIT !<LIST FIX FIX> !<LIST FIX FIX FIX> #FALSE () ,TYPE-AND ,==?>
+
+<CHECKIT !<LIST FIX FIX> <LIST [REST FIX]> !<LIST [2 FIX]> ,TYPE-AND ,=?>
+
+<CHECKIT <LIST [OPT FIX FLOAT]> <LIST [REST FIX FLOAT]> <LIST [OPTIONAL
+ FIX FLOAT]> ,TYPE-MERGE ,=?>
+
+<CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 1 FIX ,GET-ELE-TYPE ,==?>
+
+<CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 2 FLOAT ,GET-ELE-TYPE ,==?>
+
+<CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 3 ATOM ,GET-ELE-TYPE ,==?>
+
+<CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> 4 STRING ,GET-ELE-TYPE ,==?>
+
+<CHECKIT <LIST FIX FLOAT [REST ATOM STRING]> ALL
+ <OR ATOM FIX FLOAT STRING> ,GET-ELE-TYPE ,=?>
+
+<DEFINE GETY (A B) <GET-ELE-TYPE .A .B T>>
+
+%<SETG FOO '<LIST FIX FLOAT [REST ATOM STRING]>>
+
+<CHECKIT %,FOO 1 <LIST FLOAT [REST ATOM STRING]> ,GETY ,=?>
+
+<CHECKIT %,FOO 2 <LIST [REST ATOM STRING]> ,GETY ,=?>
+
+<CHECKIT %,FOO 3 <LIST [REST <OR ATOM STRING>]> ,GETY ,=?>
+
+<CHECKIT %,FOO ALL <LIST [REST <OR ATOM FIX FLOAT STRING>]> ,GETY ,=?>
+\f
+<PUT-DECL VV VECTOR>
+
+<CHECKIT <OR VV FALSE> ANY <OR FALSE VECTOR> ,TYPE-AND ,=?>
+
+
+<PUT-DECL QQ '<VECTOR FIX FIX>>
+
+<CHECKIT <OR QQ FALSE> VECTOR <VECTOR FIX FIX> ,TYPE-AND ,=?>
+
projects / pdp10-muddle.git / blobdiff