;ELISION-TOKI-PONA-CLOS - This is an experiment in implementing Elision, with words as CLOS objects. ;Copyright (C) 2021 Prince Trippy . ;This program is free software: you can redistribute it and/or modify it under the terms of the ;GNU Affero General Public License version 3 as published by the Free Software Foundation. ;This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without ;even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. ;See the GNU Affero General Public License for more details. ;You should have received a copy of the GNU Affero General Public License along with this program. ;If not, see . (cl:defpackage #:elision-toki-pona-clos (:use #:common-lisp) (:documentation "Elision is a high-level system for representing text as words, not characters. This package defines an experiment, using toki pona and CLOS, in part for fun. Ultimately, this package is just a toy.") (:export #:dictionary #:make-dictionary #:word #:sentence #:paragraph #:word-to-string #:toki-pona #:make-sentence #:make-paragraph #:word> #:word< #:dictionary-to-list)) (cl:in-package #:elision-toki-pona-clos) (deftype octet () '(unsigned-byte 8)) (deftype index () '(unsigned-byte 9)) (deftype limit () '(integer 0 124)) (defun toki-pona-letter-p (character) ;This is a predicate so that constant string can be protected. "This predicate is true only when the argument is one of the fourteen toki pona characters." (and (characterp character) (position character "aeijklmnopstuw" :test 'char=))) (defun word-length (word) "Return the length of a toki pona word." (aref (words (dictionary word)) 0 (index word))) (defclass dictionary () ((table :reader table :initarg table :type string :documentation "This string holds the characters of every word.") (words :reader words :initarg words :type array :documentation "This holds the length and index for every word.")) (:documentation "The dictionary is an object holding words, so they may be treated as indices.")) (defclass word () ((dictionary :reader dictionary :initarg dictionary :type dictionary :documentation "This is the dictionary the word references.") (index :reader index :initarg index :type limit :documentation "This is the word's index into its dictionary.")) (:documentation "A word in Elision is represented as an index into a dictionary.")) (defclass sentence () ((primary :reader primary :initarg primary :type dictionary :documentation "This should always be TOKI-PONA.") (auxiliary :reader auxiliary :initarg auxiliary :type dictionary :documentation "This dictionary is intended for foreign words.") (which :reader which :initarg which :type bit-vector :documentation "If zero, the word indexes primary, else auxiliary.") (words :reader words :initarg words :type vector :documentation "This holds the word indices of the sentence.")) (:documentation "The sentence is the basic unit of word collection in this. The ending punctuation slot is unimplemented.")) (defclass paragraph () ((primary :reader primary :initarg primary :type dictionary :documentation "This should always be TOKI-PONA.") (auxiliary :reader auxiliary :initarg auxiliary :type dictionary :documentation "This dictionary is intended for foreign words.") (which :reader which :initarg which :type bit-vector :documentation "If zero, the word indexes primary, else auxiliary.") (sentences :reader sentences :initarg sentences :type (vector octet) :documentation "Sentences are represented here only as lengths.") (words :reader words :initarg words :type vector :documentation "This holds the word indices of the paragraph.")) (:documentation "This exists primarily to show how layers of the system mesh; see the SENTENCE.")) (defmethod word ((index integer) (dictionary dictionary)) "Create a word object from components." (make-instance 'word 'dictionary dictionary 'index index)) (defmethod word ((index integer) (sentence sentence)) "Extract a word from a sentence." (word (aref (words sentence) index) (if (zerop (aref (which sentence) index)) (primary sentence) (auxiliary sentence)))) (defmethod word ((index integer) (paragraph paragraph)) "Extract a word from a paragraph." (word (aref (words paragraph) index) (if (zerop (aref (which paragraph) index)) (primary paragraph) (auxiliary paragraph)))) ;I suppose I won't bother with implementing this. ;(defmethod sentence ((index integer) (paragraph paragraph)) "Extract a sentence from a paragraph." ; (make-instance 'sentence 'primary (primary paragraph) 'auxiliary (auxiliary paragraph) ; 'which ; 'words)) (defun word-to-string (word) "Convert a word into its displaced string representation." (make-array (word-length word) :element-type 'character :displaced-to (table (dictionary word)) :displaced-index-offset (aref (words (dictionary word)) 1 (index word)))) (defmethod print-object ((word word) stream) (prog1 word (print-unreadable-object (word stream :type t :identity t) (write-string (word-to-string word) stream)))) (defun make-dictionary (&rest words) "This is the most base and least efficient dictionary creation function." (assert (every 'stringp words) (words) "All arguments to MAKE-DICTIONARY must be strings.") (assert (> 125 (length words)) (words) "A toki pona dictionary disallows more than 125 words.") (dolist (word words) (assert (every 'toki-pona-letter-p word) (word words) "A toki pona word contains only these characters: aeijklmnopstuw")) (make-instance 'dictionary 'table (let ((length #0=(reduce '+ words :key 'length :initial-value 0))) (or #1=(and (> array-total-size-limit length) (> array-dimension-limit length)) (assert (progn (setq length #0#) #1#) (words) "The dictionary table size exceeds the system limits.")) ;(setq words (sort words 'string<)) (make-array length :element-type 'character :initial-contents (apply 'concatenate 'string words))) 'words (make-array `(2 ,(length words)) :element-type 'index :initial-contents (list (mapcar 'length words) (mapcar (let ((index 0)) (lambda (word) (prog1 index (incf index (length word))))) words))))) (defun make-dictionary (&rest words &aux table) "Create a toki pona dictionary from the given words. This version optimizes the table somewhat." (assert (every 'stringp words) (words) "All arguments to MAKE-DICTIONARY must be strings.") (assert (> 125 (length words)) (words) "A toki pona dictionary disallows more than 125 words.") (dolist (word words) (assert (every 'toki-pona-letter-p word) (word words) "A toki pona word contains only these characters: aeijklmnopstuw")) ;(setq words (sort words 'string<)) (setq table (remove-if (lambda (word) (member word words :test (lambda (first second) (and (string/= first second) (search first second :test 'char=))))) words)) (make-instance 'dictionary 'table (let ((length (reduce '+ table :key 'length :initial-value 0))) (or (and (> array-total-size-limit length) (> array-dimension-limit length)) (error "The dictionary table size exceeds the system limits.")) (setq table (make-array length :element-type 'character :initial-contents (apply 'concatenate 'string table)))) 'words (make-array `(2 ,(length words)) :element-type 'index :initial-contents (list (mapcar 'length words) (mapcar (lambda (word) (search word table)) words))))) (defvar toki-pona (make-dictionary "a" "akesi" "ala" "alasa" "ale" "ali" "anpa" "ante" "anu" "awen" "e" "en" "esun" "ijo" "ike" "ilo" "insa" "jaki" "jan" "jelo" "jo" "kala" "kalama" "kama" "kasi" "ken" "kepeken" "kili" "kin" "kiwen" "ko" "kon" "kule" "kulupu" "kute" "la" "lape" "laso" "lawa" "len" "lete" "li" "lili" "linja" "lipu" "loje" "lon" "luka" "lukin" "lupa" "ma" "mama" "mani" "meli" "mi" "mije" "moku" "moli" "monsi" "mu" "mun" "musi" "mute" "namako" "nanpa" "nasa" "nasin" "nena" "ni" "nimi" "noka" "o" "oko" "olin" "ona" "open" "pakala" "pali" "palisa" "pan" "pana" "pi" "pilin" "pimeja" "pini" "pipi" "poka" "poki" "pona" "pu" "sama" "seli" "selo" "seme" "sewi" "sijelo" "sike" "sin" "sina" "sinpin" "sitelen" "sona" "soweli" "suli" "suno" "supa" "suwi" "tan" "taso" "tawa" "telo" "tenpo" "toki" "tomo" "tu" "unpa" "uta" "utala" "walo" "wan" "waso" "wawa" "weka" "wile") "This dictionary contains toki pona. Any toki pona text must use it.") (defun make-sentence (&rest words &aux (set #0=(delete-duplicates (mapcar 'dictionary words) :test 'eq))) "Create a sentence from words. But two dictionaries in-total are allowed; one must be TOKI-PONA." (or #1=(and (>= 2 (length set)) (member toki-pona set :test 'equalp)) (assert (progn (setq set #0#) #1#) (words) "The dictionaries of the words are inadequate.")) (make-instance 'sentence 'primary toki-pona 'auxiliary (or (car (delete toki-pona set :test 'equalp)) toki-pona) 'which (make-array (length words) :element-type 'bit :initial-contents (mapcar (lambda (word) (if (equalp toki-pona (dictionary word)) 0 1)) words)) 'words (make-array (length words) :element-type 'index :initial-contents (mapcar 'index words)))) (defun make-paragraph (&rest sentences &aux (set #0=(delete-duplicates (nconc (mapcar 'primary sentences) (mapcar 'auxiliary sentences)) :test 'eq)) (length (reduce '+ sentences :key #2=(lambda (sentence) (length (words sentence)))))) "Create a paragraph from sentences; two dictionaries in-total are allowed; one must be TOKI-PONA." (or #1=(and (>= 2 (length set)) (member toki-pona set :test 'equalp)) (assert (progn (setq set #0#) #1#) (sentences) "The sentences' dictionaries are inadequate.")) (make-instance 'paragraph 'primary toki-pona 'auxiliary (or (car (delete toki-pona set :test 'equalp)) toki-pona) 'which (make-array length :element-type 'bit :initial-contents (apply 'concatenate 'bit-vector (mapcar 'which sentences))) 'words (make-array length :element-type 'limit :initial-contents (apply 'concatenate 'vector (mapcar 'words sentences))) 'sentences (make-array (length sentences) :element-type 'octet :initial-contents (mapcar #2# sentences)))) ;I could have these two share a body, but it's not worthwhile, considering the circumstances. (defun word> (first second) "This predicate is true when the first word is greater than the second." (cond ((and (eq toki-pona (dictionary first)) (eq (dictionary first) (dictionary second))) (> (index first) (index second))) ((string> (word-to-string first) (word-to-string second)) t))) (defun word< (first second) "This predicate is true when the first word is lesser than the second." (cond ((and (eq toki-pona (dictionary first)) (eq (dictionary first) (dictionary second))) (< (index first) (index second))) ((string< (word-to-string first) (word-to-string second)) t))) (defun dictionary-to-list (dictionary) "Convert a dictionary into a list of words." (loop :for index :below (array-dimension (words dictionary) 1) :collecting (word index dictionary))) ;I'd considered adding the following functions, but have decided it's not much worthwhile for a toy: ;add-to-end-of-dictionary ;update-word ;update-sentence ;update-paragraph .