Changeset 5

Show
Ignore:
Timestamp:
07/13/07 08:45:44 (1 year ago)
Author:
andrew.pennebak..@gmail.com
Message:

Moved all BF interpreters to bf/.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • bf/bf.py

    r3 r5  
    7373 
    7474def main(): 
    75         systemArgs=sys.argv[1:] # ignore program name 
     75        systemArgs=sys.argv[1:] 
    7676 
    7777        live=False 
    …… 
    103103                        code+=line 
    104104 
    105                         position=run(code, position) #position=len(code) 
     105                        position=run(code, position) 
    106106        else: 
    107107                src=args[0] 

  • bf/bf.scm

    r1 r5  
    1 ; SchemeBF: A scheme interpreter of the brainfuck programming language. 
    2 ; v 0.2.3 
    3 ; Amrik S. Kochhar 
    4 ; amrik[at]mit[dot]edu 05.14.2006 
    5 ; 
    6 ; Feel free to distribute. 
    7 ; 
    8 ; 
    9 ; Taken from Wikipedia: 
    10 ; 
    11 ;>      Move the pointer to the right 
    12 ;<      Move the pointer to the left 
    13 ;+      Increment the memory cell under the pointer 
    14 ;-      Decrement the memory cell under the pointer 
    15 ;.      Output the character signified by the cell at the pointer 
    16 ;,      Input a character and store it in the cell at the pointer 
    17 ;[      Jump past the matching ] if the cell under the pointer is 0 
    18 ;]      Jump back to the matching [ 
     1; Andrew Pennebaker 
     2; 13 Jul 2007 
     3; License: GPL 
    194 
    20 ; --------------- 
    21 ; Version history 
    22 ; --------------- 
    23 ; 
    24 ; v 0.2 
    25 ; - Massive speed improvements by using an improved assign algorithm and using hash-tables for bracket lookup. 
    26 ; 
    27  
    28 ; v 0.1 
    29 ; - Initial release 
    30  
    31 ;;;;;;;;;;; VARIABLE INITIALISATION ;;;;;;;;;;; 
    32  
    33 (define (make-hash) (make-hash-table 'equal)) 
    34 (define (hash-put! table key value) (hash-table-put! table key value)) 
    35 (define (hash-get table key) (hash-table-get table key (lambda () 'none))) 
    36  
    37 (define memory (make-vector 30000)) 
    38 (define myptr 0) 
    39 (define string-ptr 0)  
    40 (define loop-begin 0)  
    41 (define mystring "") 
    42 (define my-open-hash (make-hash)) 
    43 (define my-close-hash (make-hash)) 
    44 (define stored-length 0) 
    45 (define stored-length2 0) 
    46 (define comma-flag 0) 
    47 ;The following all have to be procedures because of the dynamic values of memory and myptr. If they were hard-defined (as values and not as procedures) then they would be stuck with the initial value. 
    48  
    49 (define (inc!) (if (= myptr 29999) (set! myptr 0) ;30000 cell wraparound hardcoded 
    50                    (set! myptr (add1 myptr)))) 
    51 (define (dec!) (if (= myptr 0) (set! myptr 29999) ;30000 cell wraparound again 
    52                    (set! myptr (sub1 myptr)))) 
    53  
    54 (define (plus!)  (if  (= (vector-ref memory myptr) 255) (vector-set! memory myptr 0) ;8 bit integer wraparound hardcoded 
    55                       (vector-set! memory myptr (add1 (vector-ref memory myptr))))) 
    56  
    57 (define (minus!)  (if (= (vector-ref memory myptr) 0) (vector-set! memory myptr 255) ;8 bit wraparound hardcoded again 
    58                       (vector-set! memory myptr (sub1 (vector-ref memory myptr))))) 
    59  
    60 (define (dot!)    (display (integer->char (vector-ref memory myptr)))) 
    61  
    62 (define (comma!) (begin (if (= comma-flag 0) (display "Enter data as one character after another without spaces:")) 
    63                         (set! comma-flag 1) 
    64                         (let ((bit (char->integer (read-char)))) 
    65                           (vector-set! memory myptr bit)))) 
    66  
    67  
    68  
    69 ;Brackets only operate on the string-pointer. 
    70  
    71 ;if the next character in the list is a close-bracket, cons them together. 
    72 ;else (i.e. the next character is another open-bracket) [1[2[3]]]) 
    73 ;then you need to find the correct bracket to cons it with, hence find the first unbalanced close-bracket, looking right. 
    74 ; 
    75 ;For each bracket, remove it from the list of brackets. Then find the unmatched close bracket. 
    76 ;So (cdr lst1) and then go through the values until you get -1 in which case this is the unmatched close bracket. 
    77 ;so cons them together. 
    78 (define (remove! obj lst) 
    79   (define (remove-helper! lst obj front-ptr) 
    80     (cond ((equal? (car lst) obj) (cdr lst)) 
    81           ((< (length lst) 2) (cond ((null? lst) '()) 
    82                                     ((equal? (car lst) obj) '()) 
    83                                     (else front-ptr))) 
    84           ((equal? (second lst) obj) (begin (set-cdr! lst (cddr lst)) 
    85                                             front-ptr)) 
    86           (else (remove-helper! (cdr lst) obj front-ptr)))) 
    87   (remove-helper! lst obj lst)) 
    88  
    89 ;Binary search takes an ascending ordered list and a key 
    90 ;It looks in the list for the key and returns #f if it cannot find it, otherwise the index at which it is located. 
    91 (define (binary-search lst key) 
    92   (define (helper lst key begin end) 
    93     (if (or (> begin end) (< end begin)) #f 
    94         (let* ((index (floor (/ (+ begin end) 2))) 
    95                (test (list-ref lst index))) ;list-ref might be a bad idea, in the next version I will switch to vectors 
    96           (cond ((< test key) (helper lst key (+ index 1) end)) 
    97                 ((> test key) (helper lst key begin (- index 1))) 
    98                 (else index))))) 
    99   (helper lst key 0 (- (length lst) 1))) 
    100  
    101 (define (new-assign first lst1 lst2 acc prev-counter counter-list) 
    102   (cond ((and (< acc 0) (> prev-counter 0)) (list first prev-counter)) 
    103         ((binary-search lst1 (car counter-list)) 
    104          (new-assign first lst1 lst2 (add1 acc) (car counter-list)(cdr counter-list))) 
    105         ((binary-search lst2 (car counter-list)) 
    106          (new-assign first lst1 lst2 (sub1 acc) (car counter-list) (cdr counter-list))) 
    107         (else (error "There is a counter in counter-list that isn't in either lst1 or lst2")))) 
    108  
    109 (define (make-counter-list lst1 lst2) 
    110   (cond ((null? lst1) lst2) 
    111         ((null? lst2) lst1) 
    112         ((<= (car lst1) (car lst2)) (cons (car lst1) (make-counter-list (cdr lst1) lst2))) 
    113         ((> (car lst1) (car lst2)) (cons (car lst2) (make-counter-list lst1 (cdr lst2)))) 
    114         (else 'error))) 
    115  
    116 (define (go-assign lst1 lst2 hash1 hash2) 
    117   (if (null? lst1) (list hash1 hash2) 
    118       (let* ((counter-list (make-counter-list lst1 lst2)) 
    119              (myval (new-assign (car lst1) (cdr lst1) lst2 0 (car counter-list) (cdr counter-list)))) 
    120         (begin 
    121           ;display the percentage of completion 
    122           (set! stored-length2 (sub1 stored-length2)) 
    123           (display (* 100.0 (- 1 (/ stored-length2 stored-length))))(display #\%)(newline) 
    124           (hash-put! hash1 (car myval) (cadr myval)) 
    125           (hash-put! hash2 (cadr myval) (car myval)) 
    126           (go-assign (remove! (car myval) lst1) (remove! (cadr myval) lst2) hash1 hash2))))) 
    127  
    128 (define (get-brackets-list string) 
    129   (define (get-brackets-helper string counter open-list close-list) 
    130     (cond ((= counter (string-length string)) (begin (set! stored-length (length open-list)) 
    131                                                      (set! stored-length2 (+ stored-length 0)) ;copy stored-length, instead of creating a pointer to it 
    132                                                      (go-assign open-list close-list my-open-hash my-close-hash))) 
    133           ((char=?  (string-ref string counter) #\[)  
    134            (get-brackets-helper string (add1 counter) (append open-list (list counter)) close-list)) 
    135           ((char=?  (string-ref string counter) #\]) 
    136            (get-brackets-helper string (add1 counter) open-list (append close-list (list counter)))) 
    137           (else (get-brackets-helper string (+ counter 1) open-list close-list)))) 
    138   (get-brackets-helper string 0 '() '())) 
    139  
    140  
    141 (define (open-bracket) 
    142   (if (= (vector-ref memory myptr) 0)  
    143       (set! string-ptr (hash-get my-open-hash string-ptr)))) 
    144  
    145 (define (close-bracket) (set! string-ptr (hash-get my-close-hash string-ptr))) 
    146 ;Unconditional jump back to corresponding open-bracket. 
    147  
    148 ;General parsing strategy: 
    149 ;Pseudo-code: 
    150 ;Termination condition: string-ptr goes out of bounds. 
    151 ;Else: Read the letter referenced by string-ptr and compute what it does. 
    152  
    153 ;Comment remover procedure 
    154 ;Type string->string 
    155 ;Complexity: t(n)~ O(n), s(n) ~ O(1) 
    156 ;Inputs a string and if the character is not in the specified character set, ignore it and continue. 
    157 (define (remove-comments string) 
    158   (define (remove-comments-helper string acc) 
    159     (if (not (string=? string "")) 
    160         (let ((f (substring string 0 1))) 
    161           (if (or (string=? f "+") (string=? f "-")  
    162                   (string=? f ">") (string=? f "<")  
    163                   (string=? f ".") (string=? f ",") 
    164                   (string=? f "[") (string=? f "]")) 
    165               (remove-comments-helper (substring string 1 (string-length string)) (string-append acc f)) 
    166               (remove-comments-helper (substring string 1 (string-length string)) acc))) 
    167         acc)) 
    168   (remove-comments-helper string "")) 
    169  
    170 (define (bf string) 
    171   (cond ((>= string-ptr (string-length string)) (newline)) ;modify this to include an automatic reset 
    172         (else (read-char) 
    173               (set! mystring string) ;remove comments from the input string (unfortunately this takes too long so I removed it) 
    174               (display "Generating loop structure. This could take a while...") 
    175               (get-brackets-list mystring) 
    176               (display "Done.") 
    177               (newline) 
    178               (compute mystring)))) 
    179  
    180 (define (compute string) 
    181   (if (>= string-ptr (string-length string)) (newline) 
    182       (let ((first (string-ref string string-ptr))) 
    183         (cond ((string=? string "") (error: "Null string")) 
    184               ((char=? #\> first) (begin (inc!) 
    185                                          (set! string-ptr (add1 string-ptr)) 
    186                                          (compute string)))    
    187               ((char=? #\< first) (begin (dec!) 
    188                                          (set! string-ptr (add1 string-ptr)) 
    189                                          (compute string))) 
    190               ((char=? #\+ first) (begin (plus!) 
    191                                          (set! string-ptr (add1 string-ptr)) 
    192                                          (compute string))) 
    193               ((char=? #\- first) (begin (minus!) 
    194                                          (set! string-ptr (add1 string-ptr)) 
    195                                          (compute string))) 
    196               ((char=? #\. first) (begin (dot!) 
    197                                          (set! string-ptr (add1 string-ptr)) 
    198                                          (compute string))) 
    199               ((char=? #\, first) (begin (comma!) 
    200                                          (set! string-ptr (add1 string-ptr)) 
    201                                          (compute string))) 
    202               ((char=? #\[ first) (begin (open-bracket) 
    203                                          (set! string-ptr (add1 string-ptr)) 
    204                                          (compute string))) 
    205               ((char=? #\] first) (begin (close-bracket) 
    206                                          (compute string))) 
    207               (else (begin (set! string-ptr (add1 string-ptr)) 
    208                            (compute string))))))) 
    209  
    210 (display "Welcome to SchemeBF v 0.2.3! A scheme interpreter of the brainfuck programming language.") 
    211 (newline)(display "Amrik S. Kochhar") 
    212 (newline)(display "amrik[at]mit[dot]edu 05.14.2006") 
    213 (newline) 
    214 (define (start) 
    215   (set! memory (make-vector 30000)) 
    216   (set! myptr 0) 
    217   (set! string-ptr 0)  
    218   (set! loop-begin 0)  
    219   (set! mystring "") 
    220   (set! stored-length 0) 
    221   (set! stored-length2 0) 
    222   (set! comma-flag 0) 
    223   (display "Instructions:")(newline) 
    224   (display "Enter BF code you wish to compile with double quotes e.g. ")(display #\")(display "+++")(display #\")(display":") 
    225   (newline) 
    226   (bf (read))) 
    227 (start) 
    228 ; 
    229 ;Here's a sample program I wrote that you can try: 
    230 ; 
    231 ;++++++++[>++++++++<-]>+.-----------[>++<-]>+.+++++.---------.++.>++++++++[>++++<-]>.-------[>+++<-]>.<<<++++.------------.[>+>+<<-]>+++++..>--.<++++++++++.<++[<++++++>-]<--.+++.>>>>>+++++++++[>++++++<-]>.--------.++..+. 
     5(define run (instructions position) 
     6        (newline))