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