Skip to content

Commit 312e99b

Browse files
masintermasinter
committed
Add templates for CL:WHEN CL:UNLESS
1 parent 82eaacc commit 312e99b

File tree

2 files changed

+45
-30
lines changed

2 files changed

+45
-30
lines changed

‎library/MSCOMMON‎

Lines changed: 45 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,17 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
2-
(FILECREATED " 4-May-92 13:10:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3| 23489
32

4-
|changes| |to:| (TEMPLATES CL:DECF CL:INCF CL:PUSH)
3+
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
54

6-
|previous| |date:| "12-Jun-90 10:17:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;2|)
5+
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
6+
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
7+
)
8+
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
9+
(VARS MSCOMMONCOMS)
710

11+
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
812

9-
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
13+
14+
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
1015

1116
(PRETTYCOMPRINT MSCOMMONCOMS)
1217

@@ -37,16 +42,16 @@
3742
CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP
3843
CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>=
3944
CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE
40-
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:VECTOR-PUSH
41-
CL:VECTOR-PUSH-EXTEND WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
45+
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:UNLESS CL:VECTOR-PUSH
46+
CL:VECTOR-PUSH-EXTEND CL:WHEN WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
4247
(P
4348
(* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES")
4449

4550
(MSADDANALYZE 'VARIABLES 'VARIABLE 'VARIABLES 'VARIABLESMSGETDEF)
4651
(MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC)
4752

4853
(* |;;|
49-
 "Then add KEYWORD support. Templates may now contain the following as their last element:")
54+
 "Then add KEYWORD support. Templates may now contain the following as their last element:")
5055

5156

5257
(* |;;| "... KEYWORDS list of keywords accepted)")
@@ -65,7 +70,7 @@
6570
(MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY)
6671

6772
(* |;;|
68-
 "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
73+
 "Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
6974

7075
(MSADDRELATION '(FLET FLETS FLETTING FLET))
7176
(MSADDRELATION '(LABEL LABELS LABELLING LABELLED))
@@ -87,42 +92,48 @@
8792
(DEFINEQ
8893

8994
(FUNCTIONSMSGETDEF
90-
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
95+
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
9196
(LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS))))
9297
(AND BODY (SELECTQ (CAR BODY)
9398
(DEFMACRO (OR (GETTEMPLATE NAME)
9499
(SETTEMPLATE NAME 'MACRO))
95100
NIL)
96101
(CL:DEFUN
97-
(* |;;| "Body is of the form:")
98-
(* |;;| "(DEFUN name (args...) bodies...)")
99-
(* |;;| "We want to hand Masterscope a massaged form it will understand.")
100-
(* |;;| "Which I believe is of this form:")
102+
(* |;;| "Body is of the form:")
103+
104+
(* |;;| "(DEFUN name (args...) bodies...)")
105+
106+
(* |;;|
107+
 "We want to hand Masterscope a massaged form it will understand.")
101108

102-
`(CL:LAMBDA ,(CADDR BODY) ,@(CDDDR BODY)))
109+
(* |;;| "Which I believe is of this form:")
110+
111+
`(CL:LAMBDA ,(CADDR BODY)
112+
,@(CDDDR BODY)))
103113
NIL)))))
104114

105115
(FUNCTIONSMSMC
106-
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
107-
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
116+
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
117+
118+
(* |;;| "Trick here is we don't want to mark FUNCTIONS macros as changed because they really don't get analyzed, but we do want to call CHANGEMACRO for them")
108119

109120
(|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR)))
110-
'DEFMACRO)
121+
'DEFMACRO)
111122
|then| (CHANGEMACRO NAME TYPE REASON)
112123
NIL
113124
|else| T)))
114125

115126
(VARIABLESMSGETDEF
116-
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
117-
127+
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
118128
(LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS))
119129
SPECVARP)
120130
(AND BODY
121-
122-
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
131+
132+
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
123133

124134
`(CL:LAMBDA NIL ,(IF (CADDR BODY)
125-
THEN `(SETQ ,(CADR BODY) ,(CADDR BODY))))))))
135+
THEN `(SETQ ,(CADR BODY)
136+
,(CADDR BODY))))))))
126137
)
127138

128139

@@ -162,9 +173,9 @@
162173
:LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE))
163174

164175
(SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT)
165-
NIL))
176+
NIL))
166177
(|..| (IF LISTP ((BOTH BIND COMPILER-LET))
167-
(BOTH BIND COMPILER-LET))))
178+
(BOTH BIND COMPILER-LET))))
168179
|..| EFFECT RETURN))
169180

170181
(SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY))
@@ -179,10 +190,10 @@
179190

180191
(SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
181192
(LOCALVARS '(IF LISTP (|..| LOCALVARS)
182-
LOCALVARS))
193+
LOCALVARS))
183194
((SPECVARS CL:SPECIAL)
184195
'(IF LISTP (|..| SPECVARS)
185-
SPECVARS))
196+
SPECVARS))
186197
NIL)))))
187198

188199
(SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY))
@@ -391,7 +402,7 @@
391402
(SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2))
392403

393404
(SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR)
394-
SET SMASH)))
405+
SET SMASH)))
395406

396407
(SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1
397408
:END2))
@@ -401,7 +412,7 @@
401412
(SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
402413

403414
(SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR)
404-
SET SMASH)
415+
SET SMASH)
405416
EVAL))
406417

407418
(SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY))
@@ -459,10 +470,14 @@
459470

460471
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
461472

473+
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
474+
462475
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
463476

464477
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
465478

479+
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
480+
466481
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
467482
:GENSYM :ARRAY))
468483

@@ -539,6 +554,6 @@
539554
(CLRHASH USERTEMPLATES)
540555
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
541556
(DECLARE\: DONTCOPY
542-
(FILEMAP (NIL (5000 6811 (FUNCTIONSMSGETDEF 5010 . 5804) (FUNCTIONSMSMC 5806 . 6286) (
543-
VARIABLESMSGETDEF 6288 . 6809)))))
557+
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
558+
VARIABLESMSGETDEF 6733 . 7289)))))
544559
STOP

‎library/MSCOMMON.DFASL‎

154 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)