github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-29 21:27:41 +00:00
Code Issues Projects Releases Wiki Activity

All source files converted to LF (#315)

Browse Source 
* All source files converted to LF

Also, HPRINT:  EQUALALL knows about CL arrays
FILEIO:  STREAM record with fields for external format functions

* Delete makeinit.dribble

* Converted CR to LF on internal/library and docs/Documentation Tools
This commit is contained in:
rmkaplan
2021-04-28 15:36:03 -07:00
committed by GitHub
parent 179325c528
commit f0ad3c5f60
736 changed files with 532174 additions and 5581 deletions
Download Patch File Download Diff File Expand all files Collapse all files

132
lispusers/SIMPLIFY
View File

@@ -1 +1,131 @@
(FILECREATED "19-Feb-87 09:42:40" {QV}<LFG>PARSER>SIMPLIFY.;1 4714
(FILECREATED "19-Feb-87 09:42:40" {QV}<LFG>PARSER>SIMPLIFY.;1 4714
previous date: " 6-NOV-79 17:25:50" <LISPUSERS>SIMPLIFY.;3)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SIMPLIFYCOMS)
(RPAQQ SIMPLIFYCOMS ((* Tools for symbolic simplification of LISP forms)
(FNS SIMPLIFY)
(FNS APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL)
(BLOCKS (APPLYFORM APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL))))
(* Tools for symbolic simplification of LISP forms)
(DEFINEQ
(SIMPLIFY
[LAMBDA (FORM) (* bas: " 6-NOV-79 16:51")
(* Eventually this will be a general symbolic 
simplification package, but for now its just a dummy 
entry)
FORM])
)
(DEFINEQ
(APPLYFORM
[LAMBDA (FN ARG1) (* bas: " 6-NOV-79 17:24")
(PROG (FNARG FNFORM)
(RETURN (if (AND (EQ (CAR (LISTP FN))
(QUOTE LAMBDA))
[LISTP (CAR (LISTP (CDR FN]
(NULL (CDADR FN))
(LITATOM (SETQ FNARG (CAADR FN)))
FNARG
(OR (PROGN (SETQ FNFORM (if (CDDDR FN)
then (CONS (QUOTE PROGN)
(CDDR FN))
else (CADDR FN)))
(SIMPLEP ARG1))
(ONCE FNARG FNFORM)))
then
(* We know that FN is a LAMBDA with one non-NIL litatom argument, and that either FNARG can be safely evaluated 
multiple times or the function body only references it once.)
(if (EQ FNARG ARG1)
then (* Arg and arg name are same so body will do)
FNFORM
else (SUBSTVAL ARG1 FNARG FNFORM))
else (LIST FN ARG1])
(ONCE
[LAMBDA (ATOM FORM FLG) (* bas: "19-AUG-78 17:34")
(DECLARE (SPECVARS FLG))
(ONCE1 ATOM FORM)
(NEQ FLG (QUOTE FAILED])
(ONCE1
[LAMBDA (A L) (* bas: "18-SEP-79 17:03")
(for I in L do [if (LISTP I)
then (OR (OPAQUE I A)
(ONCE1 A I))
elseif (EQ A I)
then (SETQ FLG (if FLG
then (QUOTE FAILED)
else (QUOTE ONCE]
until (EQ FLG (QUOTE FAILED])
(OPAQUE
[LAMBDA (FORM VAR) (* rmk: " 5-AUG-79 22:11")
(* Determines if VAR substitution can take place in 
FORM)
(SELECTQ (CAR FORM)
(QUOTE T)
([LAMBDA NLAMBDA]
(FMEMB VAR (CADR FORM)))
[PROG (for I in (CADR FORM) thereis (EQ VAR (if (LISTP I)
then (CAR I)
else I]
NIL])
(SIMPLEP
[LAMBDA (FORM) (* rmk: " 5-AUG-79 22:06")
(* Decides if a form is simple enough so that it can 
be evaluated repeatedly rather than taking a LAMBDA 
binding)
(OR (ATOM FORM)
(SELECTQ (CAR (LISTP FORM))
((QUOTE CAR CDR CADR CDDR)
(LITATOM (CADR FORM)))
NIL)
(STRINGP FORM])
(SUBSTVAL
[LAMBDA (NEW OLD FORM) (* bas: " 8-MAR-79 20:39")
(* Substitutes NEW for OLD in FORM.
Just like SUBST except is sensitive to opacity)
(if (LISTP FORM)
then [if (OPAQUE FORM OLD)
then FORM
else (PROG (NSCR OSCR)
(RETURN (if [SETQ OSCR (for I in FORM
thereis (NEQ I
(SETQ NSCR
(SUBSTVAL NEW
OLD I]
then (for I in FORM
collect (if (NULL OSCR)
then (SUBSTVAL NEW OLD I)
elseif (EQ OSCR I)
then (SETQ OSCR NIL)
NSCR
else I))
else FORM]
elseif (EQ FORM OLD)
then NEW
else FORM])
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: APPLYFORM APPLYFORM ONCE ONCE1 OPAQUE SIMPLEP SUBSTVAL)
]
(PUTPROPS SIMPLIFY COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (541 874 (SIMPLIFY 551 . 872)) (875 4521 (APPLYFORM 885 . 1935) (ONCE 1937 . 2140) (
ONCE1 2142 . 2557) (OPAQUE 2559 . 3085) (SIMPLEP 3087 . 3588) (SUBSTVAL 3590 . 4519)))))
STOP