aboutsummaryrefslogtreecommitdiff
path: root/src/interp/metameta.lisp.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp/metameta.lisp.pamphlet')
-rw-r--r--src/interp/metameta.lisp.pamphlet384
1 files changed, 0 insertions, 384 deletions
diff --git a/src/interp/metameta.lisp.pamphlet b/src/interp/metameta.lisp.pamphlet
deleted file mode 100644
index 47070f8d..00000000
--- a/src/interp/metameta.lisp.pamphlet
+++ /dev/null
@@ -1,384 +0,0 @@
-\documentclass{article}
-\usepackage{axiom}
-\begin{document}
-\title{\$SPAD/src/interp metameta.lisp}
-\author{Timothy Daly}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-\section{License}
-<<license>>=
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-;;
-;; - Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; - Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in
-;; the documentation and/or other materials provided with the
-;; distribution.
-;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
-;; names of its contributors may be used to endorse or promote products
-;; derived from this software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-@
-<<*>>=
-<<license>>
-
-; .META(META PROGRAM)
-; .PREFIX 'PARSE-'
-; .PACKAGE 'PARSING'
-; .DECLARE(METAPGVAR METAVARLST METAKEYLST METARULNAM TRAPFLAG)
-
-(IN-PACKAGE "BOOT")
-
-(DEFPARAMETER METAPGVAR NIL)
-(DEFPARAMETER METAVARLST NIL)
-(DEFPARAMETER METAKEYLST NIL)
-(DEFPARAMETER METARULNAM NIL)
-(DEFPARAMETER TRAPFLAG NIL)
-
-; PROGRAM:<HEADER*>! <RULE*>! ='.FIN' ;
-
-(DEFUN PARSE-PROGRAM NIL
- (AND (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-HEADER))))
- (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-RULE))))
- (MATCH-STRING ".FIN")))
-
-; HEADER: '.META' '(' IDENTIFIER IDENTIFIER <IDENTIFIER>! ')' .(SETQ XNAME ##3)
-; / '.DECLARE' '(' IDENTIFIER* ')' .(PRINT-FLUIDS #1)
-; / '.PREFIX' STRING .(SET-PREFIX #1)
-; / '.PACKAGE' STRING .(PRINT-PACKAGE #1) ;
-
-(DEFUN PARSE-HEADER NIL
- (OR (AND (MATCH-ADVANCE-STRING ".META")
- (MUST (MATCH-ADVANCE-STRING "("))
- (MUST (PARSE-IDENTIFIER))
- (MUST (PARSE-IDENTIFIER))
- (BANG |FIL_TEST| (OPTIONAL (PARSE-IDENTIFIER)))
- (MUST (MATCH-ADVANCE-STRING ")"))
- (ACTION (SETQ XNAME (NTH-STACK 3))))
- (AND (MATCH-ADVANCE-STRING ".DECLARE")
- (MUST (MATCH-ADVANCE-STRING "("))
- (MUST (STAR REPEATOR (PARSE-IDENTIFIER)))
- (MUST (MATCH-ADVANCE-STRING ")"))
- (ACTION (PRINT-FLUIDS (POP-STACK-1))))
- (AND (MATCH-ADVANCE-STRING ".PREFIX")
- (MUST (PARSE-STRING))
- (ACTION (SET-PREFIX (POP-STACK-1))))
- (AND (MATCH-ADVANCE-STRING ".PACKAGE")
- (MUST (PARSE-STRING))
- (ACTION (PRINT-PACKAGE (POP-STACK-1))))))
-
-; RULE: RULE1 ';' .(PRINT-RULE #1) / ^='.FIN' .(META-SYNTAX-ERROR) ;
-
-(DEFUN PARSE-RULE NIL
- (OR (AND (PARSE-RULE1)
- (MUST (MATCH-ADVANCE-STRING ";"))
- (ACTION (PRINT-RULE (POP-STACK-1))))
- (AND (NOT (MATCH-STRING ".FIN"))
- (ACTION (META-SYNTAX-ERROR)))))
-
-; RULE1: IDENTIFIER .(SETQ METARULNAM (INTERN (STRCONC META_PREFIX ##1)))
-; <'{' FID* '}'>! ':' EXPR =';'
-; < =$METAPGVAR +(PROG =(TRANSPGVAR METAPGVAR) (RETURN #1))
-; .(SETQ METAPGVAR NIL) >
-; +=(MAKE-DEFUN #3 #2 #1) ;
-
-(DEFUN PARSE-RULE1 NIL
- (AND (PARSE-IDENTIFIER)
- (ACTION (SETQ METARULNAM (INTERN (STRCONC |META_PREFIX| (NTH-STACK 1)))))
- (BANG |FIL_TEST|
- (OPTIONAL (AND (MATCH-ADVANCE-STRING "{")
- (MUST (STAR REPEATOR (PARSE-FID)))
- (MUST (MATCH-ADVANCE-STRING "}")))))
- (MUST (MATCH-ADVANCE-STRING ":"))
- (MUST (PARSE-EXPR))
- (MUST (MATCH-STRING ";"))
- (OPTIONAL (AND METAPGVAR
- (PUSH-REDUCTION 'PARSE-RULE1
- (CONS 'PROG
- (CONS (TRANSPGVAR METAPGVAR)
- (CONS (CONS
- 'RETURN
- (CONS (POP-STACK-1) NIL))
- NIL))))
- (ACTION (SETQ METAPGVAR NIL))))
- (PUSH-REDUCTION 'PARSE-RULE1
- (MAKE-DEFUN (POP-STACK-3) (POP-STACK-2) (POP-STACK-1)))))
-
-; FID: IDENTIFIER +#1 ;
-
-(DEFUN PARSE-FID NIL
- (AND (PARSE-IDENTIFIER)
- (PUSH-REDUCTION 'PARSE-FID (POP-STACK-1))))
-
-; EXPR: SUBEXPR
-; < EXPR1* +(OR #2 -#1)
-; / EXPR2* +(OR #2 -#1) > ;
-
-(DEFUN PARSE-EXPR NIL
- (AND (PARSE-SUBEXPR)
- (OPTIONAL (OR (AND (STAR REPEATOR (PARSE-EXPR1))
- (PUSH-REDUCTION 'PARSE-EXPR
- (CONS 'OR
- (CONS (POP-STACK-2)
- (APPEND (POP-STACK-1) NIL)))))
- (AND (STAR REPEATOR (PARSE-EXPR2))
- (PUSH-REDUCTION 'PARSE-EXPR
- (CONS 'OR
- (CONS (POP-STACK-2)
- (APPEND (POP-STACK-1) NIL)))))))))
-
-; EXPR1: '/' <^'/'> SUBEXPR ;
-
-(DEFUN PARSE-EXPR1 NIL
- (AND (MATCH-ADVANCE-STRING "/")
- (OPTIONAL (NOT (MATCH-ADVANCE-STRING "/")))
- (MUST (PARSE-SUBEXPR))))
-
-; EXPR2: '\\' <^'\\'> SUBEXPR ;
-
-(DEFUN PARSE-EXPR2 NIL
- (AND (MATCH-ADVANCE-STRING "\\")
- (OPTIONAL (NOT (MATCH-ADVANCE-STRING "\\")))
- (MUST (PARSE-SUBEXPR))))
-
-; SUBEXPR:FIL_TEST <^?$TRAPFLAG FIL_TEST>*!
-; <FIL_TEST <?$TRAPFLAG +(MUST #1)> >*!
-; +(#3 -#2 -#1) +=(MAKE-PARSE-FUNCTION #1 "AND) ;
-
-(DEFUN PARSE-SUBEXPR NIL
- (AND (PARSE-FIL_TEST)
- (BANG |FIL_TEST|
- (OPTIONAL (STAR |OPT_EXPR|
- (AND (NOT TRAPFLAG)
- (PARSE-FIL_TEST)))))
- (BANG |FIL_TEST|
- (OPTIONAL (STAR |OPT_EXPR|
- (AND (PARSE-FIL_TEST)
- (OPTIONAL (AND TRAPFLAG
- (PUSH-REDUCTION 'PARSE-SUBEXPR
- (CONS
- 'MUST
- (CONS (POP-STACK-1) NIL))))))
- )))
- (PUSH-REDUCTION 'PARSE-SUBEXPR
- (CONS (POP-STACK-3)
- (APPEND (POP-STACK-2) (APPEND (POP-STACK-1) NIL))))
- (PUSH-REDUCTION 'PARSE-SUBEXPR (MAKE-PARSE-FUNCTION (POP-STACK-1) 'AND))))
-
-; FIL_TEST: REP_TEST <'!' +(BANG FIL_TEST #1)> ;
-
-(DEFUN PARSE-FIL_TEST NIL
- (AND (PARSE-REP_TEST)
- (OPTIONAL (AND (MATCH-ADVANCE-STRING "!")
- (PUSH-REDUCTION 'PARSE-FIL_TEST
- (CONS 'BANG
- (CONS '|FIL_TEST| (CONS (POP-STACK-1) NIL))))))))
-
-; REP_TEST: N_TEST <REPEATOR> ;
-
-(DEFUN PARSE-REP_TEST NIL
- (AND (PARSE-N_TEST)
- (OPTIONAL (PARSE-REPEATOR))))
-
-; N_TEST: '^' TEST +(NOT #1) / TEST ;
-
-(DEFUN PARSE-N_TEST NIL
- (OR (AND (MATCH-ADVANCE-STRING "^")
- (MUST (PARSE-TEST))
- (PUSH-REDUCTION 'PARSE-N_TEST (CONS 'NOT (CONS (POP-STACK-1) NIL))))
- (PARSE-TEST)))
-
-; TEST: IDENTIFIER ( '{' <SEXPR*>! '}'
-; +(=(INTERN (STRCONC META_PREFIX #2)) -#1)
-; / +(=(INTERN (STRCONC META_PREFIX #1)))) .(SETQ TRAPFLAG T)
-; / STRING +(MATCH-ADVANCE-STRING #1) .(SETQ TRAPFLAG T)
-; / '=' REF_SEXPR .(SETQ TRAPFLAG T)
-; / '?' REF_SEXPR .(SETQ TRAPFLAG NIL)
-; / '.' SEXPR +(ACTION #1) .(SETQ TRAPFLAG NIL)
-; / '+' CONS_SEXPR +(PUSH-REDUCTION =(LIST "QUOTE METARULNAM) #1)
-; .(SETQ TRAPFLAG NIL)
-; / '(' EXPR ')' .(SETQ TRAPFLAG T)
-; / '<' EXPR '>' .(PARSE-OPT_EXPR) .(SETQ TRAPFLAG NIL) ;
-
-(DEFUN PARSE-TEST NIL
- (OR (AND (PARSE-IDENTIFIER)
- (MUST (OR (AND (MATCH-ADVANCE-STRING "{")
- (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR))))
- (MUST (MATCH-ADVANCE-STRING "}"))
- (PUSH-REDUCTION 'PARSE-TEST
- (CONS (INTERN (STRCONC
- |META_PREFIX|
- (POP-STACK-2)))
- (APPEND (POP-STACK-1) NIL))))
- (PUSH-REDUCTION 'PARSE-TEST
- (CONS (INTERN (STRCONC |META_PREFIX| (POP-STACK-1)))
- NIL))))
- (ACTION (SETQ TRAPFLAG T)))
- (AND (PARSE-STRING)
- (PUSH-REDUCTION 'PARSE-TEST
- (CONS 'MATCH-ADVANCE-STRING (CONS (POP-STACK-1) NIL)))
- (ACTION (SETQ TRAPFLAG T)))
- (AND (MATCH-ADVANCE-STRING "=")
- (MUST (PARSE-REF_SEXPR))
- (ACTION (SETQ TRAPFLAG T)))
- (AND (MATCH-ADVANCE-STRING "?")
- (MUST (PARSE-REF_SEXPR))
- (ACTION (SETQ TRAPFLAG NIL)))
- (AND (MATCH-ADVANCE-STRING ".")
- (MUST (PARSE-SEXPR))
- (PUSH-REDUCTION 'PARSE-TEST (CONS 'ACTION (CONS (POP-STACK-1) NIL)))
- (ACTION (SETQ TRAPFLAG NIL)))
- (AND (MATCH-ADVANCE-STRING "+")
- (MUST (PARSE-CONS_SEXPR))
- (PUSH-REDUCTION 'PARSE-TEST
- (CONS 'PUSH-REDUCTION
- (CONS (LIST 'QUOTE METARULNAM) (CONS (POP-STACK-1) NIL))))
- (ACTION (SETQ TRAPFLAG NIL)))
- (AND (MATCH-ADVANCE-STRING "(")
- (MUST (PARSE-EXPR))
- (MUST (MATCH-ADVANCE-STRING ")"))
- (ACTION (SETQ TRAPFLAG T)))
- (AND (MATCH-ADVANCE-STRING "<")
- (MUST (PARSE-EXPR))
- (MUST (MATCH-ADVANCE-STRING ">"))
- (ACTION (PARSE-OPT_EXPR))
- (ACTION (SETQ TRAPFLAG NIL)))))
-
-; SEXPR: IDENTIFIER / NUMBER / STRING / NON_DEST_REF / DEST_REF / LOCAL_VAR
-; / '"' SEXPR +(QUOTE #1) / '=' SEXPR / '(' <SEXPR*>! ')' ;
-
-(DEFUN PARSE-SEXPR NIL
- (OR (PARSE-IDENTIFIER)
- (PARSE-NUMBER)
- (PARSE-STRING)
- (PARSE-NON_DEST_REF)
- (PARSE-DEST_REF)
- (PARSE-LOCAL_VAR)
- (AND (MATCH-ADVANCE-STRING "\"")
- (MUST (PARSE-SEXPR))
- (PUSH-REDUCTION 'PARSE-SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
- (AND (MATCH-ADVANCE-STRING "=")
- (MUST (PARSE-SEXPR)))
- (AND (MATCH-ADVANCE-STRING "(")
- (BANG |FIL_TEST| (OPTIONAL (STAR REPEATOR (PARSE-SEXPR))))
- (MUST (MATCH-ADVANCE-STRING ")")))))
-
-; REF_SEXPR: STRING +(MATCH-STRING #1) / SEXPR ;
-
-(DEFUN PARSE-REF_SEXPR NIL
- (OR (AND (PARSE-STRING)
- (PUSH-REDUCTION 'PARSE-REF_SEXPR (CONS 'MATCH-STRING (CONS (POP-STACK-1) NIL))))
- (PARSE-SEXPR)))
-
-; CONS_SEXPR: IDENTIFIER <^=(MEMBER ##1 METAPGVAR) +(QUOTE #1)>
-; / LOCAL_VAR +(QUOTE #1)
-; / '(' <SEXPR_STRING>! ')'
-; / SEXPR ;
-
-(DEFUN PARSE-CONS_SEXPR NIL
- (OR (AND (PARSE-IDENTIFIER)
- (OPTIONAL (AND (NOT (MEMBER (NTH-STACK 1) METAPGVAR))
- (PUSH-REDUCTION 'PARSE-CONS_SEXPR
- (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))))
- (AND (PARSE-LOCAL_VAR)
- (PUSH-REDUCTION 'PARSE-CONS_SEXPR (CONS 'QUOTE (CONS (POP-STACK-1) NIL))))
- (AND (MATCH-ADVANCE-STRING "(")
- (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
- (MUST (MATCH-ADVANCE-STRING ")")))
- (PARSE-SEXPR)))
-
-; SEXPR_STRING: CONS_SEXPR <SEXPR_STRING>! +(CONS #2 #1)
-; / '-' CONS_SEXPR <SEXPR_STRING>! +(APPEND #2 #1) ;
-
-(DEFUN PARSE-SEXPR_STRING NIL
- (OR (AND (PARSE-CONS_SEXPR)
- (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
- (PUSH-REDUCTION 'PARSE-SEXPR_STRING
- (CONS 'CONS (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))
- (AND (MATCH-ADVANCE-STRING "-")
- (MUST (PARSE-CONS_SEXPR))
- (BANG |FIL_TEST| (OPTIONAL (PARSE-SEXPR_STRING)))
- (PUSH-REDUCTION 'PARSE-SEXPR_STRING
- (CONS 'APPEND (CONS (POP-STACK-2) (CONS (POP-STACK-1) NIL)))))))
-
-; NON_DEST_REF: '##' NUMBER +(NTH-STACK #1) ;
-
-(DEFUN PARSE-NON_DEST_REF NIL
- (AND (MATCH-ADVANCE-STRING "##")
- (MUST (PARSE-NUMBER))
- (PUSH-REDUCTION 'PARSE-NON_DEST_REF (CONS 'NTH-STACK (CONS (POP-STACK-1) NIL)))))
-
-; DEST_REF: '#' NUMBER +=(LIST (INTERN (STRCONC 'POP-STACK-' (STRINGIMAGE #1)))) ;
-
-(DEFUN PARSE-DEST_REF NIL
- (AND (MATCH-ADVANCE-STRING "#")
- (MUST (PARSE-NUMBER))
- (PUSH-REDUCTION 'PARSE-DEST_REF
- (LIST (INTERN (STRCONC "POP-STACK-" (STRINGIMAGE (POP-STACK-1))))))))
-
-; LOCAL_VAR: '$' ( IDENTIFIER / NUMBER +=(GETGENSYM #1) .(PUSH ##1 METAPGVAR)) ;
-
-(DEFUN PARSE-LOCAL_VAR NIL
- (AND (MATCH-ADVANCE-STRING "$")
- (MUST (OR (PARSE-IDENTIFIER)
- (AND (PARSE-NUMBER)
- (PUSH-REDUCTION 'PARSE-LOCAL_VAR (GETGENSYM (POP-STACK-1)))
- (ACTION (PUSH (NTH-STACK 1) METAPGVAR)))))))
-
-; OPT_EXPR: <'*' +(STAR OPT_EXPR #1) / REPEATOR> +(OPTIONAL #1) ;
-
-(DEFUN PARSE-OPT_EXPR NIL
- (AND (OPTIONAL (OR (AND (MATCH-ADVANCE-STRING "*")
- (PUSH-REDUCTION 'PARSE-OPT_EXPR
- (CONS 'STAR
- (CONS '|OPT_EXPR|
- (CONS (POP-STACK-1) NIL)))))
- (PARSE-REPEATOR)))
- (PUSH-REDUCTION 'PARSE-OPT_EXPR (CONS 'OPTIONAL (CONS (POP-STACK-1) NIL)))))
-
-; REPEATOR: ('*' / BSTRING +(AND (MATCH-ADVANCE-STRING #1) (MUST ##1)))
-; +(STAR REPEATOR #1) ;
-
-(DEFUN PARSE-REPEATOR NIL
- (AND (OR (MATCH-ADVANCE-STRING "*")
- (AND (PARSE-BSTRING)
- (PUSH-REDUCTION 'PARSE-REPEATOR
- (CONS 'AND
- (CONS (CONS 'MATCH-ADVANCE-STRING
- (CONS (POP-STACK-1) NIL))
- (CONS (CONS 'MUST (CONS (NTH-STACK 1) NIL))
- NIL))))))
- (PUSH-REDUCTION 'PARSE-REPEATOR
- (CONS 'STAR (CONS 'REPEATOR (CONS (POP-STACK-1) NIL))))))
-
-; .FIN ;
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 05:20:42 +0000