| 123456789101112131415161718192021222324252627282930313233343536373839404142 |
- %
- % GLHEAD.PSL.13 16 FEB. 1983
- %
- % HEADER FOR GLISP FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
- % G. NOVAK 20 OCTOBER 1982
- %
- (GLOBAL '(GLQUIETFLG GLSEPBITTBL GLUNITPKGS GLSEPMINUS GLOBJECTNAMES
- GLTYPENAMES GLBREAKONERROR GLUSERSTRNAMES GLLASTFNCOMPILED
- GLLASTSTREDITED GLCAUTIOUSFLG GLLISPDIALECT GLBASICTYPES
- GLOBJECTTYPES GLTYPESUSED))
- (FLUID '(TTLIST SPECS SOURCE GLGLOBALVARS DOMAINNAME ARGTYPES NOTFLG
- GLAMBDAFN ADDISATYPE PAIRLIST PROGG BITTBL KEY Y TYPES
- CONTEXT EXPR VALBUSY FAULTFN GLSEPATOM GLSEPPTR *GL* *GLVAL*
- GLTOPCTX RESULTTYPE RESULT GLNATOM FIRST OPNDS OPERS
- GLEXPR DESLIST EXPRSTACK GLTYPESUBS GLPROGLST
- TYPE GLNRECURSIONS GLFNSUBS GLEVALSUBS))
- % CASEQ MACRO FOR PSL
- (DM CASEQ (L)
- (PROG (CVAR CODE)
- (SETQ CVAR (COND ((ATOM (CADR L))(CADR L))
- (T 'CASEQSELECTORVAR)))
- (SETQ CODE (CONS 'COND (MAPCAR (CDDR L)
- (FUNCTION (LAMBDA (X)
- (COND ((EQ (CAR X) T) X)
- ((ATOM (CAR X))
- (CONS (LIST 'EQ CVAR
- (LIST 'QUOTE (CAR X)))
- (CDR X)))
- (T (CONS (LIST 'MEMQ CVAR
- (LIST 'QUOTE (CAR X)))
- (CDR X)))))))))
- (RETURN (COND ((ATOM (CADR L)) CODE)
- (T (LIST 'PROG (LIST CVAR)
- (LIST 'SETQ CVAR (CADR L))
- (LIST 'RETURN CODE)))))))
|
