Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon.

Pages: 1-

S-Expressions to HTML

Name: Anonymous 2012-09-23 16:57

(define (tagged-list? expr)
  (and (pair? expr) (symbol? (car expr))))

(define (sexp->html expr)
  (cond ((null? expr) "")
        ((string? expr) expr)
        ((tagged-list? expr)
         (make-element (symbol->string (car expr)) "" (cdr expr)))
        ((pair? expr)
         (string-append (sexp->html (car expr))
                        (sexp->html (cdr expr))))
        (else (error "cannot be converted to html" expr))))

(define (make-element name attrs expr)
  (cond ((null? expr) (string-append "<" name attrs "/>"))
        ((tagged-list? expr)
         (make-element name
                       (string-append attrs
                                      " " (symbol->string (car expr))
                                      "=\"" (cadr expr) "\"")
                       (cddr expr)))
        (else
          (string-append "<" name attrs ">" (sexp->html expr) "</" name ">"))))


Sample input:
(let ((title "Hello, world!")
      (urls '("https://boards.4chan.org/g/"
              "https://www.reddit.com/r/programming"
              "https://news.ycombinator.com")))
  (display
    (sexp->html
      `(html lang "en-us"
             (head
               (meta charset "utf-8")
               (title ,title)
               (style type "text/css"
                      "o { text-decoration: overline; }"
                      "spoiler { background-color: #000; }"
                      "spoiler:hover { background-color: transparent; }"))
             (body
               (h1 ,title)
               (p "Welcome to " (spoiler "/prog/") "." (br)
                  (b (i (o (u "ENTERPRISE")))) " solutions!")
               (h2 "Places you should go back to.")
               (ul ,(map (lambda (url) `(li (a href ,url ,url)))
                         urls)))))))


Output:
http://pastebin.com/v4cTnfTJ (spam filter won't let me post HTML)

Name: Anonymous 2012-09-23 17:09

You've been busy, Xarn.

Name: Anonymous 2012-09-23 17:18

OWNED!

Symta:

taggedList? E:[!sym? @_] = E

sexpToHTML ø = “”
          ;"$E" = E
          ;[X@Xs]:taggedList? = makeElement X “” Xs
          ;[X@xs] =l @X,r @Xs,r
          ; _ = error “cannot be converted to html”

makeElement Name Attrs ø = "<$Name $Attrs>"
           ;Name Attrs [A B@Xs]:taggedList? = r Name “$Attrs $A ="$B"” Xs
           ;Name Attrs Expr = “<$Name $Attrs>$(sexpToHTML Expr)</$Name>”


Scheme:

(define (tagged-list? expr)
  (and (pair? expr) (symbol? (car expr))))

(define (sexp->html expr)
  (cond ((null? expr) "")
        ((string? expr) expr)
        ((tagged-list? expr)
         (make-element (symbol->string (car expr)) "" (cdr expr)))
        ((pair? expr)
         (string-append (sexp->html (car expr))
                        (sexp->html (cdr expr))))
        (else (error "cannot be converted to html" expr))))

(define (make-element name attrs expr)
  (cond ((null? expr) (string-append "<" name attrs "/>"))
        ((tagged-list? expr)
         (make-element name
                       (string-append attrs
                                      " " (symbol->string (car expr))
                                      "=\"" (cadr expr) "\"")
                       (cddr expr)))
        (else
          (string-append "<" name attrs ">" (sexp->html expr) "</" name ">"))))

Name: Anonymous 2012-09-23 17:20

>>3
Fuck off Shitta fagstorm

Name: Anonymous 2012-09-23 17:23

>>3
That looks hideous.

Name: Anonymous 2012-09-23 17:25

>>3
Symta: It's Bad™

Name: Anonymous 2012-09-23 17:25

>>4>>5
Sorry ヽ(*・ω・)ノ

Name: Anonymous 2012-09-23 17:27

>>3
Symta: It's Bad™

Name: Anonymous 2012-09-23 17:27

It would be nice if instead it collected all of the atoms in the string appends into a tree structure, flattened the tree structure, and then applied string append to the flattened list. Or instead if a lazy evaluation is present, the implementation could translate:


(string-append (string-append "a" "b") (string-append "c" "d"))


to


(string-append "a" "b" "c" "d")


and so on, until the actual string value is needed.

Name: Anonymous 2012-09-23 17:43

>>3
Nice.

>>9
Do you mean have sexp->html return a list of strings and then (apply string-append lst) to it? I can see how that might make the code easier to read, but traversing a tree is already inefficient, and traversing a list in addition to that would be Terrible! I assume that string-append is much faster than append as well.

If anybody has any optimization tips, let me know. I'm thinking of writing a blog and maybe even a text board in pure Scheme with S-exps as the templates and markup.

Name: Anonymous 2012-09-23 17:45

>>10
Are you going to do it in Racket?

Name: Anonymous 2012-09-23 17:46

