fork(1) download
copy 
  1. ;; Define helper functions
  2. (define (drop-while pred lis)
  3.   (cond ((null? lis) lis)
  4.         ((not (pred (car lis))) lis)
  5.         (else (drop-while pred (cdr lis)))))
  6.  
  7. (define (take-while pred lis)
  8.   (let loop ((lis lis) (acc '()))
  9.     (cond ((null? lis) (reverse acc))
  10.           ((not (pred (car lis))) acc)
  11.           (else (loop (cdr lis) (cons (car lis) acc))))))
  12.  
  13. (define (char-other? ch)
  14.   (not (or (= (char->integer ch) 91)
  15.            (= (char->integer ch) 93)
  16.            (= (char->integer ch) 40)
  17.            (= (char->integer ch) 41)
  18.            (= (char->integer ch) 32)
  19.            (= (char->integer ch) 10))))
  20.  
  21. (define (process-other chars)
  22.   (and (not (null? chars))
  23.        (let* ((token-chars (take-while char-other? chars))
  24.               (rest (drop-while char-other? chars)))
  25.          (list token-chars rest))))
  26.  
  27. ;; Custom function to check if all elements in a list are characters
  28. (define (all-char? lis)
  29.   (if (null? lis)
  30.       #t
  31.       (and (char? (car lis)) (all-char? (cdr lis)))))
  32.  
  33. ;; Function to tag tokens with their type
  34. (define (tag-token type value)
  35.   (list type value))
  36.  
  37. ;; Functions to take and drop elements from the list
  38. (define (take n lis)
  39.   (if (or (<= n 0) (null? lis))
  40.       '()
  41.       (cons (car lis) (take (- n 1) (cdr lis)))))
  42.  
  43. (define (drop n lis)
  44.   (if (or (<= n 0) (null? lis))
  45.       lis
  46.       (drop (- n 1) (cdr lis))))
  47.  
  48. ;; Functions for Dot Count
  49. (define (process-dots chars)
  50.   (let* ((dot-chars (take-while (lambda (ch) (char=? ch (integer->char 46))) chars))  ; char 46 is '.'
  51.          (num-dots (length dot-chars))
  52.          (rest (drop-while (lambda (ch) (char=? ch (integer->char 46))) chars)))
  53.     (list num-dots rest)))
  54.  
  55. ;; Define main tokenize function with integrated new functions
  56. (define (tokenize input)
  57.   (let loop ((chars (string->list input)) (tokens '()))
  58.     (cond
  59.       ((null? chars) (reverse tokens))  ; Return the reversed tokens
  60.       ((char=? (car chars) (integer->char 91))  ; Handle opening bracket [
  61.        (loop (cdr chars) (cons (tag-token 'open-bracket "[") tokens)))
  62.       ((char=? (car chars) (integer->char 93))  ; Handle closing bracket ]
  63.        (loop (cdr chars) (cons (tag-token 'close-bracket "]") tokens)))
  64.       ((char=? (car chars) (integer->char 40))  ; Handle opening parenthesis
  65.        (loop (cdr chars) (cons (tag-token 'open-parenthesis "(") tokens)))
  66.       ((char=? (car chars) (integer->char 41))  ; Handle closing parenthesis
  67.        (loop (cdr chars) (cons (tag-token 'close-parenthesis ")") tokens)))
  68.       ((char=? (car chars) (integer->char 32))  ; Skip spaces
  69.        (loop (cdr chars) tokens))
  70.       ((char=? (car chars) (integer->char 46))  ; Handle dots (.)
  71.        (let* ((result (process-dots chars))
  72.               (num-dots (car result))
  73.               (rest (cadr result)))
  74.          (loop rest (cons (tag-token 'dots num-dots) tokens))))  ; Use a tagged list structure
  75.       (else
  76.        (let* ((result (process-other chars))
  77.               (token (car result))
  78.               (rest (cadr result)))
  79.          (loop rest (cons (tag-token 'other token) tokens))))))  ); End of tokenize function
  80.  
  81. (define (simplify-for-output x) x)
  82.  
  83. ;; Function to check if a token represents dots
  84. (define (dots? x) (eq? 'dots (caar x)))
  85.  
  86. (define (dot-count x) (cadr x))
  87.  
  88. ;; Function to gather up the tokens based on dots
  89. (define (process-final tokens)
  90. (define (process-finalz . args)
  91.   (debug 'process-finalz args))
  92. (process-finalz tokens))
  93.  
  94. ;; DEBUG
  95. (define (debug procedure-name args)
  96.   (define (debug-helper args)
  97.     (if (null? (cdr args))
  98.       args
  99.       (cons (car args)
  100.         (cons '--- (debug-helper (cdr args))))))
  101. (write (cons procedure-name (debug-helper args)))(newline)(newline))
  102.  
  103. ;; Example usage
  104. (define input "(define) for good (). 1 2")
  105.  
  106. ;; Tokenize the input
  107. (let ((tokens (tokenize input)))
  108.   (write tokens)  ; Write the intermediate tokenized output for debugging
  109.   (newline)(newline)
  110.   (write (process-final tokens)))  ; Return the final processed output
  111.  
Success #stdin #stdout 0.02s 8056KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
((open-parenthesis "(") (other (#\e #\n #\i #\f #\e #\d)) (close-parenthesis ")") (other (#\r #\o #\f)) (other (#\d #\o #\o #\g)) (open-parenthesis "(") (close-parenthesis ")") (dots 1) (other (#\1)) (other (#\2)))

(process-finalz ((open-parenthesis "(") (other (#\e #\n #\i #\f #\e #\d)) (close-parenthesis ")") (other (#\r #\o #\f)) (other (#\d #\o #\o #\g)) (open-parenthesis "(") (close-parenthesis ")") (dots 1) (other (#\1)) (other (#\2))))

#<unspecified>
https://ideone.com/ayOW2d
language:
Scheme (chicken 4.13)
created:
2 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!