fork download
copy 
  1. ;; Define helper functions
  2. (define (drop-while pred lis)
  3.   (if (or (null? lis) (not (pred (car lis))))
  4.       lis
  5.       (drop-while pred (cdr lis))))
  6.  
  7. (define (take-while pred lis)
  8.   (define (take-while-helper pred lis result)
  9.     (if (and (not (null? lis)) (pred (car lis)))
  10.         (take-while-helper pred (cdr lis) (cons (car lis) result))
  11.         (reverse result)))
  12.   (take-while-helper pred lis '()))
  13.  
  14. (define (char-other? ch)
  15.   (not (or (= (char->integer ch) 91)
  16.            (= (char->integer ch) 93)
  17.            (= (char->integer ch) 40)
  18.            (= (char->integer ch) 41)
  19.            (= (char->integer ch) 32)
  20.            (= (char->integer ch) 10))))
  21.  
  22. (define (process-other chars)
  23.   (and (not (null? chars))
  24.        (let* ((token-chars (take-while char-other? chars))
  25.               (rest (drop-while char-other? chars)))
  26.          (list token-chars rest))))
  27.  
  28. ;; Custom function to check if all elements in a list are characters
  29. (define (all-char? lis)
  30.   (if (null? lis)
  31.       #t
  32.       (and (char? (car lis)) (all-char? (cdr lis)))))
  33.  
  34. (define (token-list x)
  35.   (if (and (pair? x) (all-char? x))
  36.       (list->string x)
  37.       x))
  38.  
  39. ;; Functions for Dot Count
  40. (define (process-dots chars)
  41.   (let* ((dot-chars (take-while (lambda (ch) (char=? ch (integer->char 46))) chars))  ; char 46 is '.'
  42.          (num-dots (length dot-chars))
  43.          (rest (drop-while (lambda (ch) (char=? ch (integer->char 46))) chars)))
  44.     (list num-dots rest)))
  45.  
  46. ;; Function to gather a specified number of items from the list
  47. (define (take n lis)
  48.   (if (or (<= n 0) (null? lis))
  49.       '()
  50.       (cons (car lis) (take (- n 1) (cdr lis)))))
  51.  
  52. ;; Function to drop a specified number of items from the list
  53. (define (drop n lis)
  54.   (if (or (<= n 0) (null? lis))
  55.       lis
  56.       (drop (- n 1) (cdr lis))))
  57.  
  58. ;; Function to gather items based on the number of dots
  59. (define (gather-items tokens num-dots)
  60.   (let loop ((remaining num-dots) (items '()) (rest (reverse tokens)))
  61.     (if (or (= remaining 0) (null? rest))
  62.         (list (reverse items) (reverse rest))
  63.         (loop (- remaining 1) (cons (car rest) items) (cdr rest)))))
  64.  
  65. ;; Pretty-print function to print tokens on one line
  66. (define (pretty-print tokens)
  67.   (if (null? tokens)
  68.       (newline)
  69.       (begin
  70.         (write (car tokens))
  71.         (when (not (null? (cdr tokens))) (display " "))  ; Add a space between tokens
  72.         (pretty-print (cdr tokens)))))
  73.  
  74. ;; Define main tokenize function with debugging statements
  75. (define (tokenize input)
  76.   (let loop ((chars (string->list input)) (tokens '()) (accumulated-tokens '()))
  77.     (cond
  78.       ((null? chars) (let ((final-tokens (map token-list tokens)))
  79.                        (pretty-print final-tokens)  ; Pretty print the final tokens
  80.                        final-tokens))
  81.       ((char=? (car chars) (integer->char 91))  ; Handle opening bracket [
  82.        (begin
  83.          (display "Tokenizing [\n")
  84.          (loop (cdr chars) (cons "[" tokens) (cons "[" accumulated-tokens))))
  85.       ((char=? (car chars) (integer->char 93))  ; Handle closing bracket ]
  86.        (begin
  87.          (display "Tokenizing ]\n")
  88.          (loop (cdr chars) (cons "]" tokens) (cons "]" accumulated-tokens))))
  89.       ((char=? (car chars) (integer->char 40))  ; Handle opening parenthesis
  90.        (begin
  91.          (display "Tokenizing (\n")
  92.          (loop (cdr chars) (cons "(" tokens) (cons "(" accumulated-tokens))))
  93.       ((char=? (car chars) (integer->char 41))  ; Handle closing parenthesis
  94.        (begin
  95.          (display "Tokenizing )\n")
  96.          (loop (cdr chars) (cons ")" tokens) (cons ")" accumulated-tokens))))
  97.       ((char=? (car chars) (integer->char 32))  ; Skip spaces
  98.        (begin
  99.          (display "Skipping space\n")
  100.          (loop (cdr chars) tokens accumulated-tokens)))
  101.       ((char=? (car chars) (integer->char 46))  ; Handle dots (.)
  102.        (let* ((result (process-dots chars))
  103.               (num-dots (car result))
  104.               (rest (cadr result))
  105.               (gathered-items (gather-items (reverse tokens) num-dots)))  ; Gather from right
  106.          (begin
  107.            (display "Processing dots: ")
  108.            (display num-dots)
  109.            (display "\nGathered items: ")
  110.            (display (car gathered-items))
  111.            (display "\nRemaining tokens: ")
  112.            (display (cdr gathered-items))
  113.            (display "\n")
  114.            (loop rest (cons "(" (append (car gathered-items) (cons ")" tokens))) (cdr gathered-items)))))
  115.       (else
  116.        (let* ((result (process-other chars))
  117.               (token (car result))
  118.               (rest (cadr result)))
  119.          (begin
  120.            (display "Tokenizing ")
  121.            (display token)
  122.            (display "\n")
  123.            (loop rest (cons token tokens) (cons token accumulated-tokens))))))))
  124.  
  125. ;; Example usage
  126. (define input "(define) f g (). 1 2")
  127.  
  128. (tokenize input)  ; Display tokens for debugging
  129.  
Success #stdin #stdout 0.01s 8124KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Tokenizing (
Tokenizing (d e f i n e)
Tokenizing )
Skipping space
Tokenizing (f)
Skipping space
Tokenizing (g)
Skipping space
Tokenizing (
Tokenizing )
Processing dots: 1
Gathered items: ())
Remaining tokens: ((( (d e f i n e) ) (f) (g) ())
Skipping space
Tokenizing (1)
Skipping space
Tokenizing (2)
"2" "1" "(" ")" ")" ")" "(" "g" "f" ")" "define" "("
https://ideone.com/eBbXkN
language:
Scheme (chicken 4.13)
created:
7 days ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!