xexpr->string is all i need

Name: Anonymous 2012-09-23 17:53

>>11
No, pure Scheme. No frameworks or non-standard implementation dependent shit, except getenv which is necessary for CGI and seems to be included with most implementations anyway.

Name: Anonymous 2012-09-23 18:04

>>10

the problem with using nested calls of string append is that there is unneeded copying. Consider the following:


class BadConcatExample {
  public static String concat(String[] strings) {
    String acc = "":
    for(String string : strings) {
      acc = acc + string;
    }
    return acc;
  }
}


versus:


class EnterpriseConcatExample {
  public static String concat(String[] strings) {
    StringBuilder acc = new StringBuilder();
    for(String string : strings) {
      acc.append(string);
    }
    return acc.toString();
  }
}


In the first example, there are many unneeded strings produced by the string concatenations. In fact, the first one takes \Omega(n^2) time. Whereas the second collects the strings in an ordered list, and then finally concatenates all of them once they entire collection is assembled. When all the strings are known at the time of the concatenation, the length of the final string is known, and the buffer can be allocated and each string copied once into its place. Thus, the entire operation can be done in linear time.

Your application is more complex than these example. In the examples a flat list is translated into a single string, whereas you must translate a tree of strings into a single string. You are right in that flattening a tree using append will be inefficient. A custom routine could be used for this though. It's hard to write though. I'll post it when I'm done.

Name: Anonymous 2012-09-23 18:30

>>14
the problem with using nested calls of string append is that there is unneeded copying.
Ah, you're right. It's kinda like the ''.join(strs) vs. for str in strs: result += str debate in FIOC. It just slipped my mind. I'll change the implementation.

Name: Anonymous 2012-09-23 18:58

>>15

yeah, it is sneaky. It's fairly easy to flatten a tree is you use a mutable stack and recursion, but I'm trying to write a functional version. I might finish soon... It's complicated and it could be slow...

Name: Anonymous 2012-09-23 19:06

>>16
How would a mutable stack or recursion make it non-functional?

Name: Anonymous 2012-09-23 19:11

>>17
I think he meant to say ``purely functional''

Name: Anonymous 2012-09-23 19:14

>>16
I managed to flatten the tree in one climb without append by using quasiquotes. Not sure if that has the same performance issues but it feels noticeably faster than it was.

