From: Christopher Allan Webber Date: Mon, 23 Jan 2017 18:20:42 +0000 (-0600) Subject: New backronym for SCRUBL, export stuff, make faster X-Git-Tag: fosdem-2017~99 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=c81524f4606c337e5282b22850dc4b1b93868eb7;p=mudsync.git New backronym for SCRUBL, export stuff, make faster Now uses hashes under the hood, but still an immutable interface --- diff --git a/mudsync/scrubl.scm b/mudsync/scrubl.scm index cf585b9..1d82338 100644 --- a/mudsync/scrubl.scm +++ b/mudsync/scrubl.scm @@ -16,15 +16,23 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with Mudsync. If not, see . -;;; SCRUBL: S-exps Can Really Undermine Basic Language -;;; a micro-"skribe-like" system +;;; SCRUBL: S-exps Craftily/Crappily Representing the Underlying Basic Language +;;; a micro-"skribe-like" system (kinda ugly tho) +;;; Turns quasiquoted structures into something rendered. +;;; +;;; This is an immutable interface but it does use mutation under the +;;; hood for expediency. +;;; To make a new scrubl that extends an existing scrubl, use the exported +;;; scrubl-extend-fields. (define-module (mudsync scrubl) #:use-module (ice-9 match) #:use-module (srfi srfi-9) - #:use-module (srfi srfi-9 gnu) #:use-module (sxml simple) - #:use-module (oop goops)) + #:use-module (oop goops) + #:export (make-scrubl + scrubl? scrubl-extend-fields + scrubl-sxml scrubl-sxml-simple-field)) (define (order-symlist-args symlist-args) "Orders the args in a symlist so keyword pairs are at the end" @@ -45,17 +53,35 @@ kwargs))))) new-args) -(define-immutable-record-type - (make-scrubl field-writers meta-write) +(define-record-type + (%make-scrubl field-writers meta-write) scrubl? (field-writers scrubl-field-writers) (meta-write scrubl-meta-write)) +(define (make-scrubl field-writers meta-write) + (%make-scrubl (alist->hashq-table field-writers) + meta-write)) + (define (scrubl-extend-fields scrubl new-field-writers) "Returns a new instance extending SCRUBL's field-writers with NEW-FIELD-WRITERS." - (set-field scrubl (scrubl-field-writers) - (append new-field-writers (scrubl-field-writers scrubl)))) + (define new-writers + (let ((new-table (make-hash-table))) + ;; Add old fields from hashq + (hash-for-each + (lambda (key val) + (hashq-set! new-table key val)) + (scrubl-field-writers scrubl)) + ;; Now add the new fields + (for-each + (match-lambda + ((key . val) + (hashq-set! new-table key val))) + new-field-writers) + new-table)) + + (%make-scrubl new-writers (scrubl-meta-write scrubl))) (define (scrubl-write scrubl obj . args) "Write out OBJ via SCRUBL @@ -67,7 +93,7 @@ Pass in optional extra ARGS to the main META-WRITE" (match obj (((? symbol? sym) args ...) (let* ((field-writers (scrubl-field-writers scrubl)) - (field-writer (assoc-ref field-writers sym)) + (field-writer (hashq-ref field-writers sym)) (ordered-args (order-symlist-args args))) (when (not field-writer) (throw 'scrubl-unknown-field @@ -84,13 +110,13 @@ Pass in optional extra ARGS to the main META-WRITE" ;;; SXML scrubl writer -(define (sxml-write scrubl obj) +(define (scrubl-sxml-write scrubl obj) (call-with-output-string (lambda (p) (sxml->xml (scrubl-write-obj scrubl obj) p)))) -(define (sxml-simple-field sym) +(define (scrubl-sxml-simple-field sym) (lambda (scrubl args) ;; sxml handles inlining automatically in case we have nested ;; lists of strings, so we don't have to worry about that... @@ -98,9 +124,9 @@ Pass in optional extra ARGS to the main META-WRITE" (scrubl-write-obj scrubl arg)) args)))) -(define sxml-scrubl - (make-scrubl `((p . ,(sxml-simple-field 'p)) - (bold . ,(sxml-simple-field 'b)) - (it . ,(sxml-simple-field 'it)) - (emph . ,(sxml-simple-field 'it))) - sxml-write)) +(define scrubl-sxml + (make-scrubl `((p . ,(scrubl-sxml-simple-field 'p)) + (bold . ,(scrubl-sxml-simple-field 'b)) + (it . ,(scrubl-sxml-simple-field 'it)) + (emph . ,(scrubl-sxml-simple-field 'it))) + scrubl-sxml-write))