REBOL [ Title: "Check for COBOL reserved word" Purpose: {This is a function that will take a string and return a true or false value after checking to see if the input word is a COBOL reserved word.} ] ;; [---------------------------------------------------------------------------] ;; [ This function accepts a string and checks to see if is a COBOL reserved ] ;; [ word, returning a true or false result. ] ;; [ It also accepts a word, but the original use was for a string because ] ;; [ originally the "words" to be checked came from parsing. ] ;; [ The function is packaged into a context for more general re-use. ] ;; [ The reserved word list was just copied from some internet site. ] ;; [ If anyone were to actually use this, he might want to replace the list ] ;; [ with the reserved for his own specific compiler. ] ;; [---------------------------------------------------------------------------] COBRESERVED: context [ RESERVEDWORDS: [ ACCEPT ACCESS ADD ADDRESS ADVANCING AFTER ALL ALLOWING ALPHABET ALPHABETIC ALPHABETIC-LOWER ALPHABETIC-UPPER ALPHANUMERIC ALPHANUMERIC-EDITED ALSO ALTER ALTERNATE AND ANY APPLY ARE AREA AREAS ARITHMETIC ASCENDING ASSIGN AT AUTHOR AUTOMATIC B-AND B-EXOR B-LESS B-NOT B-OR BASIS BEFORE BEGINNING BINARY BIT BITS BLANK BLOCK BOOLEAN BOTTOM BY CALL CANCEL CBL CD CF CH CHARACTER CHARACTERS CLASS CLASS-ID CLOCK-UNITS CLOSE COBOL CODE CODE-SET COLLATING COLUMN COM-REG COMMA COMMIT COMMON COMMUNICATION COMP COMP-1 COMP-2 COMP-3 COMP-4 COMP-5 COMP-6 COMP-7 COMP-8 COMP-9 COMPUTATIONAL COMPUTATIONAL-1 COMPUTATIONAL-2 COMPUTATIONAL-3 COMPUTATIONAL-4 COMPUTATIONAL-5 COMPUTATIONAL-6 COMPUTATIONAL-7 COMPUTATIONAL-8 COMPUTATIONAL-9 COMPUTE CONFIGURATION CONNECT CONTAINED CONTAINS CONTENT CONTINUE CONTROL CONTROLS CONVERTING COPY CORR CORRESPONDING COUNT CURRENCY CURRENT CYCLE DATA DATE DATE-COMPILED DATE-WRITTEN DAY DAY-OF-WEEK DB DB-ACCESS-CONTROL-KEY DB-DATA-NAME DB-EXCEPTION DB-RECORD-NAME DB-SET-NAME DB-STATUS DBCS DE DEBUG-CONTENTS DEBUG-ITEM DEBUG-LINE DEBUG-NAME DEBUG-SUB-1 DEBUG-SUB-2 DEBUG-SUB-3 DEBUGGING DECIMAL-POINT DECLARATIVES DEFAULT DELETE DELIMITED DELIMITER DEPENDING DESCENDING DESTINATION DETAIL DISABLE DISCONNECT DISPLAY DISPLAY-1 DISPLAY-2 DISPLAY-3 DISPLAY-4 DISPLAY-5 DISPLAY-6 DISPLAY-7 DISPLAY-8 DISPLAY-9 DIVIDE DIVISION DOWN DUPLICATE DUPLICATES DYNAMIC EGCS EGI EJECT ELSE EMI EMPTY ENABLE END END-ADD END-CALL END-COMPUTE END-DELETE END-DISABLE END-DIVIDE END-ENABLE END-EVALUATE END-IF END-INVOKE END-MULTIPLY END-OF-PAGE END-PERFORM END-READ END-RECEIVE END-RETURN END-REWRITE END-SEARCH END-SEND END-START END-STRING END-SUBTRACT END-TRANSCEIVE END-UNSTRING END-WRITE ENDING ENTER ENTRY ENVIRONMENT EOP EQUAL EQUALS ERASE ERROR ESI EVALUATE EVERY EXACT EXCEEDS EXCEPTION EXCLUSIVE EXIT EXTEND EXTERNAL FALSE FD FETCH FILE FILE-CONTROL FILLER FINAL FIND FINISH FIRST FOOTING FOR FORM FORMAT FREE FROM FUNCTION GENERATE GET GIVING GLOBAL GO GOBACK GREATER GROUP HEADING HIGH-VALUE HIGH-VALUES I-O I-O-CONTROL ID IDENTIFICATION IF IN INDEX INDEX-1 INDEX-2 INDEX-3 INDEX-4 INDEX-5 INDEX-6 INDEX-7 INDEX-8 INDEX-9 INDEXED INDICATE INHERITS INITIAL INITIALIZE INITIATE INPUT INPUT-OUTPUT INSERT INSPECT INSTALLATION INTO INVALID INVOKE IS JUST JUSTIFIED KANJI KEEP KEY LABEL LAST LD LEADING LEFT LENGTH LESS LIMIT LIMITS LINAGE LINAGE-COUNTER LINE LINE-COUNTER LINES LINKAGE LOCALLY LOCAL-STORAGE LOCK LOW-VALUE LOW-VALUES MEMBER MEMORY MERGE MESSAGE METACLASS METHOD METHOD-ID MODE MODIFY MODULES MORE-LABELS MOVE MULTIPLE MULTIPLY NATIVE NEGATIVE NEXT NO NORMAL NOT NULL NULLS NUMBER NUMERIC NUMERIC-EDITED OBJECT OBJECT-COMPUTER OCCURS OF OFF OMITTED ON ONLY OPEN OPTIONAL OR ORDER ORGANIZATION OTHER OUTPUT OVERFLOW OVERRIDE OWNER PACKED-DECIMAL PADDING PAGE PAGE-COUNTER PARAGRAPH PASSWORD PERFORM PF PH PIC PICTURE PLUS POINTER POSITION POSITIVE PRESENT PREVIOUS PRINTING PRIOR PROCEDURE PROCEDURE-POINTER PROCEDURES PROCEED PROCESSING PROGRAM PROGRAM-ID PROTECTED PURGE QUEUE QUOTE QUOTES RANDOM RD READ READY REALM RECEIVE RECONNECT RECORD RECORD-NAME RECORDING RECORDS RECURSIVE REDEFINES REEL REFERENCE REFERENCES RELATION RELATIVE RELEASE RELOAD REMAINDER REMOVAL RENAMES REPEATED REPLACE REPLACING REPORT REPORTING REPORTS REPOSITORY RERUN RESERVE RESET RETAINING RETRIEVAL RETURN RETURN-CODE RETURNING REVERSED REWIND REWRITE RF RH RIGHT ROLLBACK ROUNDED RUN SAME SD SEARCH SECTION SECURITY SEGMENT SEGMENT-LIMIT SELECT SELF SEND SENTENCE SEPARATE SEQUENCE SEQUENTIAL SERVICE SESSION-ID SET SHARED SHIFT-IN SHIFT-OUT SIGN SIZE SKIP1 SKIP2 SKIP3 SORT SORT-CONTROL SORT-CORE-SIZE SORT-FILE-SIZE SORT-MERGE SORT-MESSAGE SORT-MODE-SIZE SORT-RETURN SOURCE SOURCE-COMPUTER SPACE SPACES SPECIAL-NAMES STANDARD STANDARD-1 STANDARD-2 STANDARD-3 STANDARD-4 START STATUS STOP STORE STRING SUB-QUEUE-1 SUB-QUEUE-2 SUB-QUEUE-3 SUB-SCHEMA SUBTRACT SUM SUPER SUPPRESS SYMBOLIC SYNC SYNCHRONIZED TABLE TALLY TALLYING TAPE TENANT TERMINAL TERMINATE TEST TEXT THAN THEN THROUGH THRU TIME TIMEOUT TIMES TITLE TO TOP TRACE TRAILING TRANSCEIVE TRUE TYPE UNEQUAL UNIT UNSTRING UNTIL UP UPDATE UPON USAGE USAGE-MODE USE USING VALID VALIDATE VALUE VALUES VARYING WAIT WHEN WHEN-COMPILED WITH WITHIN WORDS WORKING-STORAGE WRITE WRITE-ONLY ZERO ZEROES ZEROS ] RESERVED?: func [ TESTWORD [word! string!] ] [ ;;;; RESERVEWORDS: head RESERVEDWORDS ;; no need to return to head of list TESTWORD: to-word TESTWORD ;; must search word list for a word either find RESERVEDWORDS TESTWORD [ return true ] [ return false ] ] ] ;; Uncomment to test ;CHECKWORD: "VARYING" ;either COBRESERVED/RESERVED? CHECKWORD [ ; print [CHECKWORD " is reserved"] ;] [ ; print [CHECKWORD " is NOT reserved"] ;] ;CHECKWORD: 'ACCEPT ;either COBRESERVED/RESERVED? CHECKWORD [ ; print [CHECKWORD " is reserved"] ;] [ ; print [CHECKWORD " is NOT reserved"] ;] ;CHECKWORD: "UMPTEEN" ;either COBRESERVED/RESERVED? CHECKWORD [ ; print [CHECKWORD " is reserved"] ;] [ ; print [CHECKWORD " is NOT reserved"] ;] ;CHECKWORD: "000100" ;either COBRESERVED/RESERVED? CHECKWORD [ ; print [CHECKWORD " is reserved"] ;] [ ; print [CHECKWORD " is NOT reserved"] ;] ;halt