Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Fetching contributors…
Cannot retrieve contributors at this time
69 lines (61 sloc) 2.37 KB
#lang racket
(except-in "incubot.rkt" main)
(only-in "vars.rkt" *incubot-logger*)
(only-in "log-parser.rkt" utterance-text))
(define (log fmt . args)
(when (*incubot-logger*)
(apply (*incubot-logger*) (string-append "incubot-server:" fmt) args)))
(provide make-incubot-server)
(define make-incubot-server
[(? string? ifn)
(with-handlers ([exn:fail:filesystem?
(lambda (e)
(log "Uh oh: ~a; using empty corpus" (exn-message e))
(make-incubot-server (make-corpus)))])
;; Load the server up asynchronously, so we don't have to wait
;; for it.
(let ([the-server (make-incubot-server (make-corpus))])
(lambda ()
(log "Reading log from ~a..." ifn)
(with-handlers ([exn? (lambda (e)
(log "Ooops: ~a~%" (exn-message e))
(lambda ignored #f))])
(call-with-input-file ifn
(lambda (inp)
(let/ec return
(for ([(utterance i) (in-indexed (in-port read inp))])
(the-server 'put (utterance-text utterance))
(when (= i 100000)
(log "Reading log from ~a...done~%" inp))))))))))]
[(? corpus? c)
;; TODO, low priority: Racket threads have a built-in "mailbox",
;; which is essentially an async channel; we could replace one of
;; these channels with it.
(let ([*to-server* (make-channel)]
[*from-server* (make-channel)])
(define funcs-by-symbol
`([get .
,(lambda (inp c)
(channel-put *from-server* (incubot-sentence inp c))
[put .
,(lambda (sentence c)
(channel-put *from-server* #t)
(add-to-corpus sentence c))])))
(lambda ()
(let loop ([c c])
(match (channel-get *to-server*)
[(cons symbol inp)
(loop ((hash-ref funcs-by-symbol symbol) inp c))]))))
(lambda (command-sym inp)
(channel-put *to-server* (cons command-sym inp))
(channel-get *from-server*)))]))
Jump to Line
Something went wrong with that request. Please try again.