rendered paste body;;; Things that happen outside the Feather universe (and so need not be
;;; functional, object-oriented, or even orthodox)
(set! original-program "{ [ xy | ( xy xy ) ] }")
;;; The unreflective Scheme part of the interpreter.
(define (flatten-1 ll)
(if (null? ll)
'()
(append (car ll) (flatten-1 (cdr ll)))))
(define (atom->identifier a)
(list->string
(flatten-1
(map (lambda (x)
(cons #\a (string->list
(number->string
(char->integer x)))))
(string->list a)))))
(define (atom->symbol a)
(string->symbol (atom->identifier a)))
(define (tokenise-inner l a)
(if (null? l)
(list (list->string a))
(case (car l)
((#\ ) (cons (list->string a) (tokenise-inner (cdr l) '())))
(else (tokenise-inner (cdr l) (append a (list (car l))))))))
(define (tokenise s)
(tokenise-inner (string->list s) '()))
(define (checkrem x l)
(if (equal? x (car l))
(cdr l)
(error "Syntax error"))) ; TODO: a better error message
(define (smember? n h)
(cond
((null? h) #f)
((equal? n (car h)) #t)
(else (smember? n (cdr h)))))
;;; Feather data types.
;;; Fakeobject-based types are enough for bootstrapping a Feather implementation,
;;; so why go to the trouble to make them genuine?
;; Fakeobjects. Because everything is defined in terms of everything else,
;; there's a bit of a tangled recursion web just here.
(letrec
(addmethod
(lambda (o mname impl)
(lambda (meth)
(((feather_atom_equality meth (featherise_atom mname)) impl) o))))
(add<<=
(lambda (o)
(call/cc (lambda (cont) (addmethod o "<<=" cont)))))
(box
(lambda (f)
(addmethod (featherise_atom "?!") "#" f)))
;; Fakeobject booleans.
;; A boolean value of true is a boxed k; a boolean value of false is a
;; boxed `ki.
(feather_truth
(add<<= (box (lambda (t) (lambda (f) t)))))
(feather_falsity
(add<<= (box (lambda (t) (lambda (f) f)))))
;; Atoms.
(featherise_atom
(lambda (a)
(addmethod
(box (atom->identifier a))
"=="
(lambda (b)
(if (equal? (atom->identifier (b (featherise_atom "#"))) a)
feather_truth
feather_falsity))))))
(define (feather_atom_equality a b)
((a (featherise_atom "==")) b))
;;; The parser
;; Returns (remainder parsed).
;; The environment is a list of atoms to be interpreted as variables rather
;; than as constants; unlike Prolog, Feather doesn't enforce naming
;; conventions to distinguish them.
(define (parse program environment)
(cond
((equal? (car program) "[")
(if (equal? (caddr program) "|")
(let ((x (parse (cdddr program)
(cons (cadr program) environment))))
(cons (checkrem "]" (car x))
(list (cons 'lambda
(cons (list (atom->symbol (cadr program)))
(cdr x))))))
(error "[ is not followed by matching |" program environment)))
((equal? (car program) "{")
(let ((x (parse (cdr program)
(cons "^" environment))))
(cons (checkrem "}" (car x))
(list (cons 'lambda
(cons (list (atom->symbol "^"))
(cdr x)))))))
((equal? (car program) "(")
(let ((x (parse (cdr program) environment)))
(let ((y (parse (car x) environment)))
(cons (checkrem ")" (car y)) (list (cons (cadr x) (cdr y)))))))
((smember? (car program) '(")" "}" "]"))
(error "Unmatched closing bracket" program environment))
((smember? (car program) environment)
(cons (cdr program) (list (atom->symbol (car program)))))
(else (cons (cdr program) (list (featherise_atom (car program)))))))
;;; The replaceable universe itself
;;; The universe is a Feather fakeobject, with the following methods:
;;; <<= retroactive assignment
;;; @$ the input program (as a Feather fakestring)
;;; @& the parser (as a Feather function)
;;; # the top-level function
(display (featherise_atom "abc"))