├── .gitignore ├── LICENSE ├── README.org ├── boxed.ijs ├── cheq.ijs ├── cursor.ijs ├── dict.ijs ├── etc ├── draw.org ├── ebnf.ebnf ├── ebnf.ijs ├── gramed.ijs ├── pretty.ijs └── scratch.ijs ├── graphdb.ijs ├── jfdag.ijs ├── list.ijs ├── metaprims.org ├── mvars.ijs ├── old ├── boxer.ijs └── sx-by-hand.ijs ├── ops.ijs ├── parseco.ijs ├── pl0 ├── build-pas ├── load-pl0.ijs ├── pl0.sx ├── pl0syntax.ijs └── pl0syntax.pas ├── prex.ijs ├── proofed.ijs ├── rel.ijs ├── stringdb.ijs ├── stype.ijs ├── sx.ijs ├── syndir-spec.org ├── syndir.ijs ├── todo.org ├── unify.ijs ├── unj.ijs ├── unparse.ijs └── versions.sql /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 tangentstorm 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * syndir: a syntax directed editor 2 | 3 | ** Goals (what will it do?) 4 | 5 | The goal is to produce a tool that allows performing arbitrary operations on code, including: 6 | 7 | - browsing 8 | - refactoring 9 | - correctness proofs 10 | - literate programming 11 | - version control 12 | - automatic inlining and minimization 13 | - peer review 14 | 15 | Everything is stored in a graph database, allowing fine grained version control, hypertext navigation, and literate programming. 16 | 17 | Text entry is syntax directed, meaning that code is stored internally as a graph structure, rather than just lines of text. 18 | 19 | New code can be entered as text, but it is immediately parsed and converted to a graph structure. 20 | 21 | Alternatively, text entry can be restricted to applications of syntactic production rules based on a formally defined grammar, also stored in the graph database. 22 | 23 | Existing code can be modified in place according to predefined rules of inference, allowing code to be transformed or refined automatically while preserving or generalizing the semantics. 24 | 25 | Each transformation step is also stored in the database, and sequences of transformations can serve as version control history or be presented as a proof of equivalence or implication between two expressions. 26 | 27 | Once these tools are working, the system can be used to bootstrap its own replacement, where the entire system is formally proven and automatically verified from the first line of code. 28 | 29 | * dependency tree (indented items are used by the modules above) 30 | 31 | - syndir.ijs :: (eventually) the main application 32 | - [[https://github.com/tangentstorm/j-kvm/][j-kvm]] :: console ui framework 33 | - jfdag.ijs :: persistent DAG as document/AST store. 34 | - [[https://code.jsoftware.com/wiki/Guides/Component_Files][jfiles]] :: j component files 35 | 36 | Various alternate implementations/attempts to be merged with above: 37 | 38 | - graphdb.ijs :: simple graph database / triple store 39 | - mvars.ijs :: helper for memory mapped variables (uses jmf) 40 | - stringdb.ijs :: persistent key-value store (uses jfiles) 41 | 42 | - boxed.ijs :: boxed token editor widget 43 | - list.ijs :: list data type 44 | - cursor.ijs :: cursor object 45 | 46 | - proofed.ijs :: tree-centric syntax directed editor 47 | - stype.ijs :: type inspection (redundant?) 48 | - unify.ijs :: unification algorithm 49 | - sx.ijs :: s-expressions 50 | - parseco.ijs :: parser combinators 51 | - dict.ijs :: in-memory key-value dictionaries 52 | 53 | - rel.ijs :: relational programming (with syntax directed example) 54 | 55 | *PL/0* is a toy language designed by Niklaus Wirth for teaching compilers. 56 | 57 | - pl0.sx :: pl/0 grammar as an s-expression. 58 | - load-pl0.ijs :: load pl0.sx into jfdag database. 59 | - pl0syntax.ijs :: unparse and pretty-print the pl0 grammar. 60 | 61 | The =old= directory contains older prototype components, 62 | and will likely be removed: 63 | 64 | - unparse.ijs :: unparser/pretty-printer 65 | - sx-by-hand.ijs :: handwritten s-expression parser 66 | - boxer :: tree/stack builder based on boxes 67 | -------------------------------------------------------------------------------- /boxed.ijs: -------------------------------------------------------------------------------- 1 | NB. editor for boxed structures 2 | require 'list.ijs cursor.ijs' 3 | require 'tangentstorm/j-kvm' 4 | 5 | coclass 'BoxEd' 6 | coinsert 'Cursor kvm vt' 7 | doc =: 'A simple editor for boxed arrays' 8 | 9 | NB. create inherited from Cursor 10 | 11 | boxc =: ,(,.<"0 a.{~ 16+i.11),.(8 u: dfh) each cut'250c 252c 2510 251c 253c 2524 2514 2534 2518 2502 2500' 12 | boxe =: {{ y rplc"1 boxc }} 13 | 14 | 15 | wr =: {{puts 8 u: y}} 16 | cw =: wr 17 | wl =: {{ wr CRLF,~ boxe y }}"1 18 | rk =: rkey 19 | NB. rl =: (1!:1)@1 20 | rl =: {{ 21 | r =. '' 22 | while. -. (CRLF) e.~ k =. a.{~{.>rkey'' do. 23 | NB. why exactly is this 255 character getting used? 24 | r=.(255{a.)-.~r,k 25 | end. 26 | r }} 27 | 28 | 29 | NB. "tab stops" for each item, since they may have different lengths 30 | stops =: {:@$@":\ 31 | 32 | errmsg =: 13!:12 33 | 34 | show =: verb define 35 | NB.cscr'' 36 | goxy 0 0 37 | boxes =. value__data 38 | wl ": boxes NB. draw the boxed items !! TODO: fix box chars 39 | goxy 1 3 40 | 'c w' =. (here&{ , {:) 0,<: stops boxes NB. cursor, width 41 | fg _8 NB.cw '|K', 42 | wr (u:' ',u:8593) {~ c = i. 1+ w NB. draw arrow for (each?) cursor 43 | fg _12 NB.cw '|B' 44 | goxy 0 4 45 | try. wr"1 ": ". ; }. ,(<,' '),. boxes catch. wr errmsg '' [ fg _1 end. NB. cw |r 46 | fg _7 NB.cw '|w' 47 | ) 48 | 49 | prompt =: verb define 50 | goxy 0 5 51 | fg _3 52 | wr y 53 | fg _7 54 | raw 0 55 | ln =: rl'' 56 | raw 1 57 | ;:ln 58 | ) 59 | 60 | run =: {{ 61 | cscr'' [ curs 0 62 | show loop_kvm_ coname''}} 63 | 64 | k_p =: k_arrlf =: nudge@_1 65 | k_n =: k_arrrt =: nudge@1 66 | 67 | k_q =: {{ break_kvm_ =: 1 }} 68 | k_x =: cscr@del 69 | k_d =: cscr@dup 70 | k_t =: cscr@swap 71 | k_i =: cscr@ins@prompt@'> ' 72 | 73 | BoxEd_z_ =: conew&'BoxEd' 74 | 75 | ed =: BoxEd;:'+/p:i.10' 76 | run__ed'' 77 | -------------------------------------------------------------------------------- /cheq.ijs: -------------------------------------------------------------------------------- 1 | NB. cheq y : checks that the result of y is equal to the following noun 2 | cocurrent'cheq' 3 | 4 | NB. unicode box chars. (j magically translates these to unicode for display) 5 | uboxch=: [: (9!:7) (a.{~16 17 18 19 20 21 22 23 24 25 26)"_ 6 | 7 | aboxch =: 16 26 17 18 25 22 23 24 19 20 21 8 | NB. ┌ ─ ┬ ┐ │ └ ┴ ┘ ├ ┼ ┤ 9 | uboxch =: 9484 9472 9516 9488 9474 9492 9524 9496 9500 9532 9508 10 | 11 | forcerank =: ,@] $~ -@[ {.!.1 [: $ ] 12 | 13 | NB. function to apply the map to ascii string y, leaving other chars unchanged 14 | a2ubox=: ((uboxch {~ aboxch i. ]) ::] ])&.(3 u:])"0 15 | lines =: [: (<;._2) 7 u: ] 16 | 17 | cheq =: 3 : 0 18 | expect=: > lines 0 : 0 19 | actual=: a2ubox 2 forcerank ": y 20 | if. actual -: expect do. 21 | else. 22 | echo '' 23 | echo 'actual=:' 24 | echo actual 25 | echo 'expect=:' 26 | echo expect 27 | 'actual -: expect' assert actual -: expect 28 | 0$0 29 | end. 30 | ) 31 | cheq_z_=:cheq_cheq_ 32 | 33 | NB. examples: 34 | 35 | cheq (];$) 2 forcerank i. 3 3 36 | ┌─────┬───┐ 37 | │0 1 2│3 3│ 38 | │3 4 5│ │ 39 | │6 7 8│ │ 40 | └─────┴───┘ 41 | ) 42 | 43 | cheq (];$) 2 forcerank i. 3 44 | ┌─────┬───┐ 45 | │0 1 2│1 3│ 46 | └─────┴───┘ 47 | ) 48 | 49 | cheq i.5 50 | 0 1 2 3 4 51 | ) 52 | 53 | cheq (5!:4)<'lines' 54 | ┌─ [: 55 | │ ┌─ < 56 | ├─ ;. ─┴─ _2 57 | ──┤ 58 | │ ┌─ 7 59 | └──────┼─ u: 60 | └─ ] 61 | ) 62 | -------------------------------------------------------------------------------- /cursor.ijs: -------------------------------------------------------------------------------- 1 | require 'list.ijs' 2 | 3 | NB. a basic cursor class, with support for text terminal display 4 | coclass'Cursor' 5 | 6 | create =: monad define 7 | data =: List'' 8 | here =: 0 9 | setdata y 10 | ) 11 | setdata =: monad define 12 | update__data y 13 | nudge 0 14 | ) 15 | ins =: monad define 16 | here ins__data y 17 | nudge #y 18 | ) 19 | del =: verb define 20 | del__data here 21 | ) 22 | swap =: verb define 23 | if. -. here e. 0, len__data do. here swap__data here-1 end. 24 | ) 25 | dup =: verb define 26 | if. here > 0 do. setdata (>: ((<: here) = i. # data)) # data end. 27 | ) 28 | nudge =: monad define 29 | lo =: 0 [ hi =: len__data'' 30 | here=: hi <. lo >. here + {.y 31 | ) 32 | 33 | Cursor_z_ =: conew&'Cursor' 34 | 35 | -------------------------------------------------------------------------------- /dict.ijs: -------------------------------------------------------------------------------- 1 | NB. a simple key-value dictionary system for j 2 | 3 | NB. symbol constructor (for string keys) 4 | key=:(' '$:]) : (s:@:,) 5 | S=: 1 : 's:'' '',m' 6 | 7 | NB. constructors: 8 | emptyd =: a:,a: 9 | 10 | NB. x:K map y:V → D(K,V) 11 | dict =: ,&<&, [ ('key/val lengths must match' assert =&#) 12 | 13 | NB. keys y:D → K 14 | keys=: >@[/ 15 | 16 | NB. vals y:D → V 17 | vals=: >@]/ 18 | 19 | NB. x:D get y:K → V 20 | get =: [: : ((keys@[i.]) { vals@[) f. 21 | 22 | NB. x:D idx y:K → int 23 | idx =: [: : (keys i. ]) f. 24 | 25 | NB. len y:D → int 26 | len =: [: >0{$L:0 27 | 28 | NB. m:K put n:V y:D → Dict (replacing existing values for keys) 29 | put =: 2 : 0 30 | 'K V'=:y 31 | if. (i=:K i.m) >: #K do. (K=:K,m) ] (V=:V,n) 32 | else. V =: n i } V end. 33 | K dict V 34 | ) 35 | 36 | 37 | 38 | NB. test case / example usage: 39 | 40 | NB. unicode box chars. (j magically translates these to unicode for display) 41 | uboxch=: [: (9!:7) (a.{~16 17 18 19 20 21 22 23 24 25 26)"_ 42 | NB. the same translation as a dictionary, so we can compare to unicode strings. 43 | a2uboxd=:(16 26 17 18 25 22 23 24 dict 9484 9472 9516 9488 9474 9492 9524 9496) 44 | NB. function to apply the map to ascii string y, but leave other chars unchanged: 45 | a2ubox=: (a2uboxd get ::] ])&.(3 u:])"0 46 | 47 | lines =: [: (<;._2) 7 u: ] 48 | shouldbe =: [: assert (>@lines@[) -: a2ubox@] 49 | 50 | (0 : 0) shouldbe ": ((key 'a b c') dict ('apple';'banana';'cherry')) get key 'b a' 51 | ┌──────┬─────┐ 52 | │banana│apple│ 53 | └──────┴─────┘ 54 | ) 55 | 56 | NB. for a version of this that doesn't require dicts, see 'cheq.ijs'' 57 | 58 | 59 | NB. rev y:D → D (reverse keys and values) 60 | rev =: (}.,{.) : [: 61 | 62 | NB. TODO: m:K ins n:V y:Dict → Dict 63 | NB. (adding multiple values for keys) 64 | NB. ins =: 2 : ' ' 65 | -------------------------------------------------------------------------------- /etc/draw.org: -------------------------------------------------------------------------------- 1 | drawing model 2 | 3 | : syms =: {{(y)=:s:;:y}} 4 | : syms 'Text Line Nest' 5 | 6 | Doc = 7 | - Text Style Text // a single token, (no newline) 8 | - Line // newline 9 | - Indent Int Doc // indent the nested document 10 | -------------------------------------------------------------------------------- /etc/ebnf.ebnf: -------------------------------------------------------------------------------- 1 | syntax = production . 2 | production = identifier '=' expression '.' . 3 | expression = term {'|' term} . 4 | term = factor { factor }. 5 | -------------------------------------------------------------------------------- /etc/ebnf.ijs: -------------------------------------------------------------------------------- 1 | require 'tangentstorm/j-kvm/vt' 2 | require 'parseco.ijs' 3 | require 'gramco.ijs' 4 | 5 | NB. -- ebnf --- 6 | wsz =: WS orp zap 7 | zw =: {{wsz`(u)`wsz seq}} NB. zap whitespace 8 | zwt =: zw tok 9 | zws =: lit zwt 10 | 11 | syntax =: production orp 12 | production =: (IDENT zwt)`('='zws)`expression`('.'zws) seq elm 'rule' 13 | expression =: term sep ('|'zws) 14 | term =: factor zw rep 15 | factor =: (IDENT zwt)`(J_STR zwt)`sub_factor`opt_factor`orp_factor alt zw 16 | sub_factor =: ('(' zws)`expression`(')' zws) seq 17 | opt_factor =: ('[' zws)`expression`(']' zws) seq 18 | orp_factor =: ('{' zws)`expression`('}' zws) seq 19 | -------------------------------------------------------------------------------- /etc/gramed.ijs: -------------------------------------------------------------------------------- 1 | NB. plain text editor with parser support 2 | require 'tangentstorm/j-kvm/ui' 3 | 4 | fnm =: 2 {:: :: '' ARGV 5 | txt =: UiList 'b'freads^:(*@#@]) fnm 6 | grm =: UiList <'grammar goes here' 7 | ast =: UiList <'AST goes here' 8 | 9 | 10 | NB. -- layout --------------- 11 | 'h w' =: gethw_vt_'' 12 | 'XY__txt XY__grm XY__ast' =: 0,"0(ih=.<.h%3)*i.3 13 | 'H__txt H__grm H__ast' =: ih 14 | 15 | app =: UiApp txt,grm,ast 16 | 17 | NB. tab key to switch widgets 18 | kc_i__app =: {{ R__F=:1 [ F =: W{~(#W)|1+W i.F [ R__F=:1 }} 19 | 20 | (9!:29) 1 [ 9!:27 'run__app _' 21 | -------------------------------------------------------------------------------- /etc/pretty.ijs: -------------------------------------------------------------------------------- 1 | NB. pretty-printer drawing model 2 | 3 | syms =: {{(y)=:s:;:y}} 4 | 5 | 6 | NB. Tree = (str ; [Tree]) 7 | 8 | tree =: ('aaa';()) 9 | 10 | 11 | syms 'Text Nest Union Nil' 12 | 13 | NB. Doc = 14 | NB. - a: // empty doc (nil) 15 | NB. - Text Str // a string chunk/token (no newline) 16 | NB. - Nest Int Doc // indent/nest (always on new line) 17 | NB. - Union Doc Doc 18 | 19 | nil =: ,< Str 29 | layout =: {{ 30 | select. >{.y=.>y 31 | case. Nil do. '' 32 | case. Text do. >{: y 33 | case. Nest do. 34 | }} -------------------------------------------------------------------------------- /etc/scratch.ijs: -------------------------------------------------------------------------------- 1 | walk =: {{ 2 | if. y -: a: do. return. end. NB. ?? 3 | on_node__x y 4 | for_box. t_nb y do. 5 | item =. >box 6 | if. is_node item do. x walk item 7 | else. on_leaf__x item end. 8 | end. 9 | on_done__x y }} 10 | 11 | dbg 1 12 | depth =: 0 13 | on_node =: {{ depth =: 1+depth [ puts ('('&,)^:(*depth) >t_nt y}} 14 | on_leaf =: {{ puts ' ', y }} 15 | on_done =: {{ puts ')', CRLF }} 16 | 17 | -------------------------------------------------------------------------------- /graphdb.ijs: -------------------------------------------------------------------------------- 1 | NB. a simple memory-mapped graph database 2 | require 'mvars.ijs stringdb.ijs' 3 | cocurrent'base' [ coinsert 'mvars stringdb' 4 | 5 | stringdb mdir,'/nodes.jf' 6 | 7 | 'rType rChild' =: i.2 8 | 9 | NB. G and P (get/put) get and put global variables 10 | setg=: {{ ".x,'=:',(5!:6)<'y' }} NB. set global using parenthesized repr 11 | G=: {{ m~[y }} 12 | P=: {{ m setg y }} 13 | 14 | 3 : 0'' 15 | NB. only declare these mapped variables if they're undefined. 16 | NB. if the file is already mapped, it'll cause an assertion 17 | NB. failure. This conditional is just to allow reloading this 18 | NB. file during development. 19 | if. _1 = (4!:0)<'SUB' do. 20 | mvar'SUB REL OBJ ETS' NB. the table of edges 21 | '`sub rel obj ets'=:('SUB'G)`('REL'G)`('OBJ'G)`('ETS'G) 22 | end. 23 | ) 24 | 25 | incoming =: [: I. obj = ] 26 | outgoing =: [: I. sub = ] 27 | children =: (#~ rChild=]{rel) @ outgoing 28 | 29 | nid =: ({.@s2k) :. k2s NB. fetch node id given string value 30 | 31 | declare =: verb define 32 | NB. declare 'sub rel obj' → creates a new edge in the db. 33 | 's r o' =. (+ :: (nid"0@:(;: :: ]))) y 34 | SUB =: SUB,s [ REL =: REL,r [ OBJ =: OBJ,o 35 | ETS =: ETS,tsrep 6!:0'' NB. timestamp each entry. 36 | EMPTY 37 | ) 38 | 39 | retract =: verb define 40 | NB. retract'' → removes the most recently created edge. 41 | SUB =: }:SUB [ REL =: }:REL [ OBJ =: }:OBJ [ ETS =: }:ETS 42 | EMPTY 43 | ) 44 | 45 | edges =: verb define 46 | NB. returns a boxed table of strings, representing the edges. 47 | if. -.#y do. y=.i.#SUB end. 48 | >@k2s "0 L:0(y{SUB);(y{REL);(y{OBJ) 49 | ) 50 | -------------------------------------------------------------------------------- /jfdag.ijs: -------------------------------------------------------------------------------- 1 | NB. tree/dag database stored in a single jfile. 2 | NB. each node is a component 3 | require 'jfiles' NB. jcreate, jerase, jappend, jread, jreplace, jdup, jsize 4 | require 'parseco.ijs' 5 | 6 | NB. -- struct builder (see parseco.ijs) -- 7 | AT =: {{ m&{:: : (<@[ m} ]) }} 8 | struct =: {{ 9 | ({{ ". x,'=:',(":y),' AT' }}&>"0 i.@#) fs =. cut y 10 | ". m,'=: (a:#~',(":#fs),'"_) : (;:@',(quote y),')' }} 11 | 12 | NB. -- node structure -------------------- 13 | 14 | 'N' struct 'ntp ntx nkv nup ndn' 15 | 16 | D0 =: 2 0$a: 17 | N0 =: D0 nkv N'' 18 | 19 | 20 | NB. -- database api ---------------------- 21 | 22 | JF =: '.dag.jf' 23 | 24 | jfa =: jappend&JF NB. append 25 | jfr =: [: jread JF;] NB. read slot y 26 | jfw =: [ jreplace JF;] NB. write x to slot y 27 | jfl =: 1 { jsize@JF NB. length 28 | jf =: jfr_base_ : jfw_base_ NB. read/write 29 | 30 | wjf =: {{ r[y jf_base_~ r=.u&.> jf_base_ y }} NB. with jfile 31 | 32 | jfc =: {{ NB. nid jfc text -> nid : add child 33 | r =. jfa < y ntx x nup N0 34 | (ndn~ r ,~ ndn) wjf x 35 | r }} 36 | 37 | {{ (y)=: i.#;:y }}'JF_ROOT JF_META JF_LANGS JF_TREES JF_EBNF JF_JSON JF_PL0' 38 | 39 | is_tree_node =: (3=#) *. 'boxed'-:datatype 40 | import_tree =: {{ 41 | nid =. x jfc >t_nt y 42 | for_box. t_nb y do. 43 | item =. >box 44 | if. is_tree_node item do. nid import_tree item 45 | else. nid jfc item end. 46 | end. 47 | nid}} 48 | 49 | jf0 =: {{ 50 | assert 0=jfl'' 51 | assert JF_ROOT = jfa < '(root)'ntx N0 52 | assert JF_META = JF_ROOT jfc 'JF_META' 53 | assert JF_LANGS = JF_ROOT jfc 'JF_LANGS' 54 | assert JF_TREES = JF_ROOT jfc 'JF_TREES' 55 | assert JF_EBNF = JF_LANGS jfc 'ebnf' 56 | assert JF_JSON = JF_LANGS jfc 'json' 57 | 58 | NB. auto-mount the pl0 grammar 59 | pl0 =. 'pl0' t_nt 3{.ts se on CRLF -.~ freads'pl0/pl0.sx' 60 | assert JF_PL0 = JF_LANGS import_tree pl0 61 | }} 62 | 63 | NB. create and initialize if necessary 64 | (jf0@jcreate)^:(-.@fexist) JF 65 | -------------------------------------------------------------------------------- /list.ijs: -------------------------------------------------------------------------------- 1 | coclass 'List' 2 | doc =: 'A general purpose list class.' 3 | 4 | create =: monad define 5 | update y 6 | ) 7 | update =: monad define 8 | value=:y NB. replace all values 9 | ) 10 | get =: monad define 11 | y { value 12 | ) 13 | ins =: dyad define 14 | update x ({., y, }.) value 15 | ) 16 | del =: verb define 17 | 1 del y 18 | : 19 | update (y {. value), (y + x) }. value 20 | ) 21 | len =: verb define 22 | # value 23 | ) 24 | swap =: verb define 25 | (2|.\y) swap y NB. swap 0 1 2 3 → 1 0 3 2 swap 0 1 2 3 26 | : 27 | update (y{value) x } value 28 | ) 29 | 30 | List_z_=:conew&'List' 31 | -------------------------------------------------------------------------------- /metaprims.org: -------------------------------------------------------------------------------- 1 | NB. This is a specification for how the syntax directed 2 | NB. editor should behave. 3 | 4 | NB. The text is delimited by ⸢...⸣ 5 | NB. The current selection is delimited by ⸤...⸥ 6 | NB. The ¤ symbol reperesents the insertion point. 7 | NB. 8 | NB. The following fake j primitives represent nonterminals: 9 | NB. 10 | NB. J: = j sentence 11 | NB. N: = noun 12 | NB. A: = adverb 13 | NB. C: = conjunction 14 | NB. V: = verb 15 | NB. S: = assignment 16 | NB. 17 | NB. For this spec, the verb 't' (for 'text') tests that the current 18 | NB. state of the text matches the following explicit noun. 19 | NB. The verb 'm' (for 'menu') does the same for the available 20 | NB. menu options. 21 | 22 | NB. The initial text is always the node ⸢J:⸣. 23 | t'' 24 | ⸢⸤¤J:⸥⸣ 25 | ) 26 | m'' 27 | → move cursor to the right 28 | n J: ⇒ J: N: J: 29 | v J: ⇒ J: V: J: 30 | g J: ⇒ J: I: =: J: 31 | l J: ⇒ J: I: =. J: 32 | ) 33 | 34 | NB. The cursor can be moved forward. 35 | A'→' 36 | ⸢⸤J:¤⸥⸣ 37 | ) 38 | 39 | NB. Applying rule 'n' introduces a noun. 40 | A'n' 41 | ⸢⸤N:⸥¤⸣ 42 | ) 43 | 44 | 0 1 2 3 45 | N: A: C: V: (: I: L: G: R: 46 | ‹«⇐ 47 | ⊥ 48 | a::. n::. v::. c::. A::. N::. V::. C::. 49 | 50 | -------------------------------------------------------------------------------- /mvars.ijs: -------------------------------------------------------------------------------- 1 | NB. memory mapped variables 2 | load'jmf' 3 | 4 | mdir_z_ =:'~/mvars' 5 | mvar_z_ =: verb define 6 | NB. usage: (sizes:int+)? mvar names:str → '' 7 | NB. creates memory mapped variables in the calling locale. 8 | 16 mvar y NB. reserve 2^16 bytes (64 kib) by default. 9 | : 10 | path =. jpath mdir,'/',cn=.>coname'' 11 | if. -. fexist path do. fpathcreate path end. 12 | for_box. ;:y do. fullvar =. ; (var=.>box);'_';cn;'_' 13 | if. fexist fn=.path,'/',var,'.mvar' do. 14 | else. createjmf_jmf_ fn ; size=.2^x end. 15 | map_jmf_ fullvar ; fn 16 | end. 17 | ) 18 | -------------------------------------------------------------------------------- /old/boxer.ijs: -------------------------------------------------------------------------------- 1 | NB. boxer: build trees with nested boxes 2 | 3 | NB. stacks of like objects 4 | NB. ---------------------------------------------------------- 5 | coclass 'Stack' 6 | 7 | create =: {{ data =: y }} 8 | pop =: {{ r [ data =: }. data [ r =. {. data }} 9 | push =: {{ data =: y , data }} 10 | append =: {{ data =: data , y }} 11 | extend =: append 12 | top =: {{ > {. data }} NB. top of stack 13 | result =: {{ data }} 14 | destroy=: codestroy 15 | 16 | NB. stacks of boxed objects (mixed types) 17 | NB. ---------------------------------------------------------- 18 | coclass 'BoxStack' 19 | coinsert 'Stack' 20 | 21 | NB. overrides: 22 | extend =: [: extend_Stack_ f. < 23 | push =: [: push_Stack_ f. < 24 | tos =: [: > top_Stack_ f. 25 | pop =: [: > pop_Stack_ f. 26 | 27 | 28 | NB. Boxers build trees of boxed objects. 29 | NB. --------------------------------------------------------- 30 | coclass 'Boxer' 31 | 32 | create =: {{ 33 | state =: 0 34 | depth =: 0 35 | main =: '' conew 'BoxStack' 36 | path =: '' conew 'BoxStack' 37 | here =: main }} 38 | 39 | pushstate =: {{ 40 | depth =: depth + 1 41 | push__path state 42 | push__path here 43 | here =: '' conew 'BoxStack' 44 | state =: y }} 45 | 46 | popstate =: {{ 47 | tmp =. result__here'' 48 | there =. here 49 | here =: pop__path'' 50 | if. # tmp do. extend__here tmp else. extend__here a: end. 51 | state =: pop__path '' 52 | depth =: depth - 1 53 | destroy__there'' }} 54 | 55 | append =: {{ append__here y }} 56 | extend =: {{ extend__here y }} 57 | result =: {{ result__main _ }} 58 | destroy=: {{ 59 | coerase here,path 60 | codestroy'' }} 61 | 62 | -------------------------------------------------------------------------------- /old/sx-by-hand.ijs: -------------------------------------------------------------------------------- 1 | NB. sx : s-expression parser 2 | require 'boxer.ijs' 3 | require 'cheq.ijs' NB. for unit tests at the end 4 | cocurrent'sx' 5 | 6 | NB. helpers for s-expression parser 7 | ord =: a. i. ] 8 | chr =: a. {~ ] 9 | between =: ( ([ >: {.@]) *. ([ <: {:@]) ) 10 | span =: ([ + [: i. >:@-~)/ 11 | chspan =: span&.ord L:0 12 | groups =: chspan cut ' '' ( ) 09 AZ ` az' 13 | 14 | NB. escape special characters in rx sets 15 | altesc =: ((];'\',])"0 '^[\]-')&stringreplace 16 | 17 | NB. m subst n y : replace leaves matching m with n in tree y 18 | subst =: {{ (]`(n"_))@.(-:m"_) L:0 }} 19 | 20 | NB. verb to classify x according to groups y: 21 | class =: (1 i.~e.S:0)"0 _ 22 | 23 | 24 | NB. sx text -> tree : a simple s-expression parser 25 | NB. --------------------------------------------------------- 26 | spaces =: a.{~ i.33 27 | syntax =:'()[]{}''`,@' 28 | others =: a.-.spaces,syntax,'"' 29 | digits =: chspan'09' 30 | 'LP RP LB RB LC RC Q QQ UQ AT'=: s:;/syntax NB. names for boxed tokens 31 | 32 | NB. (private) return next character from s and increment cp 33 | nxch =: {{ cp=:cp+1 if. cptok 77 | case. LP do. pushstate__bx 0 78 | case. RP do. popstate__bx'' 79 | case. do. append__bx tok 80 | end. 81 | end. 82 | (r=.result__bx'') [ destroy__bx'' 83 | catch. 84 | destroy__bx'' 85 | 'malformed s-expression' throw. 86 | end. 87 | else. r=.>a: end. 88 | r }} 89 | 90 | NB. dtw = delete trailing whitespace (like dtb, but with newlines, etc) 91 | dtw =: #~ ([: +./\. 32 < 3&u:) 92 | sx_z_ =: parse_sx_@dtw_sx_ 93 | 94 | 95 | NB. mini test suite 96 | a =: [: assert ] 97 | 98 | a a: = sx '' 99 | a (<1) = sx '1' 100 | a (1;2) = sx '1 2' 101 | 102 | NB.  fix memory leak here! 103 | {{ goterr=.0 try. sx ')...' catch. goterr=.1 end. 104 | a goterr }}'' 105 | 106 | NB. ok, now let''s parse a valid s-expression: 107 | cheq sx '1 ( 2(3 4 5 ) 6) 7' 108 | ┌─┬─────────────┬─┐ 109 | │1│┌─┬───────┬─┐│7│ 110 | │ ││2│┌─┬─┬─┐│6││ │ 111 | │ ││ ││3│4│5││ ││ │ 112 | │ ││ │└─┴─┴─┘│ ││ │ 113 | │ │└─┴───────┴─┘│ │ 114 | └─┴─────────────┴─┘ 115 | ) 116 | 117 | cheq sx' () (()) (() (())) ' 118 | ┌──┬────┬─────────┐ 119 | │┌┐│┌──┐│┌──┬────┐│ 120 | │││││┌┐│││┌┐│┌──┐││ 121 | │└┘│││││││││││┌┐│││ 122 | │ ││└┘│││└┘│││││││ 123 | │ │└──┘││ ││└┘│││ 124 | │ │ ││ │└──┘││ 125 | │ │ │└──┴────┘│ 126 | └──┴────┴─────────┘ 127 | ) 128 | -------------------------------------------------------------------------------- /ops.ijs: -------------------------------------------------------------------------------- 1 | 2 | NB. state accessors: 3 | 'ix ch tb nt na nb wk ib' =: i.#s0 4 | 5 | NB. accessor methods (combine with the names above: 'ix at state') 6 | at =: >@{ NB. fetch and unbox at index x from boxes y 7 | aa =: {{ (u&.(>@]) n{ y) n} y }} NB. apply u at ix n in array of boxes y 8 | 9 | 10 | S =: ib&at NB. retrieve the input string 11 | 12 | NB. nx :: state->state = move to next character (ch-:'' if past end) 13 | NB. x tk: s->(item; s (initial parser state) 16 | NB. everything is stored explicitly inside 17 | NB. the state tuple, to make it easy to backtrack. 18 | match =: {{ ( parse tree | error 21 | NB. applies rule u to (match y) and returns node buffer on success. 22 | parse =: {{ if.f['f s'=.u match y do. >nb{s else. ,.'parse failed';fs. always match, but consume nothing. 27 | NB. any: s->fs. matches one input item, unless out of bounds. 28 | NB. u neg: s->fs. invert match flag from u and restore everything else. 29 | NB. u end: s->fs. matches at end of input. 30 | NB. m chr: s->fs. match literal atom m and advance the index 31 | NB. m one: s->fs. match one item from m and advance the index. 32 | NB. m seq: s->fs. match each rule in sequence m 33 | NB. m alt: s->fs. try each rule in m until one matches. 34 | NB. m lit: s->fs like seq for literals only. 35 | NB. u ifu v: s->fs. invoke arbitrary function v on old/new states if u matches. 36 | NB. u tok: s->fs move current token to nb if u matches, else fail 37 | NB. m sym: s->fs alias for 'm lit tok' 38 | NB. u zap: s->fs match if u matches, but drop any generated nodes 39 | NB. u opt: s->fs. optionally match rule u. succeed either way 40 | NB. u rep: s->fs. match 1+ repetitions of u 41 | NB. u orp: s->fs. optionally repeat (match 0+ repetitions of u)}} 42 | NB. u not: s->fs. match anything but u. 43 | NB. u sep v: s->fs. match 1 or more u, separated by v 44 | 45 | NB. plain functions for tree building 46 | NB. --------------------------------- 47 | NB. x node: s->s. starts a new node in the parse tree with tag x 48 | NB. x emit: s->s push item x into the current node buffer 49 | NB. m attr n: s->fs. append (m=key;n=value) pair to the attribute dictionary. 50 | NB. done: s->s. closes current node and makes it an item of previous node-in progress. 51 | 52 | NB. combinators for tree building. 53 | NB. ------------------------------ 54 | NB. u elm n : s->fs. create node element tagged with n if u matches 55 | NB. u atr n : s->fs. if u matched, move last item to node attribute n. 56 | NB. u tag: s->fs. move the last token in node buffer to be the node's tag. 57 | 58 | NB. predefined character sets 59 | alpha =: a.{~ , (i.26) +/ a.i.'Aa' 60 | digit =: '0123456789' 61 | hexit =: digit,'AaBbCcDdEeFf' 62 | other =: (32}.127{.a.)-.alpha,digit 63 | paren =: '()' 64 | brack =: '[]' 65 | curly =: '{}' 66 | space =: 32{.a. NB. that's all ascii ctrl chars. 67 | 68 | NB. Some predefined tokens 69 | NL =: (CR lit opt)`(LF lit) seq 70 | ALPHA =: alpha one 71 | UNDER =: '_' lit 72 | DIGIT =: digit one 73 | NUMBER =: digit rep 74 | IDENT =: (ALPHA`(ALPHA`DIGIT`UNDER alt orp) seq) 75 | HEXIT =: hexit one 76 | LPAREN =: '(' lit 77 | RPAREN =: ')' lit 78 | LBRACK =: '[' lit 79 | RBRACK =: ']' lit 80 | LCURLY =: '{' lit 81 | RCURLY =: '}' lit 82 | WS =: (TAB,' ') one 83 | 84 | NB. generic line splitter 85 | lines =: {{ ,.> nb at s [ 'f s' =. (NL not rep) tok sep (NL zap) match y }} 86 | 87 | NB. tree matching 88 | NB. --------------------------------- 89 | NB. u all: s->fs. matchs if u matches the entire remaining input. 90 | NB. u box: s->fs. matches if current value is a box and u matches it entirely. 91 | -------------------------------------------------------------------------------- /parseco.ijs: -------------------------------------------------------------------------------- 1 | NB. ------------------------------------------------------------ 2 | NB. Parser Combinators for J 3 | NB. 4 | NB. The semantics here are heavily inspired by 5 | NB. Allesandro Warth's ometa system: 6 | NB. 7 | NB. http://tinlizzie.org/ometa/ 8 | NB. 9 | NB. but implemented as parser combinators rather than a standalone language. 10 | NB. 11 | NB. ------------------------------------------------------------ 12 | LICENSE =: (0 : 0) 13 | Copyright (c) 2021 Michal J Wallace 14 | 15 | Permission is hereby granted, free of charge, to any person obtaining a copy 16 | of this software and associated documentation files (the "Software"), to deal 17 | in the Software without restriction, including without limitation the rights 18 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 19 | copies of the Software, and to permit persons to whom the Software is 20 | furnished to do so, subject to the following conditions: 21 | 22 | The above copyright notice and this permission notice shall be included in all 23 | copies or substantial portions of the Software. 24 | 25 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 26 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 27 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 28 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 29 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 30 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 31 | SOFTWARE. 32 | ) 33 | 34 | 35 | NB. --- structs ------------------------------------------------ 36 | 37 | NB. sg =. m AT: constructor for setter/getter verbs (accessors). 38 | NB. (sg y) gets item m from struct y 39 | NB. (x sg y) returns copy of y with with m set to x 40 | AT =: {{ m&{:: : (<@[ m} ]) }} 41 | 42 | NB. m struct y : create verbs for struct with name m and fields y 43 | NB. m is quoted name, y is space-delimited names 44 | struct =: {{ 45 | NB. constructor for empty struct: 46 | ". m,'=: (a:#~',(":#fs),'"_) : (;:@',(quote y),')' [ fs =. cut y 47 | NB. accessors for each field: 48 | ({{ ". x,'=:',(":y),' AT' }}&>"0 i.@#) fs 49 | 0 0$0}} 50 | 51 | 52 | NB. --- tree state --------------------------------------------- 53 | 54 | NB. you can use whatever tree builder you like (by setting 55 | NB. the 'tb' field in the parse state to a different locale), 56 | NB. provided it implements the methods in the "tree builder 57 | NB. interface" section. 58 | 59 | NB. In order to support backtracking, the interface requires 60 | NB. that every method take and return a state memento. 61 | 62 | NB. For this default implementation, the the complete state 63 | NB. is just stored in the memento, and the trees built are 64 | NB. just nested boxes. 65 | 66 | NB. -- TS -- 67 | NB. nt = node tag 68 | NB. na = node attributes 69 | NB. nb = node buffer (grows as we build rules) 70 | NB. wk = work stack (grows with recursive descent) 71 | 'TS' struct 't_nt t_na t_nb t_wk' 72 | tna0 =: (0 2$a:) NB. initialize dictionary. used here and it 'node' 73 | ts0 =: tna0 t_na TS'' 74 | 75 | 76 | NB. --- parse state -------------------------------------------- 77 | 78 | NB. mb = match bit 79 | NB. ix = current index into the input 80 | NB. ch = current character, or '' after ix>#S 81 | NB. mk = mark (start of current token) 82 | NB. tb = tree builder 83 | NB. ts = tree state 84 | NB. ib = input buffer 85 | 'S' struct 'mb ix ch mk ib tb ts ib' 86 | 87 | NB. treebuilder defaults to this current namespace 88 | tb0 =: coname'' 89 | 90 | NB. s0 : S. initial parse state 91 | s0 =: 0 mb] 0 ix] ' 'ch] 0 mk] tb0 tb] ts0 ts] S'' 92 | 93 | 94 | NB. even simpler setters for match bit: 95 | I =: 1&mb 96 | O =: 0&mb 97 | 98 | NB. 'character buffer' (input from mk to ix) 99 | cb =: ib {~ mk + i.@(ix-mk) 100 | 101 | 102 | NB. -- "microcode" --------------------------------------------- 103 | 104 | NB. u AA v. s->s. apply u at v in y. (where v = (m AT)) 105 | AA =: {{ (u v y) v y }} 106 | 107 | NB. m AP v. s->s. append m to v=(buffer AT) in y 108 | AP =: {{ ,&m AA v y }} 109 | 110 | NB. nx :: state->state = move to next character (ch-:'' if past end) 111 | nx =: {{i ix (i{ ::'' ib y) ch (ix~ 1+ ix) y [ i=. 1+ix y }} 112 | nx =: {{i ix (i{ ::'' ib y) ch y [ i=. 1 + ix y }} 113 | 114 | NB. on: string -> s (initial parser state) 115 | NB. everything is stored explicitly inside 116 | NB. the state tuple, to make it easy to backtrack. 117 | on =: {{ ({.y) ch y ib s0 }} 118 | 119 | NB. state fw y (micro) : match y chars (where y is int >: 0) 120 | fw =: {{ (*y) mb nx^:y x }} 121 | 122 | NB. la : lookahead 123 | la =: ib@] {~ ix@] + i.@[ 124 | 125 | NB. x tk: s->(item;s. always match, but consume nothing. 132 | nil =: I 133 | 134 | NB. any: s->s. matches one input item, unless out of bounds. 135 | any =: {{ f mb nx^:f y [ f =. (#ib y)>ix y }} 136 | 137 | NB. u neg: s->s. invert match flag from u and restore everything else 138 | NB. from the original state after running u. This primitive allows 139 | NB. you to implement negative lookahead (or apply it twice to implement 140 | NB. positive lookahead without consuming). 141 | neg =: {{'neg'] y mb~ -. mb u y }} 142 | 143 | NB. u end: s->s. matches at end of input. 144 | end =: any neg 145 | 146 | NB. r try : s->s. generic error trap. mostly this handles 147 | NB. the case where we're reading past the end of the input. 148 | try =: :: O 149 | 150 | NB. m chr: s->s. match literal atom m and advance the index 151 | chr =: {{ y fw m -: ch y }} try 152 | 153 | NB. m chs s->s. match any one item from m and advance ix. ('choose'/'character set') 154 | chs =: {{ y fw m e.~ ch y }} try 155 | 156 | NB. m seq: s->s. match each rule in sequence m 157 | seq =: {{'seq'] s=:y 158 | for_r. m do. 159 | if. -.mb s=. r`:6 s do. O y return. end. 160 | end. I s }} 161 | 162 | NB. m alt: s->s. try each rule in m until one matches. 163 | NB. This is "Prioritized Choice" from PEG parsers. 164 | NB. It removes some ambiguity, but means you have to think 165 | NB. carefully about how to order your rules. For example, 166 | NB. if your language allows simple strings of letters to be 167 | NB. used as names but also reserves some strings of letters 168 | NB. as keywords, then you must specify the keywords first. 169 | alt =: {{'alt'] s=:y 170 | for_r. m do. 171 | if. mb s=. r`:6 s do. I s return. end. 172 | end. O y }} 173 | 174 | 175 | NB. -- extra utilities ----------------------------------------- 176 | 177 | NB. u opt: s->s. optionally match rule u. succeed either way 178 | opt =: I@: 179 | 180 | NB. m lit: s->s like seq for literals only. 181 | NB. this just matches the whole sequence directly vs S. 182 | NB. ,m is so we can match a single character. 183 | lit =: {{ y fw (#m) * m-: (#m=.,m) la y }} try 184 | 185 | NB. u rep: s->s. match 1+ repetitions of u 186 | rep =: {{ y (<&ix mb ]) u^:mb^:_ I y }} 187 | 188 | NB. u orp: s->s. optionally repeat (match 0+ repetitions of u)}} 189 | orp =: rep opt 190 | 191 | NB. u not: s->s. match anything but u. 192 | NB. fail if u matches or end of input, otherwise consume 1 input. 193 | not =: {{ (u neg)`any seq }} 194 | 195 | NB. u sep v: s->s. match 1 or more u, separated by v 196 | sep =: {{ u`(v`u seq orp) seq f. }} 197 | 198 | NB. -- lexers -------------------------------------------------- 199 | 200 | NB. !! this implementation makes no sense. 201 | NB. the token buffer only contains one token. 202 | NB. 203 | NB. u scan: string -> tokens | error 204 | NB. applies rule u to (on y) and returns token buffer on success. 205 | NB. scan =: {{ if.mb s=.u on y do. cb s else. ,.'scan failed';s. if u matches, return 1;<(s_old) v (s_new) 208 | ifu =: {{ f mb y v^:f s [ f=.mb s=.u y }} 209 | 210 | NB. u tok: s->s move current token to NB if u matches, else fail 211 | NB. (this is overridden later) 212 | NB. tok =: ifu({{ (ix mk (AP nb)~ cb) y }}@]) 213 | 214 | NB. m sym: s->s alias for 'm lit tok' 215 | NB. sym =: lit tok 216 | 217 | NB. u zap: s->s match if u matches, but drop any generated nodes 218 | NB. the only effect that persists is the current (ch,ix,mk). 219 | zap =: ifu(ix@] mk ch@] ch ix@] ix [) 220 | 221 | 222 | NB. -- parsers ------------------------------------------------- 223 | 224 | NB. u parse: string -> [node] | error 225 | NB. applies rule u to (on y) and returns node buffer on success. 226 | NB. note that the node buffer is a *list of boxes*, even if there 227 | NB. is only one top-level node. It's a forest, not a tree. 228 | parse =: {{ if.mb s=.u on y do. t_nb ts s else. ,.'parse failed'; ts: starts a new node in the tree with tag x 239 | NB. node =: {{ x nt a: ntup } ( ts: push item x into the current node buffer 243 | NB.emit =: {{ ( ts: set item x to be the head(tag) 247 | t_head =: {{ it t_nt s [ 'it s' =. t_nb tk y }} 248 | t_head =: {{ t_nt&>/(t_nb tk) y }} 249 | t_head =: [: t_nt&>/ (t_nb tk) 250 | 251 | NB. x t_attr ts -> ts. take last item and assign as attribute x 252 | t_attr =: {{ (x,&s. closes current node and makes it an item of previous node-in progress. 255 | NB. done =: {{ (ntup{y) emit (>old) ntup} s [ 'old s'=.wk tk y }} 256 | t_done =: {{ (t_ntup{y) t_emit (>old) t_ntup} s [ 'old s'=.t_wk tk y }} 257 | 258 | NB. m tbm1 s -> s. execute tree builder method m on the tree state 259 | tbm1 =: {{ y ts~ (m,'__t')~ ts y [ t =. tb y}} 260 | tbm2 =: {{ y ts~ x (m,'__t')~ ts y [ t =. tb y}} 261 | 262 | 263 | 264 | NB. combinators for tree building. 265 | NB. ------------------------------ 266 | NB. tok =: ifu {{ x] (ix y) mk (cb y) emit y }} 267 | tok =: ifu (ix@] mk cb@] 't_emit'tbm2 ]) 268 | sym =: lit tok 269 | 270 | NB. u elm n : s->s. create node element tagged with n if u matches 271 | NB.elm =: {{ 't_done'tbm1^:mb u n 't_node'tbm2 y }} 272 | elm =: {{ 273 | if.mb s=. u n 't_node'tbm2 y do.'t_done'tbm1 s 274 | else. O y end. }} 275 | 276 | NB. u atr n : s->s. if u matched, move last item to node attribute n. 277 | atr =: {{ if.mb s=. u y do. I n 't_attr'tbm2 s else. O y end. }} 278 | 279 | NB. u tag: s->s. move the last token in node buffer to be the node's tag. 280 | NB. helpful for rewriting infix notation, eg (a head(+) b) -> (+ (a b)) 281 | NB.tag =: {{'tag' if.mb s=. u y do. I it head s ['it s' =. nb tk s else. O y end. }} 282 | NB. tag =: ifu {{x] it head s ['it s' =. nb tk y }} NB.<- moved to head 283 | tag =: ifu('t_head'tbm1@]) 284 | 285 | 286 | NB. -- common lexers ------------------------------------------- 287 | 288 | NB. character sets 289 | alpha =: a.{~ , (i.26) +/ a.i.'Aa' 290 | digit =: '0123456789' 291 | hexit =: digit,'AaBbCcDdEeFf' 292 | other =: (32}.127{.a.)-.alpha,digit 293 | paren =: '()' 294 | brack =: '[]' 295 | curly =: '{}' 296 | space =: 32{.a. NB. that's all ascii ctrl chars. 297 | 298 | NB. Some predefined tokens 299 | NL =: (CR lit opt)`(LF lit) seq 300 | ALPHA =: alpha chs 301 | UNDER =: '_' lit 302 | DIGIT =: digit chs 303 | NUMBER =: digit rep 304 | IDENT =: (ALPHA`(ALPHA`DIGIT`UNDER alt orp) seq) 305 | HEXIT =: hexit chs 306 | LPAREN =: '(' lit 307 | RPAREN =: ')' lit 308 | LBRACK =: '[' lit 309 | RBRACK =: ']' lit 310 | LCURLY =: '{' lit 311 | RCURLY =: '}' lit 312 | WS =: (TAB,' ') chs 313 | WSz =: WS orp zap 314 | 315 | 316 | NB. generic line splitter 317 | lines =: {{ ,.> NB at s =. (NL not rep) tok sep (NL zap) on y }} 318 | 319 | 320 | NB. -- j lexer ------------------------------------------------- 321 | 322 | NB. fragments used by the tokens: 323 | j_op =: (brack,curly,other-.'_') chs 324 | j_num =: ('_' lit opt)`(DIGIT rep)`(('.'lit)`(DIGIT orp) seq opt) seq 325 | squo =: '''' 326 | squl =: squo lit 327 | j_esc =: (2#squo) lit 328 | 329 | NB. full tokens 330 | J_LDEF =: '{{'lit 331 | J_RDEF =: '}}'lit 332 | J_NB =: (('NB','.')lit)`(NL not rep) seq 333 | 334 | J_STR =: squl`(j_esc`(squl not) alt orp)`squl seq 335 | J_OPER =: (j_op`DIGIT`ALPHA alt)`('.:' chs rep) seq 336 | J_OP =: j_op 337 | J_NUMS =: j_num`('j'lit`j_num seq opt)seq sep (WS rep) 338 | J_TOKEN =: NL`J_LDEF`J_RDEF`LPAREN`RPAREN`J_NB`J_STR`J_OPER`J_NUMS`J_OP`IDENT alt 339 | J_LEXER =: (WS zap)`(J_TOKEN tok) alt orp 340 | 341 | J_STR on h=.'''hello'',abc' 342 | 343 | NB. c-style strings/numbers 344 | STR_ESC =: ('\'lit)`any seq 345 | DQ =: '"'lit 346 | STR =: DQ`(STR_ESC`(DQ not) alt orp)`DQ seq tok 347 | INT =: DIGIT rep tok 348 | 349 | 350 | NB. -- parser examples ----------------------------------------- 351 | 352 | NB. simple pascal -like block 353 | BEGIN =: 'begin' sym 354 | END =: 'end' sym 355 | nends =: END not orp tok 356 | block =: (BEGIN`nends`END) seq 357 | block on 'begin hello; 2+2; end' 358 | 359 | TRACE =: 0 360 | NB. m trace v: s->st. provides a trace of parse rule v if TRACE~:0 361 | trace =: {{ 362 | if. TRACE do. r [ smoutput m; r=.v Y=:y [ smoutput '>> ',m 363 | else. v y end. }} 364 | 365 | NB. s-expressions (lisp-like syntax) 366 | LP =: 'LP' trace (LPAREN zap) 367 | RP =: 'RP' trace (RPAREN zap) 368 | ID =: 'ID' trace (LP`RP`WS`DQ alt not rep tok) 369 | 370 | NB. se: s-expression parser 371 | se_a =: ID`STR`INT alt NB. just the atoms 372 | se_p =: 'se' trace (WSz`LP`((se_a tag opt)`se_s seq)`RP seq elm '' sep WSz) 373 | se_s =: se_p`se_a`WSz alt orp 374 | se =: end`se_s alt 375 | 376 | NB.se_p =: LP`((se_a tag opt)`(WSz`se_p`se_a alt orp)seq)`RP seq elm '' 377 | NB.se =: (WSz`end seq)`(se_p`se_a alt sep WSz) alt 378 | 379 | NB. ll: lisp lexer 380 | ll =: WSz`((LPAREN tok)`(RPAREN tok)`WS`ID`(STR tok) alt)seq orp 381 | 382 | 383 | NB. -- tree matching ------------------------------------------- 384 | 385 | NB. u all: s->s. matches if u matches the entire remaining input. 386 | all =: {{ (u f.)`end seq }} 387 | 388 | NB. u box: s->s. matches if current value is 389 | box =: {{ 390 | if. 32 = 3!:0 c =. ch y 391 | do. smoutput 'entering box C:' [ C =: > c 392 | smoutput c 393 | f mb nx^:f s [f=.mb s=.u all on > c else. O y end. }} 394 | 395 | 396 | NB. -- test suite ---------------------------------------------- 397 | 398 | T =: [:`]@.mb NB. T = assert match 399 | F =: ]`[:@.mb NB. F = assert doesn't match 400 | 401 | T any on 'hello' 402 | F any neg on 'hello' 403 | T any neg on '' 404 | T end on '' 405 | F end on 'x' 406 | F 'a' chr on 'xyz' 407 | T 'a' chr on 'abc' 408 | T 'abc' chs on 'cab' 409 | F 'abc' chs on 'xyz' 410 | T ('a'chr)`('b'chr)`('c'chr) seq on 'abc' 411 | F ('a'chr)`('b'chr)`('c'chr) alt on 'xyz' 412 | T ('a'chr)`('b'chr)`('c'chr) alt on 'abc' 413 | T 'ab' lit on 'abc' 414 | 415 | T 'ab' lit tok on 'abc' 416 | 417 | T 'ab' sym on 'abc' 418 | T '3' lit opt on '1' 419 | T '3' lit opt on '3' 420 | T 'a'lit`('b'lit opt)`('c'lit) seq on 'abc' 421 | T 'a'lit`('b'lit opt)`('c'lit) seq on 'acb' 422 | 423 | T ('a'lit rep) on 'aab' 424 | F ('a'lit rep) on 'bba' 425 | T ('a'lit rep)`('b'lit) seq on 'aaab' 426 | 427 | T 'x' lit not on 'a' 428 | 429 | jsrc =. 0 : 0 430 | avg =: +/ % # NB. average is sum div len 431 | avg +/\>:i.10 NB. average of first 10 triangle nums (22) 432 | name =. 'Sally O''Malley' 433 | ) 434 | 435 | [ expect =: (;:jsrc) 436 | [ actual =: J_LEXER parse jsrc 437 | assert expect -: actual 438 | 439 | aa=:ALPHA`ALPHA seq tok 440 | actual =: (('abc'lit tok)`(aa atr 'a0')`(aa atr 'a1')seq elm'n' parse 'abcdefg') 441 | expect =: ,<(<'n'),(<2 2$(<'a0'),(<<'de'),(<'a1'),<<'fg'),<,<'abc' 442 | 'atr atr elm' assert expect -: actual 443 | 444 | actual =: aa tag`aa`aa seq elm'' parse'banana' 445 | expect =: ,<(<<'ba'),( [result] : apply u to each node of the tree. 482 | t_visit =: {{ (u y),, u t_visit every (#~ (<'boxed')=datatype each) t_nb y }} 483 | assert (;:'a b d g') -: t_nt t_visit ts se on'(a (b c (d e) f (g h))))' 484 | 485 | 486 | NB. -- decompiler ---------------------------------------------- 487 | cocurrent 'decompile' 488 | ar =: 5!:1@< 489 | br =: 5!:2@< 490 | tr =: 5!:4@< 491 | ops =: ;:'nil any lit chs seq alt tok sym zap opt rep orp not sep elm atr tag' 492 | all =: ops,;:'try ifu' 493 | ALL =: toupper each all 494 | (ALL) =: br each all 495 | -------------------------------------------------------------------------------- /pl0/build-pas: -------------------------------------------------------------------------------- 1 | # fpc is https://www.freepascal.org/ 2 | # ~/x is https://github.com/tangentstorm/xpl 3 | 4 | fpc -Fu~/x/code -Fi~/x/code pl0syntax.pas 5 | -------------------------------------------------------------------------------- /pl0/load-pl0.ijs: -------------------------------------------------------------------------------- 1 | NB. load pl0.sx into jfdag repo. 2 | 3 | load 'tangentstorm/j-kvm/vt' 4 | load '../parseco.ijs ../jfdag.ijs' 5 | coinsert 'vt' 6 | 7 | is_node =: (3=#) *. 'boxed'-:datatype 8 | 9 | import_tree =: {{ 10 | nid =. x jfc >t_nt y 11 | for_box. t_nb y do. 12 | item =. >box 13 | if. is_node item do. nid import_tree item 14 | else. nid jfc item end. 15 | end. 16 | nid}} 17 | 18 | 19 | pl0 =: JF_LANGS import_tree 'pl0' t_nt 3{.ts se on CRLF -.~ freads'pl0.sx' 20 | -------------------------------------------------------------------------------- /pl0/pl0.sx: -------------------------------------------------------------------------------- 1 | (:grammar PL0) 2 | (:nb "from Algorithms and Data Structures by Niklaus Wirth.") 3 | 4 | (:def program (:seq (:ref block) (:lit "."))) 5 | (:def block 6 | (:seq (:opt (:seq (:lit "const") 7 | (:sep (:seq (:ref IDENT) 8 | (:lit "=") 9 | (:ref NUMBER)) 10 | (:lit ",")) 11 | (:lit ";"))) 12 | (:opt (:seq (:lit "var") 13 | (:sep (:ref IDENT) (:lit ",")) 14 | (:lit ";"))) 15 | (:opt (:seq (:lit "procedure") 16 | (:ref IDENT) 17 | (:lit";") 18 | (:ref block) 19 | (:lit ";"))) 20 | (:ref statement))) 21 | 22 | (:def statement 23 | (:alt (:seq (:ref IDENT) (:lit ":=") (:ref expression)) 24 | (:seq (:lit "call") (:ref IDENT)) 25 | (:seq (:lit "begin") 26 | (:ref statement) 27 | (:orp (:seq (:lit ";") (:ref statement))) 28 | (:lit "end")) 29 | (:seq (:lit "if") 30 | (:ref condition) 31 | (:lit "do") 32 | (:ref statement)) 33 | (:nil (:nb empty statement)))) 34 | 35 | (:def condition 36 | (:alt (:seq (:lit "odd") 37 | (:ref expression)) 38 | (:seq (:ref expression) 39 | (:alt (:lit "=") (:lit "≠") 40 | (:lit "<") (:lit ">") 41 | (:lit "≤") (:lit "≥")) 42 | (:ref expression)))) 43 | 44 | (:def expression (:seq (:ref term) 45 | (:orp (:seq (:alt (:lit "+") (:lit "-")) 46 | (:ref term))))) 47 | 48 | (:def term (:seq (:ref factor) 49 | (:orp (:seq (:alt (:lit "×") (:lit "÷")) 50 | (:ref factor))))) 51 | 52 | (:def factor (:alt (:ref IDENT) 53 | (:ref NUMBER) 54 | (:seq (:lit "(") 55 | (:ref expression) 56 | (:lit ")")))) 57 | -------------------------------------------------------------------------------- /pl0/pl0syntax.ijs: -------------------------------------------------------------------------------- 1 | NB. hand-written pretty printer for pl0.sx 2 | load'../parseco.ijs' 3 | load'tangentstorm/j-kvm/vt' 4 | load'tangentstorm/j-kvm/cw' 5 | coinsert'cw' 6 | coinsert'vt' 7 | 8 | dumps =: {{ 5!:6<'y'}} 9 | 10 | 11 | is_node =: (3=#) *. 'boxed'-:datatype 12 | 13 | pl0 =: ':sx' t_nt 3{.ts se on CRLF -.~ freads'pl0.sx' 14 | 15 | cw =: puts 16 | dbg 1 17 | is_node =: (3=#) *. 'boxed'-:datatype 18 | is_rule =: (~:toupper)@{. 19 | draw =: {{ 20 | if. -. is_node y do. y=.>y end. 21 | if. -. is_node y do. fg'K' 22 | BAD =: y 23 | puts '%[',":>y 24 | puts ']' 25 | 'bad node' throw. 26 | return. 27 | end. 28 | assert is_node y 29 | select. nt=.>t_nt y 30 | case. ':sx' do. 31 | for_child. t_nb y do. draw child end. 32 | case. ':grammar' do. cw 'grammar ',(;2{::y),CRLF 33 | case. ':nb' do. 34 | fg'K' 35 | cw (;t_nb y),CRLF 36 | case. ':ref' do. 37 | nm =. ;t_nb y 38 | if. is_rule nm do. fg'w' else. fg 'B' end. 39 | cw nm 40 | case. ':lit' do. 41 | fg'g' 42 | cw (;t_nb y) 43 | case. ':nil' do. 44 | fg'K' 45 | cw '""' 46 | case. ':def' do. 47 | fg'W' 48 | cw (;0{::t_nb y) 49 | fg'K' 50 | cw ': ',CRLF,' ' 51 | for_child. >}.t_nb y do. 52 | draw child 53 | end. 54 | cw CRLF 55 | fcase. ':rep' do. 56 | fcase. ':opt' do. 57 | case. ':orp' do. s=.'?*+'{~ nt (i."_~) _4[\':opt:orp:rep' 58 | fg'K' 59 | cw'(' 60 | for_child. ,t_nb y do. draw child end. 61 | fg'K' 62 | cw')',s 63 | case. ':seq' do. 64 | for_child. t_nb y do. draw child end. 65 | case. ':sep' do. 66 | nb =. t_nb y 67 | assert (#nb)=2 68 | draw 0{nb 69 | fg 'r' 70 | cw '/' 71 | draw 1{nb 72 | case. ':alt' do. 73 | fg'K' 74 | cw'(' 75 | for_child. t_nb y do. 76 | if. child_index > 0 do. 77 | fg 'K' 78 | cw '|' 79 | end. 80 | draw child 81 | end. 82 | fg'K' 83 | cw')' 84 | case. do. NB. unhandled 85 | fg'r' 86 | cw 'unknown: ' 87 | fg 'R' 88 | cw >t_nt y 89 | end.}} 90 | 91 | 92 | draw pl0 93 | cw fg'w' 94 | -------------------------------------------------------------------------------- /pl0/pl0syntax.pas: -------------------------------------------------------------------------------- 1 | { drastic: direct representation of abstract syntax trees } 2 | {$mode delphiunicode}{$i xpc.inc} 3 | program drastic; 4 | uses xpc, kvm, cw, variants, uvar, sysutils; 5 | 6 | // type uvar.TVar = variant, TVars = array of variant; 7 | // function uvar.A( {open} array of TVar) : TVars { array constructor } 8 | 9 | 10 | {-- data constructors -----------------------------------------} 11 | 12 | type 13 | TKind = ( 14 | kNB, { nota bene (comment) } 15 | kNL, kHBox, kVBox, { newline and horizontal/vertical formatting } 16 | kLit, kNul, kSeq, { empty pattern, literals, and sequences } 17 | kAlt, kOpt, { alternatives and optional } 18 | kRep, kOrp, { repeat and optional repeat } 19 | kDef, kSub { define and use named patterns } 20 | ); 21 | 22 | const nl = kNL; 23 | 24 | function nb (s : TStr) : TVar; begin result := A([kNB, s]) end; 25 | function lit(s : TStr) : TVar; begin result := A([kLit, s]) end; 26 | function sub(s : TStr) : TVar; begin result := A([kSub, s]) end; 27 | 28 | {$define combinator := (vars : array of TVar):TVar; begin result:= } 29 | function seq combinator A([kSeq, A(vars)]) end; 30 | function alt combinator A([kAlt, A(vars)]) end; 31 | function opt combinator A([kOpt, A(vars)]) end; 32 | function rep combinator A([kRep, A(vars)]) end; 33 | function orp combinator A([kOrp, A(vars)]) end; 34 | function hbox combinator A([kHBox, A(vars)]) end; 35 | 36 | function def(iden : TStr; alts : array of TVar) : TVar; 37 | begin result := A([kDef, iden, A(alts)]) 38 | end; 39 | 40 | 41 | 42 | {-- recursive show for variants -------------------------------} 43 | 44 | procedure VarShow(v : TVar); 45 | var i : cardinal; item : TVar; debug:boolean=false; 46 | begin 47 | if v = NULL then ok 48 | else if VarIsStr(v) then cwrite(v) 49 | else if VarIsArray(v) then 50 | if VarIsStr(v[0]) or varIsArray(v[0]) then 51 | //  TODO: ignore spaces if last item was kNB (to fix seq) 52 | for i:=0 to len(v)-1 do VarShow(v[i]) 53 | else if varIsOrdinal(v[0]) then try 54 | case TKind(v[0]) of 55 | kNB : cwrite([ '|K', TStr(v[1])]); 56 | kHBox : varshow(A([ join(nl, v[1]) ])); 57 | kLit : cwrite([ '|B', TStr( v[1]) ]); 58 | kSub : cwrite([ '|m', TStr( v[1]) ]); 59 | kOpt : varshow(A([ '|r( ', join(' ', v[1]), ' |r)?' ])); 60 | kRep : varshow(A([ '|r( ', join(' ', v[1]), ' |r)+' ])); 61 | kOrp : varshow(A([ '|r( ', join(' ', v[1]), ' |r)*' ])); 62 | kAlt : varshow(A([ '|r( ', join(' |r|| ', v[1]), ' |r)' ])); 63 | kSeq : varshow(A([ '|>', join(' ', v[1]), '|<' ])); 64 | kDef : VarShow(A(['|R@|y ', v[1], '|_|R: ', 65 | join('|_|r|| ' , v[2]), nl ])); 66 | else cwrite('|!r|y'); write('<', TKind(v[0]), '>'); cwrite('|w|!k'); 67 | end 68 | except on e:EVariantError do 69 | begin debug:=true; 70 | fg('r');writeln(e.message);fg('w'); 71 | cwriteln(['|c', repr(v), '|w']); 72 | end 73 | end // try..except 74 | else begin writeln('unhandled v[0] case:', repr(v[0])); halt end 75 | else if TKind(v) = kNL then cwrite('|_') // newline but with indentation 76 | else begin writeln('unhandled case:', repr(v)); halt end; 77 | if debug then begin 78 | writeln('vartype:', vartype(v), 'isArray:', VarIsArray(v)); 79 | write('empty?: ', VarIsEmpty(v)); writeln(' null?:', VarIsNull(v)); 80 | writeln('rank:',VarArrayDimCount(v)); 81 | writeln('high:',varArrayHighBound(v, 1)); 82 | for i:=0 to varArrayHighBound(v,1) do varshow(varArrayGet(v,[i])) 83 | end 84 | end; 85 | 86 | 87 | function KindStr(k : TKind):TStr; begin result:=''; write(result, k) end; 88 | function ToSymEx(v : TVar) : TStr; { render as s-expression } 89 | var i:cardinal; 90 | procedure Wr(s:TStr); begin result := result + s; writeln(result) end; 91 | procedure Ls(v:TVars);begin result := '('+TStr(implode(' ',v))+')' end; 92 | begin result:=''; 93 | if VarIsStr(v) then WriteStr(result, '"', v, '"') 94 | else if VarIsArray(v) then begin 95 | Wr('('); 96 | try Wr(KindStr(TKind(v[0]))) 97 | except on e:EVariantError do result += ToSymEx(v[0]) end; 98 | if Length(v) > 1 then for i:=1 to Length(v)-1 do Wr(' '+ToSymEx(v[i])); 99 | Wr(')'); 100 | end else Wr('!'); 101 | end; 102 | 103 | 104 | {-- main : shows pretty grammar for PL/0 in color --------------} 105 | 106 | var grammar : TVar; 107 | begin 108 | clrscr; 109 | grammar := hbox([ 110 | '|wPL/0 syntax', 111 | nb('from Algorithms and Data Structures by Niklaus Wirth.'), 112 | def('program', [ 113 | seq([ sub('block'), lit('.') ]) ]), 114 | 115 | def('block', [ seq([ 116 | hbox([ 117 | opt([ lit('const'), 118 | rep([ sub('ident'), lit('='), sub('number'), '|r/', lit(',') ]), 119 | lit(';') ]), 120 | opt([ lit('var'), rep([ sub('ident'), '|r/', lit(',') ]), lit(';') ]), 121 | orp([ lit('procedure'), sub('ident'), lit(';'), 122 | sub('block'), lit(';') ]), 123 | sub('statement') ]) ]) ]), 124 | 125 | def('statement', [ 126 | seq([ sub('ident'), lit(':='), sub('expression') ]), 127 | seq([ lit('call'), sub('ident') ]), 128 | seq([ lit('begin'), 129 | sub('statement'), 130 | orp([ lit(';'), sub('statement')]), 131 | lit('end') ]), 132 | seq([ lit('if'), sub('condition'), lit('then'), sub('statement') ]), 133 | seq([ lit('while'), sub('condition'), lit('do'), sub('statement') ]), 134 | nb('empty statement') ]), 135 | 136 | def( 'condition', [ 137 | seq([ lit('odd'), sub('expression') ]), 138 | seq([ sub('expression'), 139 | alt([ lit('='), lit('≠'), 140 | lit('<'), lit('>'), 141 | lit('≤'), lit('≥') ]), 142 | sub('expression') ]) ]), 143 | 144 | def('expression', [ 145 | seq([ alt([ lit('+'), lit('-') ]), 146 | sub('term'), 147 | orp([ alt([ lit('+'), lit('-') ]), 148 | sub('term') ]) ]) ]), 149 | 150 | def('term', [ 151 | seq([ sub('factor'), 152 | orp([ alt([ lit('×'), lit('÷') ]), 153 | sub('factor') ]) ]) ]), 154 | 155 | def('factor', [ 156 | sub('ident'), 157 | sub('number'), 158 | seq([ lit('('), sub('expression'), lit(')') ]) ]), 159 | '|w' ]); 160 | VarShow(grammar); 161 | end. 162 | -------------------------------------------------------------------------------- /prex.ijs: -------------------------------------------------------------------------------- 1 | NB. this file designs a nice syntax for 2 | NB. parsing and regular expressions. 3 | load'parseco.ijs' 4 | 5 | boxes =: {{ (x=#y) *. 'boxed'-:datatype y }} 6 | NB. no_attrs requires top level is an 'elm' 7 | NB. !!why does this need <@t_nt, but only t_nt in sx.ijs? 8 | no_attrs =: {{ 9 | if. 3 boxes y do. 10 | (<@t_nt , [: no_attrs each t_nb) y 11 | else. y end. }} 12 | 13 | 14 | NB. parser combinators for regular expressions 15 | rx_lit =: ALPHA rep tok elm'lit' 16 | rx_chs =: LBRACK`(ALPHA rep)`RBRACK seq elm'chs' 17 | 18 | NB. rx_mod =: (nil elm'mod')`('?+*'chs tok tag) seq 19 | rx_grp =: LP`rx_alt`RP seq elm'grp' 20 | rx_trm =: rx_lit`rx_chs`rx_grp alt 21 | rx_opt =: rx_trm`('?'lit zap) seq elm'opt' 22 | rx_rep =: rx_trm`('+'lit zap) seq elm'rep' 23 | rx_orp =: rx_trm`('*'lit zap) seq elm'orp' 24 | rx_seq =: rx_opt`rx_rep`rx_orp`rx_trm alt rep elm'seq' 25 | rx_alt =: rx_seq`('|'lit zap`rx_seq seq orp) seq elm'alt' 26 | rx0 =: rx_alt`end seq elm'rx' 27 | 28 | T rx0 on 'a' 29 | T rx0 on '[ab]' 30 | T rx0 on 'ab+' 31 | T rx0 on 'a*b|b?c+' 32 | T rx0 on 'a|b|c' 33 | T rx0 on '(a|b)+' 34 | 35 | simp =: {{ NB. simplify rx parse tree 36 | if. -. 'boxed'-:datatype y do. y return. end. 37 | h=.{.y [ t=.}.y 38 | if. h e. ;:'alt seq grp trm' do. 39 | NB. eliminate these nodes if only one element 40 | if.1=#t do. simp 0{::t return. end. 41 | end. 42 | h,simp each t }} 43 | 44 | noa =: [: no_attrs 0{:: t_nb@ts 45 | rx1 =: noa @ rx0 @ on 46 | rx2 =: simp @ rx1 47 | rx =: rx2 48 | 49 | encs =: 1|.')(',] 50 | gers =: '`' joinstring (encs each) 51 | jsrc =: {{ NB. jsrc rx pattern -> j source 52 | h=.{.y [ t=.}.y 53 | select. h 54 | case. 'rx' do. jsrc 0{::t 55 | case. 'alt' do. (gers jsrc&.> t),' alt' 56 | case. 'seq' do. (gers jsrc&.> t),' seq' 57 | case. 'lit' do. (quote@;t),' lit' 58 | case. 'chs' do. (quote@;t),' chs' 59 | case. 'opt' do. (jsrc 0{::t),' opt' 60 | case. 'rep' do. (jsrc 0{::t),' rep' 61 | case. 'orp' do. (jsrc 0{::t),' orp' 62 | case. do. ,":y return. 63 | end. }} 64 | -------------------------------------------------------------------------------- /proofed.ijs: -------------------------------------------------------------------------------- 1 | require 'tangentstorm/j-kvm' 2 | require 'sx.ijs dict.ijs unify.ijs stype.ijs' 3 | coinsert 'vt' 4 | 5 | NB. G holds the grammar 6 | G=:emptyd 7 | 8 | NB. defrule name (text) defines a new rule. 9 | NB. format is: (node template) (patterns) (text template) 10 | defrule=: {{ G =: (y S) put (< sx (0 : 0)) G }} 11 | 12 | NB. (rule 'name') fetches the rule from the system as a triple 13 | rule =: {{ ,> G get key y }} 14 | 15 | NB. special formatting symbols: 16 | 'SYM_NL SYM_SP'=:key'\n _' 17 | 18 | NB. grammar for a PL0-like language 19 | 20 | defrule 'program' 21 | ($name $imps $decs $body) 22 | (iden imports? decl* block) 23 | ("program" _ $name ";" \n 24 | $imps 25 | $decs \n 26 | $body ".") 27 | ) 28 | 29 | defrule 'imports' 30 | ($mods) 31 | (iden*) 32 | ("import" _ ";" \n) 33 | ) 34 | 35 | defrule 'writeln' 36 | ($args) 37 | (expr*) 38 | ("WriteLn(" $args / "," ")") 39 | ) 40 | 41 | defrule 'str' 42 | ($s) ($s) ("\"" $s "\"") 43 | ) 44 | 45 | 46 | 47 | head =: ,@>@{.@, 48 | tail =: }.@, 49 | 50 | NB. render nodes, colored according to datatype 51 | render =: RESET,~visit 52 | NB. visit :: [box] -> string 53 | visit =: ;@:(visit_box&.>) 54 | NB. visit_box :: contents -> string 55 | visit_box =: {{ 56 | select. stype y 57 | case. BOX do. 58 | if. 1 do. visit y NB. if. #y=1 59 | else. 60 | NB. !! todo: this part does not return a string yet. 61 | 'nm r t' =: ,>G get (head y) 62 | ((;nm) dict tail y) subs t 63 | end. 64 | case. TXT do. (FGC _15),y NB. fg'W' 65 | case. NUM do. (FGC _14),":y NB. fg'Y' 66 | case. SYM do. 67 | select. y 68 | case. SYM_NL do. LF 69 | case. SYM_SP do. ' ' 70 | case. do. (FGC _6), 2 s:y NB. sym→str !! fg'c' 71 | end. 72 | case. do. 73 | if. #y do. (FGC _1),":y else. '' end. 74 | end. }} 75 | 76 | NB. an example program 77 | p0 =: 0 : 0 78 | (program hello ( ) ( ) 79 | (block (writeln (str "hello, world.")) )) 80 | ) 81 | 82 | NB. sx y -> list of boxes 83 | NB. each boxs contains one of: 84 | NB. - a symbol 85 | NB. - a string 86 | NB. - a list of boxes 87 | echo render sx p0 88 | 89 | require 'parseco.ijs' 90 | -------------------------------------------------------------------------------- /rel.ijs: -------------------------------------------------------------------------------- 1 | coinsert 'rel' NB. make next section available in base locale. 2 | 3 | NB. ============================================================ 4 | NB. -- relational calculus ------------------------------------- 5 | NB. ============================================================ 6 | cocurrent 'rel' 7 | 8 | NB. helper for tests 9 | is =: dyad : 0 10 | NB. 5!:5 = linear representation of an object 11 | if. -. x -: y do. echo (5!:5<'x'),' ~: ',(5!:5<'y') end. x -: y 12 | ) 13 | 14 | NB. tl makes a function total (defined for all domains) 15 | tl =: :: ] 16 | 17 | NB. some test relations (rows separated by ';') 18 | r1 =: > 0 1 ; 0 2 ; 1 3 ; 2 4 19 | r2 =: > 0 1 11 ; 0 2 22 ; 1 3 33 ; 2 4 44 20 | r3 =: > 0 1 11 111; 0 2 22 222; 1 3 33 333; 2 4 44 444 21 | 22 | 23 | NB. ------------------------------------------------------------ 24 | NB. R ap y : apply dyadic relation R to y 25 | NB. x R ap y : same, but treat n-ary R as dyadic with split at x 26 | NB. ------------------------------------------------------------ 27 | ap =: adverb : 0 28 | }."1 m #~ y ="1 {."1 m 29 | : 30 | x }."1 m #~ y -:"1 x {."1 m 31 | ) 32 | assert (,. 1 2 ) is r1 ap 0 NB. two-row result for key=0 33 | assert (,. 3 ) is r1 ap 1 NB. one-row result for key=1 34 | assert (0 1 $ _) is r1 ap 9 NB. no results for key=9 35 | 36 | NB. dyadic case should let us specify the size of the key 37 | assert (,. 11) is 2 r2 ap 0 1 38 | assert (,: 11 111) is 2 r3 ap 0 1 39 | assert (,. 111) is 3 r3 ap 0 1 11 40 | 41 | NB. inverse of a binary relation (reverses the direction) 42 | iv =: ( |."_1 ) : ( -@[ |."1 ] ) 43 | assert ( r1) is (> 0 1 ; 0 2 ; 1 3 ; 2 4) 44 | assert ( iv r1) is (> 1 0 ; 2 0 ; 3 1 ; 4 2 ) 45 | assert (1 iv r1) is (> 1 0 ; 2 0 ; 3 1 ; 4 2 ) 46 | 47 | r2 =: > 0 1 11 ; 0 2 22 ; 1 3 33 ; 2 4 44 48 | assert ( r2) is (> 0 1 11; 0 2 22; 1 3 33; 2 4 44) 49 | assert (2 iv r2) is (> 1 11 0; 2 22 0; 3 33 1; 4 44 2) 50 | 51 | 52 | NB. ------------------------------------------------------------ 53 | NB. R ai y : apply inverse of binary relation R to y 54 | NB. x R ai y : same, but treat n-ary R as binary with split at x 55 | NB. ------------------------------------------------------------ 56 | ai =: adverb : 0 57 | ((iv m) ap) :. (m ap) y 58 | : 59 | x (((x iv m) ap) :. (m ap)) y 60 | ) 61 | 62 | 63 | r4 =: > 0 1 11 ; 0 2 22 ; 1 2 22 64 | assert (,. 1 11 ,: 2 22) is r4 ap 0 NB. nothing new here. 65 | assert ( ,: 2 22) is r4 ap 1 66 | NB. monadic case: ( a | b c ) 67 | assert (,. 0) is 2 r4 ai 1 11 NB. but ac maps value to key 68 | 69 | 70 | NB. dyadic case: ( a b | c ) (when x = 2) 71 | assert (,. 0) is 2 r4 ai 1 11 NB. but ac maps value to key 72 | assert (,. 0 1) is 2 r4 ai 2 22 NB. (or to multiple keys) 73 | 74 | 75 | NB. ============================================================ 76 | NB. relation class 77 | NB. ============================================================ 78 | coclass 'Rel' 79 | coinsert 'relwords' 80 | typeSyms =: s:;: 'int bit nid sym str chr box' 81 | 82 | sym2lit =: 4 s: ] 83 | findsplit =: [: -: @: I. (s:<'|') = ] 84 | assert 0 = findsplit s: ;: 'a:int b:int c:int' 85 | assert 1 = findsplit s: ;: 'a:int | b:int c:int' 86 | assert 2 = findsplit s: ;: 'a:int b:int | c:int' 87 | 88 | create =: monad : 0 89 | NB. example: 'sub:int rel:int obj:int' conew 'Rel' 90 | y =. (' '"_)^:(':'=])"0 y NB. discard ':' chars 91 | sp =: findsplit toks =. s: ;: y 92 | 'keys doms' =: |: _2 ]\ toks -. s:<'|' 93 | for_i. i. # keys do. 94 | n =. i { keys 95 | k =. i { doms 96 | if. -. k e. typeSyms do. 97 | echo 'unknown type:', sym2lit k 98 | throw. 99 | elseif. -. '[[:alpha:]][_[:alnum:]]*' rxeq sym2lit n do. 100 | echo 'invalid name:', sym2lit n 101 | throw. 102 | elseif. 1 do. 103 | NB. TODO... 104 | end. 105 | end. 106 | nk =: #keys 107 | ek =: sp & {."1 NB. extract key columns (from arg or data)) 108 | ev =: sp & }."1 NB. extract val columns (from data) 109 | ke =: (nk-sp) & {."1 NB. extract inverted key (from arg) 110 | data =: }: ,: i. nk NB. init empty relation as 0*nkeys array 111 | ) 112 | 113 | 114 | NB. relation verbs 115 | 116 | NB. apply relation to arguments to fetch data by key: 117 | rel=: (verb : 'data') 118 | get=: ev@rel #~ (ek@rel) -:"1 ek 119 | ap =: get`rel@.(''-:]) 120 | 121 | NB. inverse relation (fetch key by val) 122 | ler=: (verb : '(ev,.ek) data') 123 | teg=: ek@rel #~ (ev@rel) -:"1 ke NB. 124 | iv =: teg`ler@.(''-:]) 125 | 126 | NB. insert data into the table 127 | ins=: (verb : 'data =: ~. data, y') $~0: 128 | 129 | 130 | NB. ============================================================ 131 | NB. -- syntax directed editor -------------------------------- 132 | NB. ============================================================ 133 | NB. based on "a relational program for a syntax directed editor" 134 | NB. by B.J. MacLennan|https://github.com/tangentstorm/maclennan/ 135 | cocurrent 'base' 136 | Rel =: conew & 'Rel' 137 | 138 | NB. -- the syntax tree ----------------------------------------- 139 | tree =: Rel 'node:nid | ord:int child:nid' NB. connections 140 | udfn =: Rel 'node:nid | nont:sym' NB. undefined nodes 141 | defn =: Rel 'node:nid | nont:sym altk:chr' NB. defined nodes 142 | 143 | alts =: Rel 'nont:sym altk:chr | rule:int' 144 | forw =: Rel 'src:sym | dst:sym' NB. chain alt rules 145 | 146 | 147 | dict =: Rel 'nont:sym | path:box' 148 | rule =: Rel 'asys:int ssys:int dict:int' 149 | NB. asys =. Rel '' (term | nont)^2 // sequences of non-terminals 150 | NB. ssys =. Rel '' (node | node*int) -> (node|nont|nont*altk) 151 | 152 | 153 | NB. --- editor functions --------------------------------------- 154 | 155 | lang_ind =: 0 : 0 156 | key:int cmd:int 157 | up cmd_prev 158 | dn cmd_next 159 | n cmd_succ 160 | h cmd_pred 161 | rt cmd_in 162 | lf cmd_out 163 | g cmd_get 164 | p cmd_put 165 | d cmd_del 166 | u cmd_undel 167 | ) 168 | 169 | lang_dep =: 0 : 0 170 | key:int cmd:int 171 | ) 172 | 173 | process =: lang_ind , lang_dep 174 | 175 | 176 | 177 | N =: 0 NB. current node 178 | move =: adverb : 'N =: u y' 179 | parent =: fst @ Ti 180 | rsib =: verb : '(0 1 + ])&.ai__tree y' 181 | 182 | NB. positioning commands 183 | cmd_out =: parent tl move 184 | cmd_in =: T tl@(,1:) move 185 | 186 | T =: ap__tree :. iv__tree 187 | Alts =: ap__alts 188 | Forw =: ap__forw 189 | 190 | 191 | NB. unparsing 192 | id =: ] 193 | fst =: {."1 194 | cat =: ,/ 195 | rdc =: 2 : 'u/n,y' 196 | 197 | NB. rules are templates 198 | 199 | NB. dispnt: recursive procedure to display non-terminals 200 | dispnt =: dyad : 0 201 | 'nid rule' =: x 202 | x unparse (2{rule) ap y 203 | ) 204 | danal =: dyad : 0 205 | 'n r' =: x 206 | try. x dispnt L: _ 0 (0{r) catch. end. 207 | ) 208 | disprule =: cat rdc '' @: danal 209 | dispnode =: disprule @: (id ,. (Alts :: Forw)@: fst @: T) 210 | unparse =: T ap :: dispnode 211 | 212 | 213 | NB. terminals 214 | 'ALPHA DIGIT PLUS MINUS STAR SLASH'=:s:'`ALPHA`DIGIT`+`-`*`/' 215 | 216 | NB. nonterminals 217 | 'NUMBER GROUP'=:s:'`NUMBER`GROUP' 218 | 219 | ia=:ins__alts@< 220 | ia 0; ALPHA 221 | 222 | lang =: 0 : 0 223 | digit:'0'..'9'. 224 | ) 225 | 226 | NB. example language 227 | ins__forw 228 | 229 | ins=.ins__tree 230 | 231 | 232 | 233 | NB. tree table 234 | NB. ------------------ 235 | NB. 13 (2 ({.;}.)"1 [,.i.@#@],.]) 1 3 4 8 236 | NB. subs =: [: :([: < [) ,. [: (i.@# ;"0 ]) [: s: ' ',] 237 | 238 | NB. for (node → non-term) and (node → (non-term × key)) combinations: 239 | 240 | 241 | as =: 4 :'x;' is (ref'digit')rep end 253 | -------------------------------------------------------------------------------- /stringdb.ijs: -------------------------------------------------------------------------------- 1 | NB. string database 2 | NB. 3 | NB. This module associate strings with numbers, using a 4 | NB. component file to map numbers to strings, and a keyed 5 | NB. file to map the strings to numbers. 6 | NB. 7 | NB. Only one database is used at a time. To select the 8 | NB. database, run: stringdb'data/strings' 9 | NB. 10 | cocurrent 'stringdb' 11 | require 'jfiles' 12 | 13 | stringdb =: verb define 14 | assert #y 15 | valpath=:jpath y,'.k2s' NB. int → str 16 | keypath=:jpath y,'.s2k' NB. str → int 17 | if. -.fexist valpath do. jcreate valpath end. 18 | if. -.fexist keypath do. keycreate keypath end. 19 | ) 20 | 21 | s2k =: verb define 22 | NB. return key corresponding to y:(str|key end. 28 | ) 29 | 30 | k2s =: verb define 31 | NB. given key y:nat, return corresponding string 32 | jread valpath;y NB. will be boxed if found 33 | ) 34 | 35 | lsdb =: verb define 36 | NB. list values in the string database 37 | jread valpath; i.1 { jsize valpath 38 | ) 39 | -------------------------------------------------------------------------------- /stype.ijs: -------------------------------------------------------------------------------- 1 | NB. stype (symbolic type) 2 | NB. stype y converts result of (3!:0 y) (datatype) to a simpler format: 3 | 4 | 0 1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 16384 32768 65536 131072 5 | t=.'? n t n n n b n n ? ? n t n n n b s t' 6 | s=.'SYM TXT NUM BOX UNK'=: s:' symbol text number boxed unknown' 7 | stype=: s {~ 'stnb?' i. (; ;: t) {~ [: >: 2^.(3!:0) 8 | -------------------------------------------------------------------------------- /sx.ijs: -------------------------------------------------------------------------------- 1 | NB. sx : s-expression parser 2 | NB. 3 | NB. this uses the 'se' parser in parseco, 4 | NB. and then strips out the (unused) attribute field 5 | NB. and converts lisp symbols to j symbols, 6 | NB. lisp numbers to j numbers. 7 | NB. 8 | NB. (not 100% sure i need those things, but this 9 | NB. matches the older logic in sx-by-hand.ijs) 10 | 11 | cocurrent'sx' 12 | require 'cheq.ijs' NB. for unit tests at the end 13 | require 'parseco.ijs' 14 | 15 | dumps =: {{5!:6<'y'}} 16 | is_node =: (3=#) *. 'boxed'-:datatype 17 | no_attrs =: {{ 18 | if. is_node y do. 19 | (t_nt , [: no_attrs each t_nb) y 20 | else. y end. }} 21 | 22 | sx =: {{ 23 | res =. se on y 24 | if. (-.mb res) +. (ix<<:@#@ib)res do. 25 | [:'parse failed' 26 | end. 27 | to_sym =: {{ if. *./y e.Num_j_ do. 0".y else. s:jf y 12 | try. (([: <"1 (<"0 dn),.(ntx L:1)) ; *@#@ndn S:1) jf dn 13 | catch. 2 $ a: 14 | end. }} 15 | 16 | NB. fetch_items 0 17 | NB. ┌──────────────────────────────────┬─────┐ 18 | NB. │┌──────────┬──────────┬──────────┐│0 1 0│ 19 | NB. ││┌─┬──────┐│┌─┬──────┐│┌─┬──────┐││ │ 20 | NB. │││1│(meta)│││2│(lang)│││3│(user)│││ │ 21 | NB. ││└─┴──────┘│└─┴──────┘│└─┴──────┘││ │ 22 | NB. │└──────────┴──────────┴──────────┘│ │ 23 | NB. └──────────────────────────────────┴─────┘ 24 | 25 | 26 | NB. -- tree control ------------------------- 27 | 28 | tree =: UiTree fetch_items 0 29 | 'H__tree W__tree' =: _1 0 + gethw_vt_'' 30 | TX_BG__tree =: _234 31 | fetch_items__tree =: {{ fetch_items_base_ (0;0) {::C{L }} 32 | 33 | nid__tree =: {{ 0{::>C{L }} 34 | txt__tree =: {{ 1{::>C{L }} 35 | set_txt__tree =: {{ L=:(<(C{L)C}L }} 36 | 37 | ind__tree =: {{ 2+C{D }} NB. indentation 38 | 39 | 40 | 41 | NB. extract the label 42 | render_item__tree =: {{ 43 | x render_item_UiTree_ f. 7 u: (0;1){::y }} 44 | 45 | 46 | NB. line editor control 47 | 48 | led =: UiEditWidget'' 49 | V__led =: 0 50 | NB.BG__led =: CU_BG__tree 51 | NB.FG__led =: CU_FG__tree 52 | 53 | edit_item =: {{ 54 | C__led =: 0 55 | XY__led =: (C__tree,~ind__tree'') + XY__tree 56 | W__led =: W__tree - ind__tree'' 57 | B__led =: txt__tree'' 58 | V__led =: 1 59 | F__app =: led 60 | }} 61 | 62 | 63 | on_accept__led =: {{ 64 | V =: 0 65 | tree =. tree_base_ [ app =. app_base_ 66 | F__app =: tree 67 | set_txt__tree B 68 | (B & ntx_base_) wjf_base_ nid__tree'' 69 | }} 70 | 71 | NB. -- status line ------------------------- 72 | 73 | stat =: UiWidget'' 74 | tree__stat =: tree_base_ 75 | W__stat =: W__tree 76 | XY__stat =: 0,H__tree 77 | render__stat =: {{ 78 | bg _8 79 | fg _7 80 | puts ' nid: ', 0":nid__tree'' 81 | ceol'' 82 | }} 83 | 84 | 85 | NB. -- keyboard handler --------------------- 86 | 87 | k_nul =: {{ exit 0 [ curs 1 [ raw 0 }} NB. ctrl-space/ctrl-@ 88 | 89 | cocurrent tree 90 | k_n =: fwd 91 | k_p =: bak 92 | k_u =: upw 93 | k_q =: {{break_kvm_=:1}} 94 | k_t =: toggle 95 | k_e =: edit_item_base_ 96 | k_i =: 1&ins_item_base_ 97 | k_I =: 0&ins_item_base_ 98 | k_c =: 0&ins_child_base_ 99 | k_C =: 1&ins_child_base_ 100 | 101 | cocurrent 'base' 102 | 103 | NB. code to run instead of j prompt 104 | app =: UiApp tree,stat,led 105 | 106 | (9!:29) 1 [ 9!:27 'run__app _ ' 107 | -------------------------------------------------------------------------------- /todo.org: -------------------------------------------------------------------------------- 1 | #+title: syndir: a syntax directed editor 2 | 3 | * DONE line editor 4 | # The 'list.ijs' here was the original, but j-kvm/ui/list.ijs is an improvement. 5 | ** DONE start with basic console io primitives 6 | :PROPERTIES: 7 | :TS: <2014-12-04 07:38AM> 8 | :ID: 78uknqj0wog0 9 | :END: 10 | 11 | ** DONE render a horizontal sequence of items 12 | :PROPERTIES: 13 | :TS: <2014-12-04 07:39AM> 14 | :ID: ai9borj0wog0 15 | :END: 16 | 17 | ** DONE implement a cursor that traverses the sequence 18 | :PROPERTIES: 19 | :TS: <2014-12-04 07:40AM> 20 | :ID: xareqtj0wog0 21 | :END: 22 | 23 | ** DONE hook the cursor up to input events for user interaction 24 | :PROPERTIES: 25 | :TS: <2014-12-04 07:41AM> 26 | :ID: a083duj0wog0 27 | :END: 28 | 29 | ** DONE allow inserting, deleting, swapping items in the sequence 30 | :PROPERTIES: 31 | :TS: <2014-12-04 07:39AM> 32 | :ID: 4h6k9sj0wog0 33 | :END: 34 | 35 | 36 | * TODO make a series of prototypes 37 | :PROPERTIES: 38 | :TS: <2022-05-10 07:10PM> 39 | :ID: hj2b7h01agj0 40 | :END: 41 | ** TODO parser for meta-grammar 42 | :PROPERTIES: 43 | :TS: <2022-05-10 07:13PM> 44 | :ID: r0xebm01agj0 45 | :END: 46 | - regex style syntax 47 | - deal with [+-?*] suffixes 48 | - probably not actually a problem but it bothers me 49 | - decide how to approach precedence 50 | ** TODO briefly discuss embedding directly in the gerund 51 | - using gerunds anyway for seq 52 | - can parse boxed items just as easily as characters 53 | : any lit on;:'^([a-z]+\w)|hel.lo*' 54 | 55 | - can't type raw parens in gerund 56 | - but the boxed '(' string is fine 57 | - can use {: }: for grouping 58 | - if using ;: could have parens translate 59 | - [`] for charsets 60 | - +*?|^$ are all valid gerund members 61 | - boxed string literals 62 | - can use {. }. for charsets 63 | 64 | but: 65 | - to use this syntax you're writing a parser for the gerund anyway 66 | - so why not just parse a string? 67 | 68 | ** TODO builder for j's sequential machine 69 | :PROPERTIES: 70 | :TS: <2022-05-10 07:51PM> 71 | :ID: 2zb3md21agj0 72 | :END: 73 | - no point in doing all of pcre since j already has that: 74 | https://www.pcre.org/original/doc/html/pcresyntax.html 75 | 76 | "Regular Expression Matching can be Simple and Fast" 77 | https://swtch.com/~rsc/regexp/regexp1.html 78 | 79 | ** TODO demo for backreferences / unification 80 | :PROPERTIES: 81 | :TS: <2022-05-10 08:27PM> 82 | :ID: q4sga141agj0 83 | :END: 84 | 85 | ** TODO unparser for j parser combinators 86 | :PROPERTIES: 87 | :TS: <2022-05-10 07:50PM> 88 | :ID: f4l3ub21agj0 89 | :END: 90 | 91 | ** TODO enhanced line editor/repl for j statements 92 | :PROPERTIES: 93 | :TS: <2022-05-10 07:10PM> 94 | :ID: i09ehh01agj0 95 | :END: 96 | - syntax highlight 97 | - push/pop parts of the sentence onto a stack 98 | - swap the items? 99 | - highlights for trains 100 | - '..' separator support 101 | 102 | ** TODO build a sequential machine / regex thing for j 103 | :PROPERTIES: 104 | :TS: <2014-11-22 12:00AM> 105 | :ID: cxvdgl70gog0 106 | :END: 107 | ** TODO simplest stackwise concept 108 | :PROPERTIES: 109 | :TS: <2022-05-10 07:14PM> 110 | :ID: hln6cn01agj0 111 | :END: 112 | - have a simple jod-like dictionary in the background 113 | - find all unique J identifiers in the chunk 114 | - see which ones are undefined 115 | - allow 'stub' entries that name a part of speech 116 | 117 | ** TODO 3-pane grammar/editor/ast thing 118 | :PROPERTIES: 119 | :TS: <2022-05-10 07:27PM> 120 | :ID: dioc6a11agj0 121 | :END: 122 | *** TODO demonstrate building a grammar interactively 123 | - import a text file 124 | - add regexes for tokenizer 125 | 126 | ** TODO JOD browser 127 | :PROPERTIES: 128 | :TS: <2022-05-10 07:29PM> 129 | :ID: jsucic11agj0 130 | :END: 131 | list dictionaries 132 | show grid of names, with part of speech, documentation 133 | expand to see actual definition 134 | tiddly/glamorous-style hypertext 135 | 136 | ** TODO get the pl0syntax unparser working 137 | :PROPERTIES: 138 | :TS: <2022-05-10 07:30PM> 139 | :ID: 9u50te11agj0 140 | :END: 141 | 142 | ** TODO leo-style outliner in j-kvm 143 | :PROPERTIES: 144 | :TS: <2022-05-10 07:30PM> 145 | :ID: 96ii6f11agj0 146 | :END: 147 | 148 | ** TODO simple widget layout language 149 | :PROPERTIES: 150 | :TS: <2022-05-10 07:31PM> 151 | :ID: a2i0ug11agj0 152 | :END: 153 | yaml? 154 | 155 | ** TODO godot-style scene builder ui. 156 | :PROPERTIES: 157 | :TS: <2022-05-10 07:32PM> 158 | :ID: d605fi11agj0 159 | :END: 160 | 161 | ** TODO 'extract function' browser 162 | :PROPERTIES: 163 | :TS: <2022-05-10 07:37PM> 164 | :ID: 1up50q11agj0 165 | :END: 166 | 167 | ** TODO true tree editor widget 168 | *** DONE add line editor to edit entries 169 | :PROPERTIES: 170 | :TS: <2014-12-04 07:41AM> 171 | :ID: 63qe8vj0wog0 172 | :END: 173 | *** TODO make the editor part of the tree itself 174 | :PROPERTIES: 175 | :TS: <2022-05-10 07:44PM> 176 | :ID: xkieg121agj0 177 | :END: 178 | ** TODO grid widget / multi-column treegrid thing 179 | :PROPERTIES: 180 | :TS: <2022-05-10 07:44PM> 181 | :ID: 3xm2p121agj0 182 | :END: 183 | - to be used for the lexer 184 | - also base for editor with gutter 185 | ** TODO true multi-line editor widget with selections 186 | :PROPERTIES: 187 | :TS: <2022-05-10 07:45PM> 188 | :ID: lit19321agj0 189 | :END: 190 | 191 | ** TODO demonstrate autocompletion 192 | :PROPERTIES: 193 | :TS: <2022-05-10 07:39PM> 194 | :ID: xy59ms11agj0 195 | :END: 196 | 197 | ** TODO traditional structure editor 198 | *** maybe model alice pascal? 199 | *** TODO unparse a tree 200 | :PROPERTIES: 201 | :TS: <2014-11-20 11:56AM> 202 | :ID: 912c9k80eog0 203 | :END: 204 | ** TODO simple outliner 205 | :PROPERTIES: 206 | :TS: <2022-05-10 09:07PM> 207 | :ID: rvw3yv51agj0 208 | :END: 209 | 210 | 211 | * TODO proof editor 212 | ** DONE begin with a simple proof 213 | :PROPERTIES: 214 | :TS: <2014-12-17 06:13AM> 215 | :ID: h1p1msm0dpg0 216 | :END: 217 | 218 | #+begin_src J 219 | (a^b)^c 220 | eq a^(b*c) by rExpMul 221 | eq a^(c*b) by rMulCom 222 | eq (a^c)^b by rExpMul^:_1 223 | #+end_src 224 | 225 | Our goal will be to enter this proof into the system. 226 | 227 | ** DONE a constructor for AST nodes 228 | :PROPERTIES: 229 | :TS: <2014-12-17 05:45AM> 230 | :ID: ho27lhl0dpg0 231 | :END: 232 | 233 | - [X] Constructor is a dyad. 234 | - [X] Left side is always a string. Use (,x) so that rank=1. 235 | - [X] Right side is always a rank 1 array, so use (,y) too. 236 | - [X] length of result is always >: 1 237 | - [X] rank of result is always 1 238 | - [X] level of result is always >:1 239 | 240 | #+begin_src J :session j 241 | C=:4 :'r=.,x if. #y do. r;,y else. 249 | :ID: oqrf4kn0dpg0 250 | :END: 251 | 252 | #+begin_src J :session j 253 | (<'3'C<('3'C<'a'C'^'C'b')C'^'C'c') 5!:0 254 | #+end_src 255 | 256 | #+RESULTS: 257 | : (a ^ b) ^ c 258 | 259 | This is mostly just for reference, because the atomic representation deals with values, not the syntax used to create those values. 260 | 261 | ** TODO unwrapping the first line 262 | :PROPERTIES: 263 | :TS: <2014-12-17 06:30AM> 264 | :ID: vvec9ln0dpg0 265 | :END: 266 | *** DONE derivation 267 | :PROPERTIES: 268 | :TS: <2014-12-17 06:35AM> 269 | :ID: cmj0ssn0dpg0 270 | :END: 271 | 272 | #+begin_src text 273 | 274 | j: NB. j: → n: 275 | n: NB. n: $ → n: v: n: 276 | n: v: n: NB. n: v: → (n: v: n:) v: 277 | (n: v: n:) v: n: NB. substitute 278 | (a ^ b) ^ c 279 | 280 | #+end_src 281 | 282 | *** TODO tree constructors for the derivation 283 | :PROPERTIES: 284 | :TS: <2014-12-17 06:52AM> 285 | :ID: nm150mo0dpg0 286 | :END: 287 | 288 | #+begin_src J :session j 289 | '`j n v' =:( 'j:'C])`('n:'C])`('v:'C]) NB. phrases 290 | '`ID NP VP'=:('ID:'C])`('NP:'C])`('VP:'C]) NB. identifiers and 291 | '`CP AP' =:('CP:'C])`('AP:'C]) NB. primitives 292 | #+end_src 293 | 294 | #+RESULTS: 295 | 296 | 297 | #+begin_src J :session j 298 | j a: 299 | #+end_src 300 | 301 | #+RESULTS: 302 | : ┌──┬┐ 303 | : │j:││ 304 | : └──┴┘ 305 | 306 | #+begin_src J :session j 307 | j < n a: 308 | #+end_src 309 | 310 | #+RESULTS: 311 | : ┌──┬─────┐ 312 | : │j:│┌──┬┐│ 313 | : │ ││n:│││ 314 | : │ │└──┴┘│ 315 | : └──┴─────┘ 316 | 317 | #+begin_src J :session j 318 | j 395 | :ID: 0i88bas0dpg0 396 | :END: 397 | 398 | #+begin_src J :session j 399 | walk =: (3 : 'if. 1=#y do. walk each >y elseif. ({.y) e. ID VP NP 0 do. >{: y elseif. do. ;walk each }.y end.')"1 400 | walk ast 401 | #+end_src 402 | 403 | #+RESULTS: 404 | : ^c 405 | 406 | 407 | 408 | 409 | 410 | * -- to try --- 411 | ** TODO write tests for tree builder behavior 412 | :PROPERTIES: 413 | :TS: <2014-11-21 11:53PM> 414 | :ID: 4ps1ra70gog0 415 | :END: 416 | ** NOTE . "views" (abstract interface for pattern matching) 417 | :PROPERTIES: 418 | :TS: <2022-04-29 06:57PM> 419 | :ID: c5jb8ia0wfj0 420 | :END: 421 | wadler 87 https://dl.acm.org/doi/pdf/10.1145/41625.41653 422 | (mentioned in ometa paper) 423 | 424 | "Wadler’s views [Wad87], for example, enable programmers to provide a “virtual representation” of their data that can be pattern-matched against without exposing any implementation details" 425 | ** store the edited text buffer as a rope? 426 | https://en.wikipedia.org/wiki/Rope_%28data_structure%29 427 | -------------------------------------------------------------------------------- /unify.ijs: -------------------------------------------------------------------------------- 1 | NB. unification and substitution for s-expressions in j 2 | NB. 3 | NB. © copyright 2014 michal j wallace < http://tangentstorm.com/ > 4 | NB. available for use under the MIT/X11 license. 5 | NB. 6 | require 'sx.ijs dict.ijs' NB. for sym/S, dict,get,put,etc 7 | coinsert 'sx dict' 8 | 9 | NB. symbolic substitution (x:dict subs y:sx → sx) 10 | NB. -------------------------------------------------------- 11 | NB. replace keys of x with corresponding values, leaving the 12 | NB. rest of y unchanged. 13 | subs =: [: :: (get :: ] L:_ 0) 14 | 15 | Note (('a b c' S) dict ('x y z' S)) subs sx'(b a (n a)) ((n) a)' 16 | ┌───────────────┬─────────┐ 17 | │┌──┬──┬───────┐│┌────┬──┐│ 18 | ││`y│`x│┌──┬──┐│││┌──┐│`x││ 19 | ││ │ ││`n│`x│││││`n││ ││ 20 | ││ │ │└──┴──┘│││└──┘│ ││ 21 | │└──┴──┴───────┘│└────┴──┘│ 22 | └───────────────┴─────────┘ 23 | ) 24 | 25 | 26 | dtype =: 3!:0 NB. datatype of y 27 | isSym =: 65536=dtype 28 | isBox =: 32=dtype 29 | 30 | inRange =: (> {.) *. (< {:) 31 | isVar =: 0:`(inRange&('$ %'S))@.isSym 32 | inTree =: +./@(e.S:0) 33 | 34 | atomic =: (1 = #) *. (-.@isBox) 35 | 36 | nope =: 'nope'S NB. symbol returned when unification fails 37 | unify =: (4 : 0) NB. x uw y : 0|dict → dict if x unifies with y, else 0 38 | if. x -: y do. emptyd 39 | elseif. (isVar x) > ((isVar y) +. (x inTree y)) do. x dict y 40 | elseif. (isVar y) > ((isVar x) +. (y inTree x)) do. y dict x 41 | elseif. +./(atomic x),(atomic y),(x ~:&# y) do. nope 42 | elseif. (1=#x) *. (x *.&isBox y) do. , x unify & > y 43 | elseif. do. 44 | if. (hu =. x unify & {. y) -: nope do. nope NB. unify heads 45 | else. tu =. x unify & (hu subs }.) y NB. unify tails 46 | if. tu -: nope do. nope 47 | else. tu , L:_1 hu end. 48 | end. 49 | end. 50 | ) 51 | 52 | NB. examples 53 | assert isVar '$a'S 54 | assert -. isVar '%a'S 55 | assert '$a'S inTree sx'(0 (1 $a) 3)' 56 | assert -. '$a'S inTree sx'(0 (1 2) 3)' 57 | 58 | assert (g=.'$a'S dict 0) -: r=.('$a'S) unify 0 59 | assert (g=.'$a'S dict 0) -: r=.(sx'$a') unify (sx'0') 60 | assert (g=.emptyd) -: r=.(sx'0 0') unify (sx'0 0') 61 | assert (g=.'$a'S dict 0) -: r=.(sx'$a 0') unify (sx'0 0') 62 | -------------------------------------------------------------------------------- /unj.ijs: -------------------------------------------------------------------------------- 1 | NB. un-parser for grammar combinators. 2 | 3 | NIL =: >ar'nil' 4 | ANY =: >ar'any' 5 | LIT =: (1;0){::>ar'lit' 6 | ONE =: (1;0){::>ar'one' 7 | SEQ =: >ar'seq' 8 | REP =: >ar'rep' 9 | ALT =: >ar'alt' 10 | IFU =: >ar'ifu' 11 | TOK =: (1;1){::>ar'tok' 12 | ZAP =: (1;1){::>ar'zap' 13 | TRC =: >ar'trace' 14 | 15 | unj =: {{'unj' assert. 2 32 e.~ t =. 3!:0 y ['unj expects an atomic representation' 16 | NB. https://code.jsoftware.com/wiki/Vocabulary/GerundsAndAtomicRepresentation 17 | NB. AR = name:str | tag:str;unj each 0{T NB. :: indicates 'try', so just delete it 42 | case. ':' do. >unj each T 43 | case. do. 44 | smoutput'FAIL' 45 | y 46 | end. 47 | end. 48 | end.}} 49 | 50 | mLit =: 'mLIT' lit 51 | mOne =: 'mONE' one 52 | mSeq =: any`any seq 53 | unj >ar'mSeq' 54 | 55 | cheq =: {{ NB. check equality 56 | if. -. x -: y do. 57 | smoutput 'expected x -: y, got: ' 58 | smoutput 'x:' 59 | smoutput x 60 | smoutput 'y:' 61 | smoutput y 62 | throw. 63 | end. }} 64 | 65 | {{ NB. test suite for unj 66 | assert. (unj >ar'mLit') cheq 'mLIT';s:' lit' 67 | assert. (unj >ar'mOne') cheq 'mONE';s:' one' 68 | assert. (unj >ar'mSeq') cheq (;~'any');s:' seq' 69 | assert. (unj >ar'any') cheq ar'll' 74 | unj >ar'se' 75 | -------------------------------------------------------------------------------- /unparse.ijs: -------------------------------------------------------------------------------- 1 | NB. 2 | NB. unparse: turn an abstract syntax tree into text. 3 | NB. 4 | load'cheq.ijs' 5 | 6 | j =: 'j:' C ] NB. any j sentence 7 | n =: 'n:' C ] NB. noun 8 | v =: 'v:' C ] NB. verb 9 | g =: 'g:' C ] NB. group (parens) 10 | ID =:'ID:' C ] NB. an identifier 11 | VP =:'VP:' C ] NB. verb primitive 12 | NP =:'NP:' C ] NB. noun primitive 13 | 14 | isbox =: 32 = 3!:0 15 | 16 | C =: dyad : 'r=.,x if. #y do. r;,y else. {: y 33 | elseif. hd e. j n v'' do. recurse y 34 | elseif. do. throw ('y';