basis/interpolate/interpolate.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors fry generalizations io io.streams.string kernel
   4 make math math.order math.parser multiline namespaces present
   5 sequences splitting strings strings.parser 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
  25                     [ string>number ]
  26                     [ 1 + stack-var boa ]
  27                     [ [ anon-var new ] [ named-var boa ] if-empty ] ?if ,
  28                 ]
  29                 [ (parse-interpolate) ] bi*
  30             ] when*
  31         ] bi*
  32     ] unless-empty ;
  33
  34 : deanonymize ( seq -- seq' )
  35     0 over <reversed> [
  36         dup anon-var? [
  37             drop 1 + dup stack-var boa
  38         ] when
  39     ] map! 2drop ;
  40
  41 : parse-interpolate ( str -- seq )
  42     [ (parse-interpolate) ] { } make deanonymize ;
  43
  44 : max-stack-var ( seq -- n/f )
  45     f [
  46         dup stack-var? [ n>> [ or ] keep max ] [ drop ] if
  47     ] reduce ;
  48
  49 :: (interpolate-quot) ( str quot -- quot' )
  50     str parse-interpolate :> args
  51     args max-stack-var    :> vars
  52
  53     args [
  54         dup named-var? [
  55             name>> quot call '[ _ @ present write ]
  56         ] [
  57             dup stack-var? [
  58                 n>> '[ _ npick present write ]
  59             ] [
  60                 '[ _ write ]
  61             ] if
  62         ] if
  63     ] map concat
  64
  65     vars [
  66         '[ _ ndrop ] append
  67     ] when* ; inline
  68
  69 PRIVATE>
  70
  71 : interpolate-quot ( str -- quot )
  72     [ [ get ] ] (interpolate-quot) ;
  73
  74 MACRO: interpolate ( str -- quot )
  75     interpolate-quot ;
  76
  77 : interpolate>string ( str -- newstr )
  78     [ interpolate ] with-string-writer ; inline
  79
  80 : interpolate-locals-quot ( str -- quot )
  81     [ [ search ] [ [ ] ] [ [ get ] ] ?if ] (interpolate-quot) ;
  82
  83 MACRO: interpolate-locals ( str -- quot )
  84     interpolate-locals-quot ;
  85
  86 : interpolate-locals>string ( str -- newstr )
  87     [ interpolate-locals ] with-string-writer ; inline
  88
  89 SYNTAX: [I
  90     "I]" parse-multiline-string
  91     interpolate-locals-quot append! ;
  92
  93 SYNTAX: I" parse-string '[ _ interpolate>string ] append! ;