github.com/retro-software.B5500-software
1
0
Fork 0
mirror of https://github.com/retro-software/B5500-software.git synced 2026-04-25 19:51:32 +00:00
Code Issues Releases Wiki Activity
Files
ef496fd66137ffc408ef1d3d8d91f909576795fc
retro-software.B5500-software/SNOBOL-UW-Chambers/SNTEST.card

382 lines
15 KiB
Plaintext
Raw Blame History

?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
* EXAMPLE 2, DIFFERENTIATION OF ALGEBRAIC EXPRESSION
*
* THIS PROGRAM DIFFERENTIATES A FULLY PARENTHESIZED
* ALGEBRAIC EXPRESSION WITH RESPECT TO X. THE EXPONENTIATION
* OPERATOR IS INDICATED BY A DOLLAR SIGN.
- SPACE 2
DEFINE("D(D)","DO","U,V,N")
DEFINE("SIMPLIFY(EXP)","S0","U")
TRACE("D,SIMPLIFY")
- SPACE
* READ IN THE EXPRESSION.
- SPACE
READ EXP = TRIM(SYSPIT) /F(END)
- SPACE
MODE("ANCHOR")
SYSPOT =
SYSPOT = "THE DERIVATIVE OF " EXP " IS " SIMPLIFY(D(EXP))
. /(END)
- SPACE 2
* THE FUNCTION "D"
- SPACE
DO D "(" *(U)* "+" *(V)* ")" = "(" D(U) "+" D(V) ")"
. /S(RETURN)
- SPACE
D "(" *(U)* "-" *(V)* ")" = "(" D(U) "-" D(V) ")"
. /S(RETURN)
- SPACE
D "(" *(U)* "*" *(V)* ")" = "((" U "*" D(V) ")+("
. V "*" D(U) "))" /S(RETURN)
- SPACE
D "(" *(U)* "/" *(V)* ")" = "(((" V "*" D(U) ")-("
. U "*" D(V) "))/(" V "$2))" /S(RETURN)
- SPACE
D "(" *(U)* "$" *(V)* ")" =
. "((" N "*(" U "$" N - "1" "))*" D(U) ")"
. /S(RETURN)
- SPACE
D = EQUALS(D,"X") "1" /S(RETURN)
D = "0" /(RETURN)
* THE FUNCTION "SIMPLIFY"
- SPACE
S0 MODE("UNANCH")
S1 EXP "(" *(U)* "*0)" = "0" /S(S1)
EXP "(0*" *(U)* ")" = "0" /S(S1)
S2 EXP "(" *(U)* "$1)" = U /S(S2)
S3 EXP "(" *(U)* "*1)" = U /S(S3)
S4 EXP "(1*" *(U)* ")" = U /S(S4)
S5 EXP "(0+" *(U)* ")" = U /S(S5)
S6 EXP "(" *(U)* "+0)" = U /S(S6)
S7 EXP "(" *(U)* "-0)" = U /S(S7)
SIMPLIFY = EXP /(RETURN)
END
?DATA CARD
(((A*(X$2))+(B*X))+C)
?END
?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
* EXAMPLE 1. THE WANG ALGORITHM
*
* THIS PROGRAM IS THE ALGORITHM BY HAO WANT (CF. "TOWARD
* MECHANICAL MATHEMATICS", IBM JOURNAL BE RESEARCH AND
* DEVELOPMENT FOR THE PROPOSITIONAL CALCULUS., IT PRINTS OUT A
* PROOF OR DISPROOF ACCORDING AS A GIVEN FORMULA IS A THEOREM
* OR NOT. THEALOGRITHM USES SEQUENTS WHICH CONSIST OF TWO
* LISTS OF FORMULAS SEPERATED BY AN ARROW (--*). INITIALLY, FOR
* A GIVEN FORMULA P THE SEQUENT
*
* --* F
*
* IS FORMED. WANG HAS DEFINED RULES FOR SIMPLIFYING A FORMULA
* IN A SEQUENT BY REMOVING THE MAIN CONNECTIVE AND THEN
* GENERATING A NEW SEQUENT OR SEQUENTS. THERE IS A TERMINAL
* TEST FOR A SEQUENT CONSISTING OF ONLY ATOMIC FORMULAS:
*
* TWO SEQUENT CONSISTING OF ONLY ATOMIC FORMULAS IS VALID IF
* THE TWO LISTS OF FORMULAS HAVE A FORMULA IN COMMON.
*
* BY REPEATED APPLICATION OF THE RULES ONE IS LED TO A SET OF
* SEQUENTS CONSISTING OF ATOMIC FORMULAS. IF EACH ONE OF THESE
* SEQUENTS IS VALID THEN SO IS THE ORIGINAL FORMULA.
- SPACE 5
DEFINE("WANG(ANTE,CONSEQ)" , "WANG","PHI,PSI")
* READ IN THE EXPRESSION
- SPACE
READ EXP = TRIM(SYSPIT) /F(END)
SYSPOT =
SYSPOT = "FORMULA: " EXP
SYSPOT =
WANG(," " EXP) /F(INVALID)
SYSPOT = "VALID" /(READ)
INVALID SYSPOT = "NOT VALID" /(READ)
WANG SYSPOT = ANTE " --* " CONSEQ
ANTE " NOT(" *(PHI)* ")" = /S(ANOT)
ANTE " AND(" *(PHI)* "," *(PSI)* ")" = /S(AAND)
ANTE " IMP(" *(PHI)* "," *(PSI)* ")" = /S(AIMP)
ANTE " OR(" *(PHI)* "," *(PSI)* ")" = /S(AOR)
ANTE " EQU(" *(PHI)* "," *(PSI)* ")" = /S(AEQU)
- SPACE
CONSEQ " NOT(" *(PHI)* ")" = /S(CNOT)
CONSEQ " AND(" *(PHI)* "," *(PSI)* ")" = /S(CAND)
CONSEQ " IMP(" *(PHI)* "," *(PSI)* ")" = /S(CIMP)
CONSEQ " OR(" *(PHI)* "," *(PSI)* ")" = /S(COR)
CONSEQ " EQU(" *(PHI)* "," *(PSI)* ")" = /S(CEQU)
- SPACE
(ANTE " :" CONSEQ " ") " " *(P)* " " ** ":" ** " " P " "
. /S(RETURN)F(FRETURN)
ANOT WANG(ANTE,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
-
AAND WANG(ANTE " " PHI " " PSI, CONSEQ) /S(RETURN)F(FRETURN)
-
AOR WANG(ANTE " " PHI,CONSEQ) /F(FRETURN)
WANG(ANTE " " PSI,CONSEQ) /S(RETURN)F(FRETURN)
-
AIMP WANG(ANTE " " PSI,CONSEQ) /F(FRETURN)
WANG(ANTE,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
-
AEQU WANG(ANTE " " PHI " " PSI,CONSEQ) /F(FRETURN)
WANG(ANTE,CONSEQ " " PHI " " PSI) /S(RETURN)F(FRETURN)
-
CNOT WANG(ANTE " " PHI,CONSEQ) /S(RETURN)F(FRETURN)
-
CAND WANG(ANTE,CONSEQ " " PHI) /F(FRETURN)
WANG(ANTE,CONSEQ " " PSI) /S(RETURN)F(FRETURN)
-
COR WANG(ANTE,CONSEQ " " PHI " " PSI) /S(RETURN)F(FRETURN)
-
CIMP WANG(ANTE " " PHI,CONSEQ " " PSI) /S(RETURN)F(FRETURN)
-
CEQU WANG(ANTE " " PHI,CONSEQ " " PSI) /F(FRETURN)
WANG(ANTE " " PSI,CONSEQ " " PHI) /S(RETURN)F(FRETURN)
END
IMP(NOT(OR(P,Q)),NOT(P))
IMP(AND(NOT(P),NOT(Q)),EQU(P,Q))
IMP(IMP(OR(P,Q),OR(P,R)),OR(P,IMP(Q,R)))
STOP
?END
?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
* BLANK IS A CONCATENATION OPERATOR!
FIRST = "HORACE"
SECOND = "GREELEY"
NAME = FIRST " " SECOND
SYSPOT = NAME
INT = 12 DIV 2 * 3
* MULTIPLICATION HAS HIGHER PRECEDENCE THAN DIVISION
* ARITHMETIC HAS HIGHER PRECENCE THAN CONCATENATION
SYSPOT = "12 / 2 * 3 = " INT
* CONCATENATE A STRING AND A NUMBER
ROW = "K"
NO. = 23
SEAT = ROW NO.
SYSPOT = SEAT
* GET AN INPUT STRING
STUFF = SYSPIT
* CHANGE ALL INSTANCES OF "CAT" TO "DOG"
LOOP STUFF "CAT" = "DOG" /S(LOOP)
SYSPOT = STUFF
* IS IT A NUMBER OR A STRING?
X = 1234
X "2" = 5
SYSPOT = X
END
THE CAT JUMPED OVER THE DOG.
THE DOG JUMPED OVER THE CAT.
?END
?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
* ID START
* DATA
READ LINE = SYSPIT
LINE "STOP" /S(QUIT)
NLINE = LINE
NLINE *LAST* "," *FIRST* "-" *TITLE*
AUTHOR = FIRST " " LAST
TITLE = " " TITLE " "
TITLE " THE " = " "
TITLE " A " = " "
TITLE " AN " = " "
STITLE = TITLE
DEBLANK TITLE " " = " " /S(DEBLANK)
LOOP TITLE " " = "," /S(LOOP)
TITLE *FIRSTCHAR/"1"* =
WORDLIST = WORDLIST TITLE
SYSPOT = LINE
SYSPOT = AUTHOR "-" STITLE
SYSPOT = TITLE "$" WORDLIST
/(READ)
QUIT SIZE = "14"
REDEFINE ALPHABET = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789. "
DECR SIZE = SIZE - "1"
SIZE "-" /S(DONE)
BACK WORDLIST *WORD* "," = /F(LAST)
WORD *HEAD/SIZE* *PIT/"1"* /F(ALL)
$PIT = $PIT WORD "," /(BACK)
ALL BIN = BIN WORD "," /(BACK)
LAST BIN *WORDLIST* =
AGAIN ALPHABET *PIT/"1"* = /F(REDEFINE)
WORDLIST = WORDLIST $PIT
$PIT = /(AGAIN)
DONE SYSPOT = "WORDLIST" WORDLIST
END READ
STURGEON,THEODORE-MORE THAN HUMAN
SMITH,E.E.-GRAY LENSMAN
SMITH,E.E.-TRIPLANETARY
RAGAN,RICHARD-TEST THE PROGRAM
STOP
?END
?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
DEFINE("PERM(NAME,RENAME)","ENT")
READ1 CARD1 = SYSPIT
CARD1 "STOP" /S(END)
CARD2 = SYSPIT
CARD1 *NUMCOD1/"6"* =
CARD2 *NUMCOD2/"4"* =
CARD1 *Y/"2"* =
CARD2 *Y/"4"* =
EQUALS(CARD1,CARD2) /S(SAME)
NUM1 = PERM(CARD1,"FIRST")
NUM2 = PERM(CARD2,"LAST")
.EQ(NUM1,NUM2) /S(ASET)
.LT(NUM1,NUM2) /S(FILL1)F(FILL2)
FILL1 A = NUM1
ADD A = A + "1"
$("FIRST" A ) =
.EQ(A,NUM2) /F(ADD)S(CONT)
FILL2 A = NUM2
INCR A = A + "1"
$("LAST" A) =
.EQ(A,NUM1) /F(INCR)S(CONT)
ASET A = NUM1
CONT COUNT = "0"
MORE COUNT = COUNT + "1"
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("FIRST" COUNT)
SYSPOT = NUMCOD1 " " NUMCOD2 " " $("LAST" COUNT)
.EQ(COUNT,A) /F(MORE)S(READ1)
SAME SYSPOT = NUMCOD1 " " NUMCOD2 " " CARD1 /(READ1)
ENT NAME = TRIM(NAME) " "
DEBLANK NAME " " = " " /S(DEBLANK)
NAME *WORD1* " " =
NAME = NAME "$" WORD1 " "
PERM = "0"
LOOP PERM = PERM + "1"
NAME *WORD* " " =
NAME = NAME WORD " "
NAME ANCHOR(X) "$" = /S(RETURN)
$(RENAME PERM ) = NAME
CLEAN $(RENAME PERM ) "$" = /S(CLEAN)F(LOOP)
END
STURGEON,THEODORE-MORE THAN HUMAN
SMITH,E.E.-GRAY LENSMAN
SMITH,E.E.-TRIPLANETARY
RAGAN,RICHARD-TEST THE PROGRAM
STOP
?END
?EXECUTE SNOBOL/DISK
?FILE PRINT = PRINT BACK UP DISK
?COMMON=3
?DATA PROGRAM
-LIST
- TITLE PROCESS S A T AND 1 2 T H G R A D E CARDS.
* THIS PROGRAM TAKES AN SAT CARD AND A 12TH GRADE SCHOOL CARD
* AND ATTEMPTS TO GENERATE A SINGLE CARD COMBINING THE
* INFORMATION ON BOTH OF THESE. IN PARTICULAR THE PROGRAM
* SEARCHES OUT THE BEST SCHOOL NAME FROM THE TWO CARDS.
* WHEN A MATCH IS NOT OBTAINED MULTIPLE CARDS ARE GENERATED
* CONTAINING CYCLIC PERMUTATIONS OF THE SCHOOL NAME FROM
* BOTH CARDS. THE CHOICE OF THE ADDRESS CARD TO BE USED
* IS LEFT TO THE DISCRETION OF THE USER. IN GENERAL
* ONLY ONE CARD WILL BE GENERATED SINCE CERTAIN KEYWORDS
* SUCH AS "HIGH" , "SCHOOL", "HS", "H S" ARE ELIMINATED
* FROM THE TEXT BEFORE COMPARISON OF SCHOOL NAMES IS
* ATTEMPTED. THIS RESULTS IN A MUCH HIGHER PERCENTAGE OF
* MATCHES THAN WOULD OTHERWISE BE OBTAINED.
*
* RICHARD RAGAN
* FSU COMPUTING CNTR.
* 5-1-66
DEFINE("EXCERPT(STRING,WORD1,WORD2)","ENTRY")
DEFINE("PERM(NAME,RENAME)","ENT")
DEFINE("HSGET(SNAME,SLOC)","Z")
DEFINE("RESTOR(QUAL,QUAN)","104")
BLANK = " "
READ SAT = SYSPIT
SAT "STOP" /S(END)
12TH = SYSPIT
12TH *12CODE/"4"* *FILLER/"3"* *12NAME/"27"* *COUNTY/"4"*
. *FILLER/"3"* *CTYCODE/"2"* *FILLER/"3"* *12LOC*
SAT *FILLER/"2"* *SATCODE/"4"* *FILLER/"2"* *SATNAME/"21"*
. *FILLER/"22"* *SATLOC*
12NAME = TRIM(12NAME) " "
SATNAME = TRIM(SATNAME) " "
DEMIN 12NAME "-" = " " /S(DEMIN)
DEMINUS SATNAME "-" = " " /S(DEMINUS)
SATNAME = HSGET(SATNAME,12LOC)
S12NAME = 12NAME
SSATNAME = SATNAME
12NAME = EXCERPT(12NAME," SCHOOL "," SCH ")
12NAME = EXCERPT(12NAME," H "," S ")
12NAME = EXCERPT(12NAME," HS "," HIGH ")
SATNAME = EXCERPT(SATNAME," SCHOOL "," SCH ")
SATNAME = EXCERPT(SATNAME," H "," S ")
SATNAME = EXCERPT(SATNAME," HS "," HIGH ")
12NAME = EXCERPT(12NAME," SR "," JR ")
SATNAME = EXCERPT(SATNAME," SR "," JR ")
EQUALS(12NAME,SATNAME) /S(LUCK)
OFF = RESTOR(12NAME,S12NAME)
ON = RESTOR(SATNAME,SSATNAME)
P12 = PERM(12NAME,"12.")
PSAT = PERM(SATNAME,"SAT.")
COUNT = "0"
MORE COUNT = COUNT + "1"
ALL = $("12." COUNT) OFF
ALL = ALL BLANK
ALL *FIXFLD/"27"*
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FIXFLD TRIM(12LOC)
.EQ(P12,COUNT) /F(MORE)
COUNT = "0"
AGAIN COUNT = COUNT + "1"
NONE = $("SAT." COUNT) ON
NONE = NONE BLANK
NONE *FLD/"27"*
SYSPPT = 12CODE SATCODE CTYCODE COUNTY FLD TRIM(12LOC)
.EQ(PSAT,COUNT) /F(AGAIN)S(READ)
LUCK .GE(SIZE(S12NAME),SIZE(SSATNAME)) /S(S12)F(SSAT)
S12 S12NAME = S12NAME BLANK
S12NAME *SAVE/"27"*
SYSPPT = 12CODE SATCODE CTYCODE COUNTY SAVE TRIM(12LOC)
. /(READ)
SSAT SSATNAME = SSATNAME BLANK
SSATNAME *KEEP/"27"*
SYSPPT = 12CODE SATCODE CTYCODE COUNTY KEEP TRIM(12LOC)
. /(READ)
- EJECT
ENTRY STRING WORD1 = " "
STRING WORD2 = " "
EXCERPT = STRING /(RETURN)
- EJECT
Z SNAME ANCHOR(X) "HIGH SCHOOL" /F(FRETURN)
SLOC *TNAME* "FLORIDA" /S(ROTAT)
SLOC *TNAME* "FLA" /F(FRETURN)
ROTAT HSGET = TNAME SNAME /(RETURN)
- EJECT
ENT NAME = TRIM(NAME) " "
PERM = "1"
DEBLANK NAME " " = " " /S(DEBLANK)
$(RENAME PERM) = NAME
NAME *WORD1* " " =
NAME = NAME "$" WORD1 " "
NAME ANCHOR(X) "$" = /S(RETURN)
LOOP PERM = PERM + "1"
$(RENAME PERM) = NAME
NAME *WORD* " " =
NAME ANCHOR(X) "$" = /S(OKAY)
NAME = NAME WORD " "
CLEAN $(RENAME PERM) "$" = /S(CLEAN)
BL $(RENAME PERM) " " = " " /S(BL)F(LOOP)
OKAY $(RENAME PERM) "$" = /(RETURN)
- EJECT
104 QUAN QUAL *CODE*
RESTOR = TRIM(CODE) " " /(RETURN)
END
?END
Reference in New Issue View Git Blame Copy Permalink