basis/interpolate/interpolate.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors fry generalizations io io.streams.string kernel
   4 locals macros make math math.order math.parser multiline
   5 namespaces present sequences splitting strings vocabs.parser ;
   6 IN: interpolate
   7
   8 <PRIVATE
   9
  10 TUPLE: named-var name ;
  11
  12 TUPLE: stack-var n ;
  13
  14 TUPLE: anon-var ;
  15
  16 : (parse-interpolate) ( str -- )
  17     [
  18         "${" split1-slice [
  19             [ >string , ] unless-empty
  20         ] [
  21             [
  22                 "}" split1-slice
  23                 [
  24                     >string dup string>number
  25                     [ 1 + stack-var boa ]
  26                     [ [ anon-var new ] [ named-var boa ] if-empty ] ?if ,
  27                 ]
  28                 [ (parse-interpolate) ] bi*
  29             ] when*
  30         ] bi*
  31     ] unless-empty ;
  32
  33 : deanonymize ( seq -- seq' )
  34     0 over <reversed> [
  35         dup anon-var? [
  36             drop 1 + dup stack-var boa
  37         ] when
  38     ] map! 2drop ;
  39
  40 : parse-interpolate ( str -- seq )
  41     [ (parse-interpolate) ] { } make deanonymize ;
  42
  43 : max-stack-var ( seq -- n/f )
  44     f [
  45         dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
  46     ] reduce ;
  47
  48 :: interpolate-quot ( str quot -- quot' )
  49     str parse-interpolate :> args
  50     args max-stack-var    :> vars
  51
  52     args [
  53         dup named-var? [
  54             name>> quot call '[ _ @ present write ]
  55         ] [
  56             dup stack-var? [
  57                 n>> '[ _ npick present write ]
  58             ] [
  59                 '[ _ write ]
  60             ] if
  61         ] if
  62     ] map concat
  63
  64     vars [
  65         '[ _ ndrop ] append
  66     ] when* ; inline
  67
  68 PRIVATE>
  69
  70 MACRO: interpolate ( str -- quot )
  71     [ [ get ] ] interpolate-quot ;
  72
  73 : interpolate>string ( str -- newstr )
  74     [ interpolate ] with-string-writer ; inline
  75
  76 : interpolate-locals ( str -- quot )
  77     [ dup search [ [ ] ] [ [ get ] ] ?if ] interpolate-quot ;
  78
  79 SYNTAX: I[
  80     "]I" parse-multiline-string
  81     interpolate-locals append! ;