;
; atomspace-daemon.scm - Background AtomSpace learning daemon
;
; Architecture:
; [Client] --socket--> [Main thread] ---> [AtomSpace] <--- [Learn thread]
;
; Two threads:
; Main thread: blocking socket server, handles queries instantly
; Learn thread: continuous vagueness-driven learning in background
;
; The AtomSpace is thread-safe. Scheme-level counters use a mutex.
; Queries never block - they read current AtomSpace state while
; learning writes to it concurrently.
;
(use-modules (opencog))
(use-modules (ice-9 format))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 popen))
(use-modules (ice-9 threads))
(use-modules (srfi srfi-1))
(primitive-load "atomspace-learner.scm")
;; ═══════════════════════════════════════════════════════════════════
;; CONFIGURATION
;; ═══════════════════════════════════════════════════════════════════
(define *socket-path* "/tmp/atomspace-learner.sock")
(define *pid-file* "/tmp/atomspace-learner.pid")
(define *log-file* "/tmp/atomspace-learner.log")
(define *learn-interval* 10) ;; Seconds between learning iterations
(define *running* #t)
;; Thread synchronization
(define *learn-mutex* (make-mutex))
(define *learn-thread* #f)
(define *learning-busy* #f) ;; True when learning step is active
;; ═══════════════════════════════════════════════════════════════════
;; LAYER EMERGENCE DETECTION
;; ═══════════════════════════════════════════════════════════════════
;; Cached layer status (recomputed periodically, not on every query)
(define *cached-layers* #f)
(define *layers-last-check* 0)
(define *layers-cache-ttl* 30) ;; Recheck every 30 seconds
(define (layer-status)
"Check which layers have emerged (cached for performance)"
(let ((now (current-time)))
(when (or (not *cached-layers*)
(> (- now *layers-last-check*) *layers-cache-ttl*))
(set! *cached-layers* (compute-layer-status))
(set! *layers-last-check* now))
*cached-layers*))
(define (compute-layer-status)
"Actually compute layer emergence - expensive, called periodically"
(let* ((words (length (get-all-words)))
(pairs (length (cog-get-atoms 'EdgeLink #t)))
(evals (length (cog-get-atoms 'EvaluationLink #t)))
;; Layer 1: Counting - cheap check
(l1 (and (> words 0) (> pairs 0)))
;; Layer 2: Association - check a few known bootstrap words only
;; Use "atom" (from "AtomSpace" after camelCase split) or "grep"
(l2-word (cond ((> (get-unit-count "atomspace") 0) "atomspace")
((> (get-unit-count "atom") 0) "atom")
(else "grep")))
(l2 (and l1
(> (get-unit-count l2-word) 0)
(let ((a (get-associations l2-word 3)))
(and (not (null? a)) (> (car (car a)) 0.5)))))
;; Layer 3: Structure - just check EvalLink count
(l3 (and l2 (> evals 0)))
;; Layer 4: Response - check one known word
(l4 (and l2 (> (get-unit-count l2-word) 0)))
;; Layer 5: Self-awareness - check bootstrap words exist
(l5 (and l4
(> (get-unit-count "grep") 0)
(> (get-unit-count "wirecore") 0)))
;; Layer 6: Tool reasoning - check if one word can form a plan
(l6 (and l5
(> (get-unit-count "keypair") 0)
(find-tool-for-action "keypair")
(find-search-location "keypair")))
;; Layer 7: Autonomous action - cheapest check
(l7 (and l6 (> *auto-observations* 0)))
;; Layer 8: Inference - at least 1 rule exists AND all rules pass verification
(l8 (and l3
(> (length (cog-get-atoms 'ImplicationLink #t)) 0)
(let ((v (verify-all-rules)))
(= (cadr v) 0)))))
(list
(cons 1 l1) (cons 2 l2) (cons 3 l3) (cons 4 l4)
(cons 5 l5) (cons 6 l6) (cons 7 l7) (cons 8 l8))))
(define (show-layers)
"Display layer emergence status"
(let ((layers (layer-status))
(names '("Counting" "Association" "Structure" "Response"
"Self-awareness" "Tool reasoning" "Autonomous action"
"Inference")))
(string-join
(cons "Layer emergence:"
(map (lambda (l name)
(format #f " ~a. ~a: ~a"
(car l) name
(if (cdr l) "EMERGED" "not yet")))
layers names))
"\n")))
;; ═══════════════════════════════════════════════════════════════════
;; ONE LEARNING STEP
;; ═══════════════════════════════════════════════════════════════════
(define *learning-iteration* 0)
(define (learning-step!)
"Run one step of the vagueness-driven learning loop.
Returns a status string. Thread-safe via mutex on counters."
(lock-mutex *learn-mutex*)
(set! *learning-iteration* (+ *learning-iteration* 1))
(set! *learning-busy* #t)
(let ((iter *learning-iteration*))
(unlock-mutex *learn-mutex*)
;; Find the most vague learnable word
(let* ((priorities (get-learning-priorities))
(skip-words (append *all-predicate-words*
'("grep" "search" "tool" "pattern" "files"
"directory" "codebase" "wirecore"
"the" "and" "for" "that" "this" "with")))
(relevant (filter (lambda (p)
(let ((w (car p)))
(and (not (member w skip-words))
(> (get-unit-count w) 0)
(learnable-word? w))))
priorities))
(target (if (null? relevant) #f (car relevant))))
(let ((result
(if (not target)
(format #f "[step ~a] No learnable targets. Need more bootstrap data."
iter)
(let ((word (car target))
(vague (cadr target)))
(display (format #f "[step ~a] Learning about '~a' (vagueness: ~,3f)\n"
iter word vague))
(let ((learned (learn-about! word)))
(format #f "[step ~a] Learned ~a lines about '~a'"
iter learned word))))))
(lock-mutex *learn-mutex*)
(set! *learning-busy* #f)
(unlock-mutex *learn-mutex*)
result))))
;; ═══════════════════════════════════════════════════════════════════
;; COMMAND PROCESSING
;; ═══════════════════════════════════════════════════════════════════
(define (process-command line)
"Process a command or query, return response string"
(cond
((string-prefix? "/quit" line)
'quit)
((string-prefix? "/stats" line)
(string-append (show-stats)
(format #f "\nLearn thread: ~a (iteration ~a)"
(if *learning-busy* "BUSY" "idle")
*learning-iteration*)))
((string-prefix? "/layers" line)
(show-layers))
((string-prefix? "/assoc " line)
(let* ((word (string-trim-both (substring line 7)))
(assocs (get-associations word 10)))
(if (null? assocs)
(format #f "No associations for '~a'" word)
(string-join
(cons (format #f "Associations for '~a':" word)
(map (lambda (p)
(format #f " ~a (PMI: ~,2f)" (cdr p) (car p)))
assocs))
"\n"))))
((string-prefix? "/unit " line)
(let ((word (string-trim-both (substring line 6))))
(if (> (get-unit-count word) 0)
(show-unit word)
(format #f "Unknown word: '~a'" word))))
((string-prefix? "/reason " line)
(let* ((word (string-trim-both (substring line 8)))
(plan (reason-search-plan word)))
(if plan
(format #f "Search plan for '~a':\n ~a" word (assoc-ref plan 'reasoning))
(format #f "Cannot form search plan for '~a'" word))))
((string-prefix? "/learn " line)
(let* ((word (string-trim-both (substring line 7)))
(learned (learn-about! word)))
(format #f "Learned ~a lines about '~a'" learned word)))
((string-prefix? "/step" line)
(learning-step!))
((string-prefix? "/bootstrap " line)
(let ((text (string-trim-both (substring line 11))))
(process-text-manual! text)
(format #f "Bootstrapped: ~a" text)))
((string-prefix? "/infer" line)
(let ((count (discover-all-rules!)))
(format #f "Inference complete. ~a rules discovered. ImplicationLinks: ~a"
count (length (cog-get-atoms 'ImplicationLink #t)))))
((string-prefix? "/rules" line)
(show-rules))
((string-prefix? "/verify" line)
(let* ((v (verify-all-rules))
(passes (car v))
(fails (cadr v))
(failures (caddr v)))
(string-join
(cons (format #f "Rule verification: ~a passed, ~a failed" passes fails)
(if (null? failures)
(list " All rules verified!")
(map (lambda (f) (format #f " FAIL: ~a" f)) failures)))
"\n")))
((string-prefix? "/discover" line)
(discover-all-knowledge!)
(format #f "Structures and rules discovered. EvaluationLinks: ~a ImplicationLinks: ~a"
(length (cog-get-atoms 'EvaluationLink #t))
(length (cog-get-atoms 'ImplicationLink #t))))
((string-prefix? "/priorities" line)
(show-learning-priorities 10))
((string-prefix? "/gaps" line)
(let* ((arg (string-trim-both (substring line 5)))
(all-words (get-all-words))
(total (length all-words)))
(if (not (string-null? arg))
;; Single word gap analysis
(let ((count (get-unit-count arg)))
(if (= count 0)
(format #f "'~a' — completely unknown (never seen)" arg)
(let* ((vague (unit-vagueness arg))
(g-score (grounding-score arg))
(s-score (structural-score arg))
(gap (gap-type arg))
(assocs (get-associations arg 5))
(takes (safe-string-list (query-takes arg)))
(returns (safe-string-list (query-returns arg)))
(contains (safe-string-list (query-contains arg)))
(has-tool (find-tool-for-action arg))
(has-loc (find-search-location arg)))
(string-join
(list (format #f "Gap analysis for '~a':" arg)
(format #f " Seen: ~a times" count)
(format #f " Vagueness: ~,4f (~a)"
vague (cond ((< vague 0.005) "well-known")
((< vague 0.015) "partially known")
((< vague 0.03) "poorly known")
(else "barely known")))
(format #f " Gap type: ~a" (symbol->string gap))
(format #f " Grounding: ~,2f Structure: ~,2f" g-score s-score)
(format #f " Associates with: ~a"
(if (null? assocs) "nothing"
(string-join (map (lambda (a) (format #f "~a(~,1f)" (cdr a) (car a))) assocs) ", ")))
(format #f " Structures: takes=~a returns=~a contains=~a"
(if (null? takes) "none" (string-join takes ","))
(if (null? returns) "none" (string-join returns ","))
(if (null? contains) "none" (string-join contains ",")))
(format #f " Learnable: ~a (tool=~a, location=~a)"
(if (and has-tool has-loc) "YES" "NO")
(or has-tool "none") (or has-loc "none"))
(format #f " Question: ~a" (vagueness-question arg)))
"\n"))))
;; Overview: categorize ALL knowledge
(let* ((scored (map (lambda (w)
(list w (get-unit-count w) (unit-vagueness w)
(gap-type w)))
all-words))
;; Categorize
(grounded (filter (lambda (s) (eq? (cadddr s) 'grounded)) scored))
(ungrounded (filter (lambda (s) (eq? (cadddr s) 'ungrounded)) scored))
(unstructured (filter (lambda (s) (eq? (cadddr s) 'unstructured)) scored))
(unknown (filter (lambda (s) (eq? (cadddr s) 'unknown)) scored))
;; Sort each by vagueness descending
(sort-by-vague (lambda (lst) (sort lst (lambda (a b) (> (caddr a) (caddr b))))))
;; Find most and least vague overall
(all-sorted (sort-by-vague scored))
(most-vague (take all-sorted (min 10 (length all-sorted))))
(least-vague (take (reverse all-sorted) (min 5 (length all-sorted)))))
(string-join
(append
(list (format #f "Knowledge gaps (~a words total):" total)
""
(format #f " GROUNDED (~a) — has action + structure associations:" (length grounded))
(format #f " ~a"
(string-join (map car (take grounded (min 10 (length grounded)))) ", "))
""
(format #f " UNGROUNDED (~a) — has structure but no action grounding:" (length ungrounded))
(format #f " ~a"
(string-join (map car (take ungrounded (min 10 (length ungrounded)))) ", "))
""
(format #f " UNSTRUCTURED (~a) — has action grounding but no structure:" (length unstructured))
(format #f " ~a"
(string-join (map car (take (sort-by-vague unstructured) (min 10 (length unstructured)))) ", "))
""
(format #f " UNKNOWN (~a) — neither action nor structure:" (length unknown))
(format #f " ~a"
(string-join (map car (take (sort-by-vague unknown) (min 15 (length unknown)))) ", "))
""
" MOST VAGUE (biggest gaps):")
(map (lambda (s)
(format #f " ~20a count=~3a vague=~,4f [~a]"
(car s) (cadr s) (caddr s) (symbol->string (cadddr s))))
most-vague)
(list ""
" LEAST VAGUE (best understood):")
(map (lambda (s)
(format #f " ~20a count=~3a vague=~,4f [~a]"
(car s) (cadr s) (caddr s) (symbol->string (cadddr s))))
least-vague))
"\n")))))
((string-prefix? "/pipeline " line)
(let* ((word (string-trim-both (substring line 10)))
(count (get-unit-count word)))
(if (= count 0)
(format #f "Unknown word: '~a'" word)
(let* ((assocs (get-associations word 10))
(assoc-strs (safe-string-list
(map (lambda (a)
(and (pair? a) (number? (car a)) (string? (cdr a))
(format #f "~a(~,1f)" (cdr a) (car a))))
(take assocs (min 5 (length assocs))))))
(contains (safe-string-list (query-contains word)))
(takes (safe-string-list (query-takes word)))
(returns (safe-string-list (query-returns word)))
(sequences (safe-string-list (query-then word)))
(plan (reason-search-plan word)))
(string-join
(append
(list (format #f "Pipeline for '~a':" word)
(format #f " Count: ~a seen ~a times" word count)
(format #f " Cluster: ~a → ~a" word
(if (null? assoc-strs) "none"
(string-join assoc-strs ", "))))
;; Structure section
(list (format #f " Structure:"))
(if (null? contains) '()
(list (format #f " ~a CONTAINS ~a" word
(string-join contains ", "))))
(if (null? takes) '()
(list (format #f " ~a TAKES ~a" word
(string-join takes ", "))))
(if (null? returns) '()
(list (format #f " ~a RETURNS ~a" word
(string-join returns ", "))))
(if (null? sequences) '()
(list (format #f " ~a THEN ~a" word
(string-join sequences ", "))))
(if (and (null? contains) (null? takes)
(null? returns) (null? sequences))
(list " (no structures discovered)")
'())
;; Predict section
(list (format #f " Predict: ~a"
(if plan
(assoc-ref plan 'reasoning)
"cannot form search plan")))
;; Use section
(if plan
(let ((tool (assoc-ref plan 'tool))
(loc (assoc-ref plan 'location))
(pats (assoc-ref plan 'patterns)))
(list (format #f " Use: ~a ~a ~a → lines → learn"
tool
(if (and pats (not (null? pats)))
(format #f "\"~a\"" (car pats)) "?")
(or loc "?"))))
(list " Use: (blocked - insufficient knowledge)")))
"\n")))))
((string-prefix? "/structures" line)
(let* ((evals (cog-get-atoms 'EvaluationLink #t))
(grouped '()))
;; Group by predicate type
(for-each
(lambda (eval)
(let* ((outgoing (cog-outgoing-set eval))
(pred-name (cog-name (car outgoing)))
(lst (cadr outgoing))
(args (cog-outgoing-set lst))
(subj-name (cog-name (car args)))
(obj-name (cog-name (cadr args)))
(conf-val (cog-value eval (Predicate "confidence")))
(conf (if conf-val (car (cog-value->list conf-val)) 0)))
(when (and (string-prefix? "word:" subj-name)
(string-prefix? "word:" obj-name))
(let* ((subj (substring subj-name 5))
(obj (substring obj-name 5))
(existing (assoc pred-name grouped)))
(if existing
(set-cdr! existing
(cons (list subj obj conf) (cdr existing)))
(set! grouped
(cons (cons pred-name (list (list subj obj conf)))
grouped)))))))
evals)
(if (null? grouped)
"No structures discovered yet. Run /discover first."
(string-join
(cons (format #f "All typed relationships (~a total):"
(length evals))
(append-map
(lambda (group)
(let ((pred (car group))
(rels (cdr group)))
(cons (format #f "\n ~a (~a):"
(string-upcase pred) (length rels))
(map (lambda (r)
(format #f " ~a ~a ~a (conf: ~,1f)"
(car r) pred (cadr r) (caddr r)))
(sort rels (lambda (a b)
(> (caddr a) (caddr b))))))))
(sort grouped (lambda (a b)
(string<? (car a) (car b))))))
"\n"))))
((string-prefix? "/cost" line)
(format #f "Bootstrap cost: ~a manual observations\nSelf-acquired: ~a auto observations\nRatio: 1:~,1f"
*manual-observations* *auto-observations*
(if (> *manual-observations* 0)
(/ (* 1.0 *auto-observations*) *manual-observations*)
0)))
((string-prefix? "/help" line)
(string-join
'("Commands:"
" /stats - Show word/pair/observation counts"
" /layers - Show which capability layers have emerged"
" /assoc <word> - Show PMI associations for word"
" /unit <word> - Show full knowledge state for word"
" /reason <word> - Show PMI-reasoned search plan for word"
" /pipeline <word> - Show full cognitive pipeline (count→cluster→structure→predict→use)"
" /structures - Dump all typed relationships grouped by type"
" /infer - Run rule discovery (Layer 8: preconditions, chaining, etc.)"
" /rules - Display all inference rules grouped by type"
" /verify - Verify all rules for internal consistency"
" /learn <word> - Execute one search about word"
" /step - Run one learning iteration (most vague target)"
" /bootstrap <text> - Feed manual knowledge"
" /discover - Run structure + rule discovery on all words"
" /gaps - Show knowledge gaps (what we don't know)"
" /gaps <word> - Detailed gap analysis for one word"
" /priorities - Show learning priorities by vagueness"
" /cost - Show bootstrap cost vs self-acquired data"
" <question> - Ask a question (what is X, how do you Y)"
" <text> - Feed text for learning"
" /quit - Shut down")
"\n"))
((string-prefix? "/" line)
"Unknown command. Try /help")
;; Question detection
((is-question? line)
(respond line))
;; Regular text - learn from it
(else
(process-text-manual! line)
(format #f "Learned from: ~a" line))))
;; ═══════════════════════════════════════════════════════════════════
;; BOOTSTRAP - Load knowledge files at startup
;; ═══════════════════════════════════════════════════════════════════
(define (load-knowledge filename)
"Load and process a knowledge file (counts as manual bootstrap)"
(if (not (file-exists? filename))
(display (format #f "[boot] File not found: ~a\n" filename))
(begin
(display (format #f "[boot] Loading ~a...\n" filename))
(let ((port (open-input-file filename))
(count 0))
(let loop ((line (read-line port)))
(if (eof-object? line)
(begin (close-port port)
(display (format #f "[boot] Processed ~a lines\n" count)))
(begin
(let ((trimmed (string-trim-both line)))
(unless (or (string-null? trimmed)
(string-prefix? "#" trimmed))
(process-text-manual! trimmed)
(set! count (+ count 1))))
(loop (read-line port)))))))))
(define (bootstrap!)
"Load initial knowledge files and discover structures"
(display "[boot] Bootstrapping...\n")
(load-knowledge "data/self-knowledge.txt")
(load-knowledge "data/anproto-knowledge.txt")
(load-knowledge "data/unix-tools.txt")
;; Discover structures only — rules via /infer when ready
(discover-all-structures!)
(display (format #f "[boot] Done. ~a\n" (show-stats)))
(display (format #f "[boot] ~a\n" (show-layers)))
(force-output))
;; ═══════════════════════════════════════════════════════════════════
;; LEARNING THREAD
;; ═══════════════════════════════════════════════════════════════════
(define (learning-thread-loop)
"Background learning loop. Runs in its own thread.
Continuously picks the most vague learnable word and searches for it."
(display "[learn-thread] Started.\n")
(let loop ()
(when *running*
(catch #t
(lambda ()
(display (format #f "\n[learn-thread] Iteration ~a...\n"
(+ *learning-iteration* 1)))
(display (format #f "~a\n" (learning-step!))))
(lambda (key . args)
(display (format #f "[learn-thread] Error: ~a ~a\n" key args))))
(force-output)
(sleep *learn-interval*)
(loop)))
(display "[learn-thread] Stopped.\n"))
;; ═══════════════════════════════════════════════════════════════════
;; SOCKET SERVER (main thread, blocking accept)
;; ═══════════════════════════════════════════════════════════════════
(define (start-server)
"Start the daemon: learning thread + blocking socket server"
;; Bootstrap
(bootstrap!)
;; Remove old socket
(when (file-exists? *socket-path*)
(delete-file *socket-path*))
(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
(bind sock AF_UNIX *socket-path*)
(listen sock 5)
;; Socket stays BLOCKING - main thread waits for connections
;; while learn thread works in the background
(display (format #f "
═══════════════════════════════════════════════════════════════════
AtomSpace Learning Daemon (Threaded)
Socket: ~a
~a
Architecture: main thread (queries) + learn thread (background)
═══════════════════════════════════════════════════════════════════
Waiting for connections... (Ctrl+C to stop)
Query: ./ask.sh /stats
./ask.sh 'what is keypair'
" *socket-path* (show-stats)))
;; Handle Ctrl+C
(sigaction SIGINT
(lambda (sig)
(display "\n[daemon] Shutting down...\n")
(set! *running* #f)
(close sock)
(when (file-exists? *socket-path*)
(delete-file *socket-path*))
(when (file-exists? *pid-file*)
(delete-file *pid-file*))
(exit 0)))
;; Start learning thread
(set! *learn-thread*
(begin-thread (learning-thread-loop)))
;; Main loop: blocking accept, queries handled immediately
(let loop ()
(when *running*
(let ((client-info
(catch 'system-error
(lambda () (accept sock))
(lambda (key . args) #f))))
(when client-info
(let ((client (car client-info)))
(handle-client client)
(close client))))
(loop)))))
(define (handle-client client)
"Handle one client connection (may send multiple lines)"
(let loop ()
(let ((line (read-line client)))
(cond
((eof-object? line) #f)
(else
(let ((trimmed (string-trim-both line)))
(unless (string-null? trimmed)
(display (format #f "[query] ~a\n" trimmed))
(let ((response (process-command trimmed)))
(if (eq? response 'quit)
(begin
(display "Shutting down.\n" client)
(set! *running* #f))
(begin
(display response client)
(newline client)
(loop)))))))))))
;; ═══════════════════════════════════════════════════════════════════
;; ENTRY POINT
;; ═══════════════════════════════════════════════════════════════════
(when (and (defined? 'command-line)
(> (length (command-line)) 0))
(let ((args (command-line)))
(cond
((and (> (length args) 1) (string=? (cadr args) "run"))
(start-server))
((and (> (length args) 1) (string=? (cadr args) "test"))
;; Quick test mode - bootstrap and show layers
(bootstrap!)
(display "\n")
(display (show-layers))
(display "\n\n")
;; Try one learning step
(display "Testing one learning step:\n")
(display (learning-step!))
(display "\n"))
(else
(display "Usage:\n guile atomspace-daemon.scm run - Start daemon\n guile atomspace-daemon.scm test - Quick test\n")))))