(define (sexp->html expr)
  (define (tagged-list? expr)
    (and (pair? expr) (symbol? (car expr))))
  (define (iter expr)
    (cond ((null? expr) '())
          ((string? expr) `(,expr))
          ((tagged-list? expr)
           (make-element (symbol->string (car expr)) '() (cdr expr)))
          ((pair? expr)
           `(,@(iter (car expr)) ,@(iter (cdr expr))))
          (else
            (error "cannot be converted to html" expr))))
  (define (make-element name attrs expr)
    (cond ((null? expr) `("<" ,name ,@attrs "/>"))
          ((tagged-list? expr)
           (make-element name
                         `(,@attrs " " ,(symbol->string (car expr))
                                   "=\"" ,(cadr expr) "\"")
                         (cddr expr)))
          (else `("<" ,name ,@attrs ">" ,@(iter expr) "</" ,name ">"))))
  (apply string-append (iter expr)))

Name: Anonymous 2012-09-23 19:19

why not javascript?

Name: Anonymous 2012-09-23 19:19

>>19
Equivalent code without quasiquotes for readability.

define (sexp->html expr)
  (define (tagged-list? expr)
    (and (pair? expr) (symbol? (car expr))))
  (define (iter expr)
    (cond ((null? expr) '())
          ((string? expr) (list expr))
          ((tagged-list? expr)
           (make-element (symbol->string (car expr)) '() (cdr expr)))
          ((pair? expr)
           (append (iter (car expr))
                   (iter (cdr expr))))
          (else (error "cannot be converted to html" expr))))
  (define (make-element name attrs expr)
    (cond ((null? expr) (append (list "<" name) attrs (list "/>")))
          ((tagged-list? expr)
           (make-element name
                         (append attrs
                                 (list " " (symbol->string (car expr))
                                       "=\"" (cadr expr) "\""))
                         (cddr expr)))
          (else (append (list "<" name)
                        attrs
                        (list ">")
                        (iter expr)
                        (list "</" name ">")))))
  (apply string-append (iter expr)))

Name: Anonymous 2012-09-23 19:37

>>21
You missed the first (

Name: Anonymous 2012-09-23 19:39

>>19

yeah, this cuts out the string appends, so there is savings there. The quasiquote @ basically have the same functionality as append, so there are appends going on. The appends can be made optimal if the list data structure can find the back of the list in a single step and if they can be destructively appended to each other, but this isn't the case in when using conses in scheme.


(append (append '(1) '(2)) (append '(3) '(4)))
=>
(append '(1 2) '(3 4))
=>
'(1 2 3 4)


In the above, the '(1 2) '(3 4) lists are not really needed. If they are destructively modified to create the '(1 2 3 4) then the work to create them is useful for the final result, but if the '(1 2 3 4) list is a new copy, then the intermediate '(1 2) and '(3 4) lists aren't necessary.

I have something using delay and force. I'll post it once I work out the bugs.

Name: Anonymous 2012-09-23 19:53

>>18
The question still applies.

Name: Anonymous 2012-09-23 19:57

ok, here it is. It's a bit long.


(define (lcar llis) (car llis))
(define (lcdr llis) (force (cdr llis)))

;; There doesn't seem to be a promise? predicate...
;; This needs to be better.
(define (llist? lis)
  (pair? lis))

;; replace with define-syntax if not using an old scheme implementation
(defmacro (lcons first rest)
  `(cons ,first (delay ,rest)))

(define (list->llist lis)
  (if (null? lis)
    '()
    (lcons (car lis)
           (list->llist (cdr lis)))))

(define (llist . lis)
  (list->llist lis))

(define (llist->list llis)
  (letrec ((unroller (lambda (llis acc)
                       (if (null? llis)
                         (reverse acc)
                         (unroller (lcdr llis)
                                   (cons (lcar llis)
                                         acc))))))
    (unroller llis '())))

(define (lappend llises)
  (if (null? llises)
      '()
      (let ((first-llises (lcar llises))
            (rest-llises (lcdr llises)))
        (if (null? first-llises)
           (lappend rest-llises)
           (lcons (lcar first-llises)
                  (lappend (lcons (lcdr first-llises)
                                  rest-llises)))))))

(define (lmap1 fn llis)
  (if (null? llis)
    '()
    (lcons (fn (lcar llis))
           (lmap1 fn (lcdr llis)))))

(define (lfor-each proc llis)
  (if (not (null? llis))
    (begin (proc (lcar llis))
           (lfor-each proc (lcdr llis)))))

(define (tree->ltree tre)
  (if (list? tre)
    (list->llist (map tree->ltree tre))
    tre))

(define (flatten-ltree ltre)
  (if (llist? ltre)
    (lappend (lmap1 flatten-ltree ltre))
    (llist ltre)))

(define (test)
  (let ((data '((((test test test)
                  test
                  (test test)
                  data
                  (data data (test)))
                 (nested data test)
                 test)
                (data data data test test (t) (((t))) (t test test)))))
    (display (apply string-append
                    (llist->list (lmap1 symbol->string
                                        (flatten-ltree (tree->ltree data))))))))

(test)

Name: Anonymous 2012-09-23 20:07

>>24
I don't know, it wasn't obvious to me how to express it in a purely functional way. But I'll try it that way. I think it can be done easier that way a lot easier than >>25 actually. It would need to be a recursive procedure that takes both the tree and the current state of the stack as a parameter, and then the new state of the stack would be returned. It's actually pretty natural.

Name: Anonymous 2012-09-23 20:45

yeah, this is a lot easier.


(define (flatten-tree tree stack)
  (if (or (not (list? tree)) (null? tree))
    (cons tree stack)
    (flatten-tree-list (car tree) (cdr tree) stack)))

(define (flatten-tree-list elem top-level-list stack)
  (if (null? top-level-list)
    (flatten-tree elem stack)
    (flatten-tree-list (car top-level-list)
                       (cdr top-level-list)
                       (flatten-tree elem stack))))

(define (test)
  (let ((data '((1) data data data (data data (data) (data) (data) (((data)))) (data data))))
    (display (reverse (flatten-tree data '())))))

(test)

Name: Anonymous 2012-09-24 19:16

This is kawaii as fuck. Too bad HTML is shit.

Name: Anonymous 2012-09-25 17:18

Name: Anonymous 2013-01-05 10:52

>>29
Wow, that's rather interesting.

Name: Anonymous 2013-08-31 13:59


Of course there are multiple solutions that all mean something different:

Name: Anonymous 2013-08-31 14:44


If my rather charismatic Bard rolls 1d20+8 for a gather information check, it takes 1d4+1 HOURS to complete. So does that mean I can't do anything else for christ knows how many turns?! Surely by that time the party would have moved on!

Name: Anonymous 2013-08-31 15:30


There is now a 1.54 patch. Also there is a patch to update from 1.50 to 1.54 (and from 1.52 to 1.54 if you have the DL version).
This update adds a third version of the "Secret Basement", the dungeon that generates random items in your inventory each floor.

Name: Anonymous 2013-09-01 14:35


In accordance with the traditional view of Aristotle, the Hellenistic Greeks generally preferred to distinguish the potential infinity from the actual infinity; for example, instead of saying that there are an infinity of primes, Euclid prefers instead to say that there are more prime numbers than contained in any given collection of prime numbers (Elements, Book IX, Proposition 20).

Don't change these.
Name: Email:
Entire Thread Thread List