From cc8a4fee3515864990e852d3a1cfc3342c256b1d Mon Sep 17 00:00:00 2001 From: dos-reis Date: Wed, 1 Oct 2008 15:04:50 +0000 Subject: * interp/i-output.boot: Move dispatch table from property.lisp. * interp/buildom.boot: Likewise. * interp/def.lisp: Likewise. --- src/ChangeLog | 6 ++ src/interp/buildom.boot | 8 ++ src/interp/def.lisp | 20 +++++ src/interp/i-output.boot | 165 ++++++++++++++++++++++++++++++++++++++++ src/interp/property.lisp | 191 +---------------------------------------------- 5 files changed, 200 insertions(+), 190 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 232dc099..af723ff8 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2008-10-01 Gabriel Dos Reis + + * interp/i-output.boot: Move dispatch table from property.lisp. + * interp/buildom.boot: Likewise. + * interp/def.lisp: Likewise. + 2008-10-01 Gabriel Dos Reis * algebra/files.spad.pamphlet (IOMode): New domain. diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 52e786a8..2570cc82 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -408,3 +408,11 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == cList:= substitute(dollarIfRepHack op,g,cList) [cList,e] +--% +for x in '((Record mkRecordFunList) + (Union mkUnionFunList) + (Mapping mkMappingFunList) + (Enumeration mkEnumerationFunList)) + repeat + MAKEPROP(first x, "makeFunctionList", second x) + diff --git a/src/interp/def.lisp b/src/interp/def.lisp index f9613d94..d6c7ed82 100644 --- a/src/interp/def.lisp +++ b/src/interp/def.lisp @@ -39,6 +39,26 @@ (in-package "BOOT") +(REPEAT (IN X '( + (|:| |DEF-:|) + (|::| |DEF-::|) + (ELT DEF-ELT) + (SETELT DEF-SETELT) + (%LET DEF-LET) + (COLLECT DEF-COLLECT) + (LESSP DEF-LESSP) + (|<| DEF-LESSP) + (REPEAT DEF-REPEAT) +;;(|TRACE,LET| DEF-TRACE-LET) + (CATEGORY DEF-CATEGORY) + (EQUAL DEF-EQUAL) + (|is| DEF-IS) + (SEQ DEF-SEQ) + (|isnt| DEF-ISNT) + (|where| DEF-WHERE) +)) (PROGN (MAKEPROP (CAR X) '|DEF-TRAN| (CADR X)) (CADR X))) + + ;;; Common Block (defparameter deftran nil) diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index a9a26e81..e7c1d62b 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -215,6 +215,171 @@ _*TALLPAR := false $collectOutput := false +--% Output functions dispatch tables. + +for x in '((+ WIDTH sumWidth) + (_- APP appneg) + (_- WIDTH minusWidth) + (_/ APP appfrac) + (_/ SUBSPAN fracsub) + (_/ SUPERSPAN fracsuper) + (_/ WIDTH fracwidth) + (AGGSET APP argsapp) + (AGGSET SUBSPAN agggsub) + (AGGSET SUPERSPAN agggsuper) + (AGGSET WIDTH agggwidth) + (binom APP binomApp) + (binomSUBSPAN binomSub) + (binom SUPERSPAN binomSuper) + (binom WIDTH binomWidth) + (ALTSUPERSUB APP altSuperSubApp) + (ALTSUPERSUB SUBSPAN altSuperSubSub) + (ALTSUPERSUB SUPERSPAN altSuperSubSuper) + (ALTSUPERSUB WIDTH altSuperSubWidth) + (BOX APP boxApp) + (BOX SUBSPAN boxSub) + (BOX SUPERSPAN boxSuper) + (BOX WIDTH boxWidth) + (BRACKET SUBSPAN qTSub) + (BRACKET SUPERSPAN qTSuper) + (BRACKET WIDTH qTWidth) + (CENTER APP centerApp) + (EXT APP appext) + (EXT SUBSPAN extsub) + (EXT SUPERSPAN extsuper) + (EXT WIDTH extwidth) + (MATRIX APP appmat) + (MATRIX SUBSPAN matSub) + (MATRIX SUPERSPAN matSuper) + (MATRIX WIDTH matWidth) + (NOTHING APP nothingApp) + (NOTHING SUPERSPAN nothingSuper) + (NOTHING SUBSPAN nothingSub) + (NOTHING WIDTH nothingWidth) + (OVER APP appfrac) + (OVER SUBSPAN fracsub) + (OVER SUPERSPAN fracsuper) + (OVER WIDTH fracwidth) + (OVERLABEL APP overlabelApp) + (OVERLABEL SUPERSPAN overlabelSuper) + (OVERLABEL WIDTH overlabelWidth) + (OVERBAR APP overbarApp) + (OVERBAR SUPERSPAN overbarSuper) + (OVERBAR WIDTH overbarWidth) + (PAREN APP appparu1) + (PAREN SUBSPAN qTSub) + (PAREN SUPERSPAN qTSuper) + (PAREN WIDTH qTWidth) + (ROOT APP rootApp) + (ROOT SUBSPAN rootSub) + (ROOT SUPERSPAN rootSuper) + (ROOT WIDTH rootWidth) + (ROW WIDTH eq0) + (SC APP appsc) + (SC SUBSPAN agggsub) + (SC SUPERSPAN agggsuper) + (SC WIDTH widthSC) + (SETQ APP appsetq) + (SETQ WIDTH letWidth) + (SLASH APP slashApp) + (SLASH SUBSPAN slashSub) + (SLASH SUPERSPAN slashSuper) + (SLASH WIDTH slashWidth) + (SUB APP appsub) + (SUB SUBSPAN subSub) + (SUB SUPERSPAN subSuper) + (SUB WIDTH suScWidth) + (SUPERSUB APP superSubApp) + (SUPERSUB SUBSPAN superSubSub) + (SUPERSUB SUPERSPAN superSubSuper) + (SUPERSUB WIDTH superSubWidth) + (VCONCAT APP vconcatapp) + (VCONCAT SUBSPAN vConcatSub) + (VCONCAT SUPERSPAN vConcatSuper) + (VCONCAT WIDTH vConcatWidth) + (BINOMIAL APP binomialApp) + (BINOMIAL SUBSPAN binomialSub) + (BINOMIAL SUPERSPAN binomialSuper) + (BINOMIAL WIDTH binomialWidth) + (ZAG APP zagApp) + (ZAG SUBSPAN zagSub) + (ZAG SUPERSPAN zagSuper) + (ZAG WIDTH zagWidth)) + repeat + MAKEPROP(first x, second x, third x) + + +for x in '((+ APP plusApp) + (* APP timesApp) + (* WIDTH timesWidth) + (** APP exptApp) + (** WIDTH exptWidth) + (** SUBSPAN exptSub) + (** SUPERSPAN exptSuper) + (^ APP exptApp) + (^ WIDTH exptWidth) + (^ SUBSPAN exptSub) + (^ SUPERSPAN exptSuper) + (STEP APP stepApp) + (STEP WIDTH stepWidth) + (STEP SUBSPAN stepSub) + (STEP SUPERSPAN stepSuper) + (IN APP inApp) + (IN WIDTH inWidth) + (IN SUBSPAN inSub) + (IN SUPERSPAN inSuper) + (AGGLST APP aggApp) + (AGGLST SUBSPAN aggSub) + (AGGLST SUPERSPAN aggSuper) + (CONCATB APP concatbApp) + (CONCATB SUBSPAN concatSub) + (CONCATB SUPERSPAN concatSuper) + (CONCATB WIDTH concatbWidth) + (CONCAT APP concatApp) + (CONCAT SUBSPAN concatSub) + (CONCAT SUPERSPAN concatSuper) + (CONCAT WIDTH concatWidth) + (QUOTE APP quoteApp) + (QUOTE SUBSPAN quoteSub) + (QUOTE SUPERSPAN quoteSuper) + (QUOTE WIDTH quoteWidth) + (STRING APP stringApp) + (STRING SUBSPAN eq0) + (STRING SUPERSPAN eq0) + (STRING WIDTH stringWidth) + (SIGMA APP sigmaApp) + (SIGMA SUBSPAN sigmaSub) + (SIGMA SUPERSPAN sigmaSup) + (SIGMA WIDTH sigmaWidth) + (SIGMA2 APP sigma2App) + (SIGMA2 SUBSPAN sigma2Sub) + (SIGMA2 SUPERSPAN sigma2Sup) + (SIGMA2 WIDTH sigma2Width) + (INTSIGN APP intApp) + (INTSIGN SUBSPAN intSub) + (INTSIGN SUPERSPAN intSup) + (INTSIGN WIDTH intWidth) + (INDEFINTEGRAL APP indefIntegralApp) + (INDEFINTEGRAL SUBSPAN indefIntegralSub) + (INDEFINTEGRAL SUPERSPAN indefIntegralSup) + (INDEFINTEGRAL WIDTH indefIntegralWidth) + (PI APP piApp) + (PI SUBSPAN piSub) + (PI SUPERSPAN piSup) + (PI WIDTH piWidth) + (PI2 APP pi2App) + (PI2 SUBSPAN pi2Sub) + (PI2 SUPERSPAN pi2Sup) + (PI2 WIDTH pi2Width) + (AGGLST WIDTH aggWidth) + (BRACKET APP bracketApp) + (BRACE APP braceApp) + (BRACE WIDTH qTWidth)) + repeat + MAKEPROP(first x, second x, third x) + +--% + specialChar(symbol) == -- looks up symbol in $specialCharacterAlist, gets the index -- into the EBCDIC table, and returns the appropriate character diff --git a/src/interp/property.lisp b/src/interp/property.lisp index 1e012666..5046fa48 100644 --- a/src/interp/property.lisp +++ b/src/interp/property.lisp @@ -1,6 +1,6 @@ ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. ;; All rights reserved. -;; Copyright (C) 2007, Gabriel Dos Reis. +;; Copyright (C) 2007-2008, Gabriel Dos Reis. ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without @@ -117,188 +117,6 @@ (SEGMENT "..") ;" 0.. is represented by (SEGMENT 0)" )) (MAKEPROP (CAR X) 'PREFIXOP (CADR X))) -(REPEAT (IN X '( - (+ WIDTH |sumWidth|) - (- APP |appneg|) - (- WIDTH |minusWidth|) - (/ APP |appfrac|) - (/ SUBSPAN |fracsub|) - (/ SUPERSPAN |fracsuper|) - (/ WIDTH |fracwidth|) - (AGGSET APP |argsapp|) - (AGGSET SUBSPAN |agggsub|) - (AGGSET SUPERSPAN |agggsuper|) - (AGGSET WIDTH |agggwidth|) - (|binom| APP |binomApp|) - (|binom| SUBSPAN |binomSub|) - (|binom| SUPERSPAN |binomSuper|) - (|binom| WIDTH |binomWidth|) - (ALTSUPERSUB APP |altSuperSubApp|) - (ALTSUPERSUB SUBSPAN |altSuperSubSub|) - (ALTSUPERSUB SUPERSPAN |altSuperSubSuper|) - (ALTSUPERSUB WIDTH |altSuperSubWidth|) - (BOX APP |boxApp|) - (BOX SUBSPAN |boxSub|) - (BOX SUPERSPAN |boxSuper|) - (BOX WIDTH |boxWidth|) - (BRACKET SUBSPAN |qTSub|) - (BRACKET SUPERSPAN |qTSuper|) - (BRACKET WIDTH |qTWidth|) - (CENTER APP |centerApp|) - (EXT APP |appext|) - (EXT SUBSPAN |extsub|) - (EXT SUPERSPAN |extsuper|) - (EXT WIDTH |extwidth|) - (MATRIX APP |appmat|) - (MATRIX SUBSPAN |matSub|) - (MATRIX SUPERSPAN |matSuper|) - (MATRIX WIDTH |matWidth|) - (NOTHING APP |nothingApp|) - (NOTHING SUPERSPAN |nothingSuper|) - (NOTHING SUBSPAN |nothingSub|) - (NOTHING WIDTH |nothingWidth|) - (OVER APP |appfrac|) - (OVER SUBSPAN |fracsub|) - (OVER SUPERSPAN |fracsuper|) - (OVER WIDTH |fracwidth|) - (OVERLABEL APP |overlabelApp|) - (OVERLABEL SUPERSPAN |overlabelSuper|) - (OVERLABEL WIDTH |overlabelWidth|) - (OVERBAR APP |overbarApp|) - (OVERBAR SUPERSPAN |overbarSuper|) - (OVERBAR WIDTH |overbarWidth|) - (PAREN APP |appparu1|) - (PAREN SUBSPAN |qTSub|) - (PAREN SUPERSPAN |qTSuper|) - (PAREN WIDTH |qTWidth|) - (ROOT APP |rootApp|) - (ROOT SUBSPAN |rootSub|) - (ROOT SUPERSPAN |rootSuper|) - (ROOT WIDTH |rootWidth|) - (ROW WIDTH |eq0|) - (SC APP |appsc|) - (SC SUBSPAN |agggsub|) - (SC SUPERSPAN |agggsuper|) - (SC WIDTH |widthSC|) - (SETQ APP |appsetq|) - (SETQ WIDTH |letWidth|) - (SLASH APP |slashApp|) - (SLASH SUBSPAN |slashSub|) - (SLASH SUPERSPAN |slashSuper|) - (SLASH WIDTH |slashWidth|) - (SUB APP |appsub|) - (SUB SUBSPAN |subSub|) - (SUB SUPERSPAN |subSuper|) - (SUB WIDTH |suScWidth|) - (SUPERSUB APP |superSubApp|) - (SUPERSUB SUBSPAN |superSubSub|) - (SUPERSUB SUPERSPAN |superSubSuper|) - (SUPERSUB WIDTH |superSubWidth|) - (VCONCAT APP |vconcatapp|) - (VCONCAT SUBSPAN |vConcatSub|) - (VCONCAT SUPERSPAN |vConcatSuper|) - (VCONCAT WIDTH |vConcatWidth|) - (BINOMIAL APP |binomialApp|) - (BINOMIAL SUBSPAN |binomialSub|) - (BINOMIAL SUPERSPAN |binomialSuper|) - (BINOMIAL WIDTH |binomialWidth|) - (ZAG APP |zagApp|) - (ZAG SUBSPAN |zagSub|) - (ZAG SUPERSPAN |zagSuper|) - (ZAG WIDTH |zagWidth|) -)) (PROGN (MAKEPROP (CAR X) (CADR X) (CADDR X))) -) - -(REPEAT (IN X '( - (+ APP |plusApp|) - (* APP |timesApp|) - (* WIDTH |timesWidth|) - (** APP |exptApp|) - (** WIDTH |exptWidth|) - (** SUBSPAN |exptSub|) - (** SUPERSPAN |exptSuper|) - (^ APP |exptApp|) - (^ WIDTH |exptWidth|) - (^ SUBSPAN |exptSub|) - (^ SUPERSPAN |exptSuper|) - (STEP APP |stepApp|) - (STEP WIDTH |stepWidth|) - (STEP SUBSPAN |stepSub|) - (STEP SUPERSPAN |stepSuper|) - (IN APP |inApp|) - (IN WIDTH |inWidth|) - (IN SUBSPAN |inSub|) - (IN SUPERSPAN |inSuper|) - (AGGLST APP |aggApp|) - (AGGLST SUBSPAN |aggSub|) - (AGGLST SUPERSPAN |aggSuper|) - (CONCATB APP |concatbApp|) - (CONCATB SUBSPAN |concatSub|) - (CONCATB SUPERSPAN |concatSuper|) - (CONCATB WIDTH |concatbWidth|) - (CONCAT APP |concatApp|) - (CONCAT SUBSPAN |concatSub|) - (CONCAT SUPERSPAN |concatSuper|) - (CONCAT WIDTH |concatWidth|) - (QUOTE APP |quoteApp|) - (QUOTE SUBSPAN |quoteSub|) - (QUOTE SUPERSPAN |quoteSuper|) - (QUOTE WIDTH |quoteWidth|) - (STRING APP |stringApp|) - (STRING SUBSPAN |eq0|) - (STRING SUPERSPAN |eq0|) - (STRING WIDTH |stringWidth|) - (SIGMA APP |sigmaApp|) - (SIGMA SUBSPAN |sigmaSub|) - (SIGMA SUPERSPAN |sigmaSup|) - (SIGMA WIDTH |sigmaWidth|) - (SIGMA2 APP |sigma2App|) - (SIGMA2 SUBSPAN |sigma2Sub|) - (SIGMA2 SUPERSPAN |sigma2Sup|) - (SIGMA2 WIDTH |sigma2Width|) - (INTSIGN APP |intApp|) - (INTSIGN SUBSPAN |intSub|) - (INTSIGN SUPERSPAN |intSup|) - (INTSIGN WIDTH |intWidth|) - (INDEFINTEGRAL APP |indefIntegralApp|) - (INDEFINTEGRAL SUBSPAN |indefIntegralSub|) - (INDEFINTEGRAL SUPERSPAN |indefIntegralSup|) - (INDEFINTEGRAL WIDTH |indefIntegralWidth|) - (PI APP |piApp|) - (PI SUBSPAN |piSub|) - (PI SUPERSPAN |piSup|) - (PI WIDTH |piWidth|) - (PI2 APP |pi2App|) - (PI2 SUBSPAN |pi2Sub|) - (PI2 SUPERSPAN |pi2Sup|) - (PI2 WIDTH |pi2Width|) - (AGGLST WIDTH |aggWidth|) - (BRACKET APP |bracketApp|) - (BRACE APP |braceApp|) - (BRACE WIDTH |qTWidth|) -)) (PROGN (MAKEPROP (CAR X) (CADR X) (CADDR X))) -) - -;; from DEF LISP - -(REPEAT (IN X '( - (|:| |DEF-:|) - (|::| |DEF-::|) - (ELT DEF-ELT) - (SETELT DEF-SETELT) - (%LET DEF-LET) - (COLLECT DEF-COLLECT) - (LESSP DEF-LESSP) - (|<| DEF-LESSP) - (REPEAT DEF-REPEAT) -;;(|TRACE,LET| DEF-TRACE-LET) - (CATEGORY DEF-CATEGORY) - (EQUAL DEF-EQUAL) - (|is| DEF-IS) - (SEQ DEF-SEQ) - (|isnt| DEF-ISNT) - (|where| DEF-WHERE) -)) (PROGN (MAKEPROP (CAR X) '|DEF-TRAN| (CADR X)) (CADR X))) ;; following was in INIT LISP @@ -343,13 +161,6 @@ (FLAG '(* + AND OR PROGN) 'NARY) -(REPEAT (IN X '( - (|Record| |mkRecordFunList|) - (|Union| |mkUnionFunList|) - (|Mapping| |mkMappingFunList|) - (|Enumeration| |mkEnumerationFunList|) -)) (MAKEPROP (CAR X) '|makeFunctionList| (CADR X))) - (MAKEPROP 'INTEGER 'ISFUNCTION 'FIXP) (MAKEPROP '|Integer| '|isFunction| '|IsInteger|) (MAKEPROP '|Boolean| '|isFunction| '|isBoolean|) -- cgit v1.2.3