X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=mim%2Fdevelopment%2Fmim%2Fmimc%2Fchkdcl.checker;fp=mim%2Fdevelopment%2Fmim%2Fmimc%2Fchkdcl.checker;h=c7a64058efdc285bf244123862a76beb790a2694;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git

diff --git a/mim/development/mim/mimc/chkdcl.checker b/mim/development/mim/mimc/chkdcl.checker
new file mode 100644
index 0000000..c7a6405
--- /dev/null
+++ b/mim/development/mim/mimc/chkdcl.checker
@@ -0,0 +1,187 @@
+<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 ,=?>
+
+<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 ,=?>
+