Add templates for CL:WHEN CL:UNLESS
This commit is contained in:
Larry Masinter
parent
82eaacc542
commit
312e99b0f4
@ -1,12 +1,17 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
(FILECREATED " 4-May-92 13:10:53" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;3| 23489
|
||||
|
||||
|changes| |to:| (TEMPLATES CL:DECF CL:INCF CL:PUSH)
|
||||
(FILECREATED "15-Jan-2022 20:17:21" |{DSK}<home>larry>medley>library>MSCOMMON.;4| 24053
|
||||
|
||||
|previous| |date:| "12-Jun-90 10:17:31" |{PELE:MV:ENVOS}<LISPCORE>LIBRARY>MSCOMMON.;2|)
|
||||
:CHANGES-TO (TEMPLATES ADD-EXEC CL:ASSOC CL:COMPILE-FILE EXEC CL:IN-PACKAGE CL:MAKE-STRING OPEN
|
||||
CL:PUSH CL:PUSHNEW CL:RASSOC CL:WRITE-LINE CL:WRITE-STRING CL:WHEN CL:UNLESS
|
||||
)
|
||||
(FNS FUNCTIONSMSGETDEF FUNCTIONSMSMC VARIABLESMSGETDEF)
|
||||
(VARS MSCOMMONCOMS)
|
||||
|
||||
:PREVIOUS-DATE " 4-May-92 13:10:53" |{DSK}<home>larry>medley>library>MSCOMMON.;3|)
|
||||
|
||||
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
; Copyright (c) 1988, 1990, 1992 by Venue & Xerox Corporation.
|
||||
|
||||
(PRETTYCOMPRINT MSCOMMONCOMS)
|
||||
|
||||
@ -37,8 +42,8 @@
|
||||
CL:STRING-LESSP CL:STRING-NOT-EQUAL CL:STRING-NOT-GREATERP CL:STRING-NOT-LESSP
|
||||
CL:STRING-UPCASE CL:STRING/= CL:STRING< CL:STRING<= CL:STRING= CL:STRING> CL:STRING>=
|
||||
CL:SUBLIS CL:SUBSETP CL:SUBST CL:SUBST-IF CL:SUBST-IF-NOT CL:SUBSTITUTE
|
||||
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:VECTOR-PUSH
|
||||
CL:VECTOR-PUSH-EXTEND WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
|
||||
CL:SUBSTITUTE-IF CL:SUBSTITUTE-IF-NOT CL:TREE-EQUAL CL:UNION CL:UNLESS CL:VECTOR-PUSH
|
||||
CL:VECTOR-PUSH-EXTEND CL:WHEN WRITE CL:WRITE-LINE CL:WRITE-STRING CL:WRITE-TO-STRING)
|
||||
(P
|
||||
(* |;;| "First tell Masterscope how to find FUNCTIONS and VARIABLES")
|
||||
|
||||
@ -46,7 +51,7 @@
|
||||
(MSADDANALYZE 'FUNCTIONS 'FUNCTION 'FUNCTIONS 'FUNCTIONSMSGETDEF 'FUNCTIONSMSMC)
|
||||
|
||||
(* |;;|
|
||||
"Then add KEYWORD support. Templates may now contain the following as their last element:")
|
||||
"Then add KEYWORD support. Templates may now contain the following as their last element:")
|
||||
|
||||
|
||||
(* |;;| "... KEYWORDS list of keywords accepted)")
|
||||
@ -65,7 +70,7 @@
|
||||
(MSADDMODIFIER 'SPECIFY 'KEYWORDS 'KEYSPECIFY)
|
||||
|
||||
(* |;;|
|
||||
"Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
|
||||
"Stuff for locally-defined things. We don't attempt to handle them (*sigh*), just record them.")
|
||||
|
||||
(MSADDRELATION '(FLET FLETS FLETTING FLET))
|
||||
(MSADDRELATION '(LABEL LABELS LABELLING LABELLED))
|
||||
@ -87,42 +92,48 @@
|
||||
(DEFINEQ
|
||||
|
||||
(FUNCTIONSMSGETDEF
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 31-Mar-88 17:31 by jrb:")
|
||||
(LET ((BODY (REMOVE-COMMENTS (GETDEF NAME 'FUNCTIONS SOURCE OPTIONS))))
|
||||
(AND BODY (SELECTQ (CAR BODY)
|
||||
(DEFMACRO (OR (GETTEMPLATE NAME)
|
||||
(SETTEMPLATE NAME 'MACRO))
|
||||
NIL)
|
||||
(CL:DEFUN
|
||||
(* |;;| "Body is of the form:")
|
||||
(* |;;| "(DEFUN name (args...) bodies...)")
|
||||
(* |;;| "We want to hand Masterscope a massaged form it will understand.")
|
||||
(* |;;| "Which I believe is of this form:")
|
||||
(* |;;| "Body is of the form:")
|
||||
|
||||
`(CL:LAMBDA ,(CADDR BODY) ,@(CDDDR BODY)))
|
||||
(* |;;| "(DEFUN name (args...) bodies...)")
|
||||
|
||||
(* |;;|
|
||||
"We want to hand Masterscope a massaged form it will understand.")
|
||||
|
||||
(* |;;| "Which I believe is of this form:")
|
||||
|
||||
`(CL:LAMBDA ,(CADDR BODY)
|
||||
,@(CDDDR BODY)))
|
||||
NIL)))))
|
||||
|
||||
(FUNCTIONSMSMC
|
||||
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
|
||||
(* |;;| "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")
|
||||
(LAMBDA (NAME TYPE REASON) (* \; "Edited 1-Apr-88 13:47 by jrb:")
|
||||
|
||||
(* |;;| "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")
|
||||
|
||||
(|if| (EQ (CAR (GETDEF NAME 'FUNCTIONS NIL '(NOERROR)))
|
||||
'DEFMACRO)
|
||||
'DEFMACRO)
|
||||
|then| (CHANGEMACRO NAME TYPE REASON)
|
||||
NIL
|
||||
|else| T)))
|
||||
|
||||
(VARIABLESMSGETDEF
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
|
||||
|
||||
(LAMBDA (NAME TYPE SOURCE OPTIONS) (* \; "Edited 19-Feb-88 19:46 by jrb:")
|
||||
(LET ((BODY (GETDEF NAME 'VARIABLES SOURCE OPTIONS))
|
||||
SPECVARP)
|
||||
(AND BODY
|
||||
|
||||
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
|
||||
|
||||
(* |;;| "We have to return something here so Masterscope can get hold of the init form, and so It'll stop looking for other things")
|
||||
|
||||
`(CL:LAMBDA NIL ,(IF (CADDR BODY)
|
||||
THEN `(SETQ ,(CADR BODY) ,(CADDR BODY))))))))
|
||||
THEN `(SETQ ,(CADR BODY)
|
||||
,(CADDR BODY))))))))
|
||||
)
|
||||
|
||||
|
||||
@ -162,9 +173,9 @@
|
||||
:LOAD :FILE-MANAGER-FORMAT :PROCESS-ENTIRE-FILE))
|
||||
|
||||
(SETTEMPLATE 'CL:COMPILER-LET '(! NIL (BOTH (|..| (IF LISTP (NIL EVAL |..| EFFECT)
|
||||
NIL))
|
||||
NIL))
|
||||
(|..| (IF LISTP ((BOTH BIND COMPILER-LET))
|
||||
(BOTH BIND COMPILER-LET))))
|
||||
(BOTH BIND COMPILER-LET))))
|
||||
|..| EFFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:COUNT '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :KEY))
|
||||
@ -179,10 +190,10 @@
|
||||
|
||||
(SETTEMPLATE 'DECLARE '(|..| (@ EXPR (CONS NIL (SELECTQ (CAR (LISTP EXPR))
|
||||
(LOCALVARS '(IF LISTP (|..| LOCALVARS)
|
||||
LOCALVARS))
|
||||
LOCALVARS))
|
||||
((SPECVARS CL:SPECIAL)
|
||||
'(IF LISTP (|..| SPECVARS)
|
||||
SPECVARS))
|
||||
SPECVARS))
|
||||
NIL)))))
|
||||
|
||||
(SETTEMPLATE 'CL:DELETE '(EVAL SMASH KEYWORDS :FROM-END :TEST :TEST-NOT :START :END :COUNT :KEY))
|
||||
@ -391,7 +402,7 @@
|
||||
(SETTEMPLATE 'CL:REPLACE '(SMASH EVAL KEYWORDS :START1 :END1 :START2 :END2))
|
||||
|
||||
(SETTEMPLATE 'CL:ROTATEF '(|..| (IF (ATOM EXPR)
|
||||
SET SMASH)))
|
||||
SET SMASH)))
|
||||
|
||||
(SETTEMPLATE 'CL:SEARCH '(EVAL EVAL KEYWORDS :FROM-END :TEST :TEST-NOT :KEY :START1 :START2 :END1
|
||||
:END2))
|
||||
@ -401,7 +412,7 @@
|
||||
(SETTEMPLATE 'CL:SET-EXCLUSIVE-OR '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:SHIFTF '(|..| (IF (ATOM EXPR)
|
||||
SET SMASH)
|
||||
SET SMASH)
|
||||
EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:SORT '(EVAL FUNCTION KEYWORDS :KEY))
|
||||
@ -459,10 +470,14 @@
|
||||
|
||||
(SETTEMPLATE 'CL:UNION '(EVAL EVAL KEYWORDS :TEST :TEST-NOT :KEY))
|
||||
|
||||
(SETTEMPLATE 'CL:UNLESS '(TEST |..| EFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH '(EVAL SMASH))
|
||||
|
||||
(SETTEMPLATE 'CL:VECTOR-PUSH-EXTEND '(EVAL SMASH EVAL))
|
||||
|
||||
(SETTEMPLATE 'CL:WHEN '(TEST |..| EFECT RETURN))
|
||||
|
||||
(SETTEMPLATE 'WRITE '(EVAL KEYWORDS :STREAM :ESCAPE :RADIX :BASE :CIRCLE :PRETTY :LEVEL :LENGTH :CASE
|
||||
:GENSYM :ARRAY))
|
||||
|
||||
@ -539,6 +554,6 @@
|
||||
(CLRHASH USERTEMPLATES)
|
||||
(PUTPROPS MSCOMMON COPYRIGHT ("Venue & Xerox Corporation" 1988 1990 1992))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (5000 6811 (FUNCTIONSMSGETDEF 5010 . 5804) (FUNCTIONSMSMC 5806 . 6286) (
|
||||
VARIABLESMSGETDEF 6288 . 6809)))))
|
||||
(FILEMAP (NIL (5280 7291 (FUNCTIONSMSGETDEF 5290 . 6258) (FUNCTIONSMSMC 6260 . 6731) (
|
||||
VARIABLESMSGETDEF 6733 . 7289)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user