refactoring...

kekkonen.scm

@@ -1,4 +1,3 @@
-(import comparse)
 (import srfi-1)
 (import srfi-14)
 (import (chicken io))
@@ -13,73 +12,7 @@
 (import ncurses)
 (import util)
 (import lisp)
-
+(import parse)
-(define (lift fn parser)
-  (bind parser (compose result fn)))
-
-(define (is-not x)
-  (satisfies (lambda (y)
-	       (not (eqv? x y)))))
-
-(define parse-whitespace
-  (one-or-more (is #\space)))
-
-(define skip-whitespace
-  (skip (zero-or-more (is #\space))))
-
-(define +letter-char-set+
-  (string->char-set "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVwXYZ"))
-
-(define +symbol-char-set+
-  (char-set-union +letter-char-set+ (string->char-set "-0123456789")))
-
-(define parse-symbol
-  (lift (compose string->symbol string-downcase list->string (applied append))
-	(sequence (lift list (in +letter-char-set+)) (zero-or-more (in +symbol-char-set+)))))
-
-(define parse-number
-  (lift (compose string->number list->string) (one-or-more (in char-set:digit))))
-
-(define parse-string
-  (lift list->string (enclosed-by (is #\") (one-or-more (is-not #\")) (is #\"))))
-
-(define (followed-by-consuming parser separator)
-  (sequence* ((value parser) (_ separator))
-	     (result value)))
-
-(define (separated-by separator parser)
-  (one-or-more (any-of (followed-by-consuming parser separator) parser)))
-
-(define parse-symbol-or-number-or-string
-  (any-of parse-number parse-symbol parse-string))
-
-(define (completely-parse parser)
-  (followed-by parser end-of-input))
-
-(define parse-statement
-  (all-of skip-whitespace (separated-by parse-whitespace parse-symbol-or-number-or-string)))
-
-(define (just fn)
-  (lambda args
-    (fn)))
-
-(define (perhaps fn arg)
-  (if arg
-      (fn arg)
-      arg))
-
-(define display-newline
-  (compose (just newline) display))
-
-(define (display-lines ln)
-  (perhaps (curry map display-newline) ln))
-
-(define (parse-input)
-  (parse (completely-parse parse-statement) (read-line)))
-
-(define parse-formatter
-  (recursive-parser (one-or-more (any-of (followed-by-consuming (char-seq "<b>") (lift fmt-bold parser))
-					 (is-not #\<)))))
 
 (define (type-of elem)
   (cond ((pair? elem) 'pair)
@@ -123,7 +56,7 @@
   '(a an the into on to at as))
 
 (define (adventure-prompt)
-  (let ((result (parse (completely-parse parse-statement) (prompt "> "))))
+  (let ((result (parse-line (prompt "> "))))
     (if result
 	(let ((grug-result (filter (compose not (cut member <> +articles-prepositions+)) result)))
 	  (if (not (null? grug-result))

util.scm

@@ -1,4 +1,4 @@
-(module util (curry applied thunk)
+(module util (curry applied thunk just perhaps)
   (import scheme)
 
   (define (curry fn a)
@@ -11,4 +11,13 @@
   (define-syntax thunk
     (syntax-rules ()
       ((_ exp ...)
-       (lambda () exp ...)))))
+       (lambda () exp ...))))
+  
+(define (just fn)
+  (lambda args
+    (fn)))
+
+(define (perhaps fn arg)
+  (if arg
+      (fn arg)
+      arg)))