diff options
Diffstat (limited to 'src/interp/metameta.lisp.pamphlet')
| -rw-r--r-- | src/interp/metameta.lisp.pamphlet | 384 |
1 files changed, 384 insertions, 0 deletions
diff --git a/src/interp/metameta.lisp.pamphlet b/src/interp/metameta.lisp.pamphlet new file mode 100644 index 00000000..47070f8d --- /dev/null +++ b/src/interp/metameta.lisp.pamphlet @@ -0,0 +1,384 @@ +\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} |