mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-28 17:20:22 +00:00
Add shen language in linguist
This commit is contained in:
saarin
@@ -1614,6 +1614,12 @@ Shell:
|
||||
filenames:
|
||||
- Dockerfile
|
||||
|
||||
Shen:
|
||||
type: programming
|
||||
color: "#120F14"
|
||||
lexer: Text only
|
||||
primary_extension: .shen
|
||||
|
||||
Slash:
|
||||
type: programming
|
||||
color: "#007eff"
|
||||
|
||||
321
samples/Shen/graph.shen
Normal file
321
samples/Shen/graph.shen
Normal file
@@ -0,0 +1,321 @@
|
||||
\* graph.shen --- a library for graph definition and manipulation
|
||||
|
||||
Copyright (C) 2011, Eric Schulte
|
||||
|
||||
*** License:
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are
|
||||
met:
|
||||
|
||||
- Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
- Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
*** Commentary:
|
||||
|
||||
Graphs are represented as two dictionaries one for vertices and one
|
||||
for edges. It is important to note that the dictionary implementation
|
||||
used is able to accept arbitrary data structures as keys. This
|
||||
structure technically encodes hypergraphs (a generalization of graphs
|
||||
in which each edge may contain any number of vertices). Examples of a
|
||||
regular graph G and a hypergraph H with the corresponding data
|
||||
structure are given below.
|
||||
|
||||
|
||||
--G=<graph Vertices Edges>------------------------------------------------
|
||||
Vertices Edges
|
||||
---------- -------
|
||||
+----Graph G-----+ hash | key -> value hash | key -> value
|
||||
| | -----+------>-------- -----+-------->---------
|
||||
| a---b---c g | 1 | a -> [1] 1 | [a b] -> [1 2]
|
||||
| | | | 2 | b -> [1 2 3] 2 | [b c] -> [2 3]
|
||||
| d---e---f | 3 | c -> [2 4] 3 | [b d] -> [2 4]
|
||||
| | 4 | d -> [3 5] 4 | [c e] -> [3 5]
|
||||
+----------------+ 5 | e -> [4 5 6] 5 | [d e] -> [4 5]
|
||||
6 | f -> [6] 6 | [e f] -> [5 6]
|
||||
7 | g -> []
|
||||
|
||||
|
||||
--H=<graph Vertices Edges>------------------------------------------------
|
||||
Vertices Edges
|
||||
---------- -------
|
||||
hash | key -> value hash | key -> value
|
||||
+-- Hypergraph H----+ -----+------>-------- -----+-------->---------
|
||||
| | 1 | a -> [1] 1 | [a b [1 2
|
||||
| +------+ | 2 | b -> [1] | c d -> 3 4
|
||||
| +------+------+ | 3 | c -> [1] | e f] 5 6]
|
||||
| |a b c |d e f | | 4 | d -> [1 2] |
|
||||
| +------+------+ | 5 | e -> [1 2] 2 | [d e [4 5
|
||||
| |g h i | j | 6 | f -> [1 2] | f g -> 6 7
|
||||
| +------+ | 7 | g -> [2] | h i] 8 9]
|
||||
| | 8 | h -> [2]
|
||||
+-------------------+ 9 | i -> [2]
|
||||
10 | j -> []
|
||||
|
||||
|
||||
--G=<graph Vertices Edges>-------Graph with associated edge/vertex data---------
|
||||
Vertices Edges
|
||||
---------- -------
|
||||
+----Graph G-----+ hash | key -> value hash | key -> value
|
||||
| 4 6 7 | -----+------>-------- -----+-------->---------
|
||||
|0a---b---c g | 1 | a -> (@p 0 [1]) 1 | [a b] -> (@p 4 [1 2])
|
||||
| 1| 3| | 2 | b -> [1 2 3] 2 | [b c] -> (@p 6 [2 3])
|
||||
| d---e---f | 3 | c -> [2 4] 3 | [b d] -> (@p 1 [2 4])
|
||||
| 2 5 | 4 | d -> [3 5] 4 | [c e] -> (@p 3 [3 5])
|
||||
+----------------+ 5 | e -> [4 5 6] 5 | [d e] -> (@p 2 [4 5])
|
||||
6 | f -> [6] 6 | [e f] -> (@p 5 [5 6])
|
||||
7 | g -> (@p 7 [])
|
||||
|
||||
V = # of vertices
|
||||
E = # of edges
|
||||
M = # of vertex edge associations
|
||||
|
||||
size = size of all vertices + all vertices stored in Vertices dict
|
||||
M * sizeof(int) * 4 + indices into Vertices & Edge dicts
|
||||
V * sizeof(dict entry) + storage in the Vertex dict
|
||||
E * sizeof(dict entry) + storage in the Edge dict
|
||||
2 * sizeof(dict) the Vertices and Edge dicts
|
||||
|
||||
*** Code: *\
|
||||
(require dict)
|
||||
(require sequence)
|
||||
|
||||
(datatype graph
|
||||
Vertices : dictionary;
|
||||
Edges : dictoinary;
|
||||
===================
|
||||
(vector symbol Vertices Edges);)
|
||||
|
||||
(package graph- [graph graph? vertices edges add-vertex
|
||||
add-edge has-edge? has-vertex? edges-for
|
||||
neighbors connected-to connected? connected-components
|
||||
vertex-partition bipartite?
|
||||
\* included from the sequence library\ *\
|
||||
take drop take-while drop-while range flatten
|
||||
filter complement seperate zip indexed reduce
|
||||
mapcon partition partition-with unique frequencies
|
||||
shuffle pick remove-first interpose subset?
|
||||
cartesian-product
|
||||
\* included from the dict library\ *\
|
||||
dict? dict dict-> <-dict contents key? keys vals
|
||||
dictionary make-dict]
|
||||
|
||||
(define graph?
|
||||
X -> (= graph (<-address X 0)))
|
||||
|
||||
(define make-graph
|
||||
\* create a graph with specified sizes for the vertex dict and edge dict *\
|
||||
{number --> number --> graph}
|
||||
Vertsize Edgesize ->
|
||||
(let Graph (absvector 3)
|
||||
(do (address-> Graph 0 graph)
|
||||
(address-> Graph 1 (make-dict Vertsize))
|
||||
(address-> Graph 2 (make-dict Edgesize))
|
||||
Graph)))
|
||||
|
||||
(defmacro graph-macro
|
||||
\* return a graph taking optional sizes for the vertex and edge dicts *\
|
||||
[graph] -> [make-graph 1024 1024]
|
||||
[graph N] -> [make-graph N 1024]
|
||||
[graph N M] -> [make-graph N M])
|
||||
|
||||
(define vert-dict Graph -> (<-address Graph 1))
|
||||
|
||||
(define edge-dict Graph -> (<-address Graph 2))
|
||||
|
||||
(define vertices
|
||||
{graph --> (list A)}
|
||||
Graph -> (keys (vert-dict Graph)))
|
||||
|
||||
(define edges
|
||||
{graph --> (list (list A))}
|
||||
Graph -> (keys (edge-dict Graph)))
|
||||
|
||||
(define get-data
|
||||
Value V -> (if (tuple? Value)
|
||||
(fst Value)
|
||||
(error (make-string "no data for ~S~%" V))))
|
||||
|
||||
(define vertex-data
|
||||
Graph V -> (get-data (<-dict (vert-dict Graph) V) V))
|
||||
|
||||
(define edge-data
|
||||
Graph V -> (get-data (<-dict (edge-dict Graph) V) V))
|
||||
|
||||
(define resolve
|
||||
{(vector (list A)) --> (@p number number) --> A}
|
||||
Vector (@p Index Place) -> (nth (+ 1 Place) (<-vector Vector Index)))
|
||||
|
||||
(define resolve-vert
|
||||
{graph --> (@p number number) --> A}
|
||||
Graph Place -> (resolve (<-address (vert-dict Graph) 2) Place))
|
||||
|
||||
(define resolve-edge
|
||||
{graph --> (@p number number) --> A}
|
||||
Graph Place -> (resolve (<-address (edge-dict Graph) 2) Place))
|
||||
|
||||
(define edges-for
|
||||
{graph --> A --> (list (list A))}
|
||||
Graph Vert -> (let Val (trap-error (<-dict (vert-dict Graph) Vert) (/. E []))
|
||||
Edges (if (tuple? Val) (snd Val) Val)
|
||||
(map (lambda X (fst (resolve-edge Graph X))) Val)))
|
||||
|
||||
(define add-vertex-w-data
|
||||
\* add a vertex to a graph *\
|
||||
{graph --> A --> B --> A}
|
||||
G V Data -> (do (dict-> (vert-dict G) V (@p Data (edges-for G V))) V))
|
||||
|
||||
(define add-vertex-w/o-data
|
||||
\* add a vertex to a graph *\
|
||||
{graph --> A --> B --> A}
|
||||
G V -> (do (dict-> (vert-dict G) V (edges-for G V)) V))
|
||||
|
||||
(defmacro add-vertex-macro
|
||||
[add-vertex G V] -> [add-vertex-w/o-data G V]
|
||||
[add-vertex G V D] -> [add-vertex-w-data G V D])
|
||||
|
||||
(define update-vert
|
||||
\* in a dict, add an edge to a vertex's edge list *\
|
||||
{vector --> (@p number number) --> A --> number}
|
||||
Vs Edge V -> (let Store (<-address Vs 2)
|
||||
N (hash V (limit Store))
|
||||
VertLst (trap-error (<-vector Store N) (/. E []))
|
||||
Contents (trap-error (<-dict Vs V) (/. E []))
|
||||
(do (dict-> Vs V (if (tuple? Contents)
|
||||
(@p (fst Contents)
|
||||
(adjoin Edge (snd Contents)))
|
||||
(adjoin Edge Contents)))
|
||||
(@p N (length VertLst)))))
|
||||
|
||||
(define update-edges-vertices
|
||||
\* add an edge to a graph *\
|
||||
{graph --> (list A) --> (list A)}
|
||||
Graph Edge ->
|
||||
(let Store (<-address (edge-dict Graph) 2)
|
||||
EdgeID (hash Edge (limit Store))
|
||||
EdgeLst (trap-error (<-vector Store EdgeID) (/. E []))
|
||||
(map (update-vert (vert-dict Graph) (@p EdgeID (length EdgeLst))) Edge)))
|
||||
|
||||
(define add-edge-w-data
|
||||
G E D -> (do (dict-> (edge-dict G) E (@p D (update-edges-vertices G E))) E))
|
||||
|
||||
(define add-edge-w/o-data
|
||||
G E -> (do (dict-> (edge-dict G) E (update-edges-vertices G E)) E))
|
||||
|
||||
(defmacro add-edge-macro
|
||||
[add-edge G E] -> [add-edge-w/o-data G E]
|
||||
[add-edge G E V] -> [add-edge-w-data G E V])
|
||||
|
||||
(define has-edge?
|
||||
{graph --> (list A) --> boolean}
|
||||
Graph Edge -> (key? (edge-dict Graph) Edge))
|
||||
|
||||
(define has-vertex?
|
||||
{graph --> A --> boolean}
|
||||
Graph Vertex -> (key? (vert-dict Graph) Vertex))
|
||||
|
||||
(define neighbors
|
||||
\* Return the neighbors of a vertex *\
|
||||
{graph --> A --> (list A)}
|
||||
Graph Vert -> (unique (mapcon (remove-first Vert) (edges-for Graph Vert))))
|
||||
|
||||
(define connected-to-
|
||||
{graph --> (list A) --> (list A) --> (list A)}
|
||||
Graph [] Already -> Already
|
||||
Graph New Already ->
|
||||
(let Reachable (unique (mapcon (neighbors Graph) New))
|
||||
New (difference Reachable Already)
|
||||
(connected-to- Graph New (append New Already))))
|
||||
|
||||
(define connected-to
|
||||
\* return all vertices connected to the given vertex, including itself *\
|
||||
{graph --> A --> (list A)}
|
||||
Graph V -> (connected-to- Graph [V] [V]))
|
||||
|
||||
(define connected?
|
||||
\* return if a graph is fully connected *\
|
||||
{graph --> boolean}
|
||||
Graph -> (reduce (/. V Acc
|
||||
(and Acc
|
||||
(subset? (vertices Graph) (connected-to Graph V))))
|
||||
true (vertices Graph)))
|
||||
|
||||
(define connected-components-
|
||||
\* given a graph return a list of connected components *\
|
||||
{graph --> (list A) --> (list (list A)) --> (list graph)}
|
||||
Graph [] _ -> []
|
||||
Graph VS [] -> (map (/. V (let Component (graph 1 0)
|
||||
(do (add-vertex Component V) Component)))
|
||||
VS)
|
||||
Graph [V|VS] ES ->
|
||||
(let Con-verts (connected-to Graph V)
|
||||
Con-edges (filter (/. E (subset? E Con-verts)) ES)
|
||||
Component (graph (length Con-verts) (length Con-edges))
|
||||
(do (map (add-edge-w/o-data Component) Con-edges)
|
||||
(cons Component (connected-components- Graph
|
||||
(difference VS Con-verts)
|
||||
(difference ES Con-edges))))))
|
||||
|
||||
(define connected-components
|
||||
{graph --> (list graph)}
|
||||
Graph -> (connected-components- Graph (vertices Graph) (edges Graph)))
|
||||
|
||||
(define place-vertex
|
||||
\* given a graph, vertex and list of partitions, partition the vertex *\
|
||||
{graph --> A --> (list (list A)) --> (list (list A))}
|
||||
Graph V [] -> (if (element? V (neighbors Graph V))
|
||||
(simple-error
|
||||
(make-string "self-loop ~S, no vertex partition" V))
|
||||
[[V]])
|
||||
Graph V [C|CS] -> (let Neighbors (neighbors Graph V)
|
||||
(if (element? V Neighbors)
|
||||
(simple-error
|
||||
(make-string "self-loop ~S, no vertex partition" V))
|
||||
(if (empty? (intersection C Neighbors))
|
||||
[[V|C]|CS]
|
||||
[C|(place-vertex Graph V CS)]))))
|
||||
|
||||
(define vertex-partition
|
||||
\* partition the vertices of a graph *\
|
||||
{graph --> (list (list A))}
|
||||
Graph -> (reduce (place-vertex Graph) [] (vertices Graph)))
|
||||
|
||||
(define bipartite?
|
||||
\* check if a graph is bipartite *\
|
||||
{graph --> boolean}
|
||||
Graph -> (= 2 (length (vertex-partition Graph))))
|
||||
|
||||
)
|
||||
|
||||
\* simple tests
|
||||
|
||||
(set g (graph))
|
||||
(add-edge (value g) [chris patton])
|
||||
(add-edge (value g) [eric chris])
|
||||
(add-vertex (value g) nobody)
|
||||
(has-edge? (value g) [patton chris])
|
||||
(edges-for (value g) chris)
|
||||
(neighbors (value g) chris)
|
||||
(neighbors (value g) nobody)
|
||||
(connected-to (value g) chris)
|
||||
(connected? (value g))
|
||||
(connected-components (value g)) <- fail when package wrapper is used
|
||||
(map (function vertices) (connected-components (value g)))
|
||||
|
||||
*\
|
||||
102
samples/Shen/html.shen
Normal file
102
samples/Shen/html.shen
Normal file
@@ -0,0 +1,102 @@
|
||||
\* html.shen --- html generation functions for shen
|
||||
|
||||
Copyright (C) 2011, Eric Schulte
|
||||
|
||||
*** License:
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are
|
||||
met:
|
||||
|
||||
- Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
|
||||
- Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
*** Commentary:
|
||||
|
||||
The standard lisp-to-html conversion tool suite. Follows some of
|
||||
the convertions of Clojure's hiccup.
|
||||
|
||||
an example...
|
||||
|
||||
(8-) (html [ul#todo1.tasks.stuff [: [title "today"]]
|
||||
(map (lambda Str [li Str]) ["get milk" "dishes"])])
|
||||
"<ul class='tasks stuff' id='todo1' title='today'>
|
||||
<li>get milk</li><li>dishes</li></ul>"
|
||||
|
||||
*** Code: *\
|
||||
(trap-error
|
||||
(require string)
|
||||
(/. E (load "../string/string.shen")))
|
||||
|
||||
(package string- [html
|
||||
\* symbols included from string *\
|
||||
takestr dropstr substr length-str index-str
|
||||
reverse-str starts-with substr? replace-str
|
||||
join split trim-left trim-right chomp trim]
|
||||
|
||||
(define to-str
|
||||
\* return argument as a string, if already a string do not change *\
|
||||
X -> X where (string? X)
|
||||
X -> (str X))
|
||||
|
||||
(define gassoc
|
||||
X Y -> (hd (tl (assoc X Y))))
|
||||
|
||||
(define dassoc
|
||||
X Y -> (remove (assoc X Y) Y))
|
||||
|
||||
(define passoc
|
||||
[] Y -> Y
|
||||
[X XV] Y -> (let Orig (gassoc X Y)
|
||||
New (if (cons? Orig) [XV|Orig] XV)
|
||||
[[X New]|(dassoc X Y)]))
|
||||
|
||||
(define html
|
||||
X -> X where (string? X)
|
||||
[Tag [: |Attrs] |Body] ->
|
||||
(let Tag-comps (css-parse-symbol Tag)
|
||||
Tag (gassoc tag Tag-comps)
|
||||
New-attrs (passoc (assoc class Tag-comps)
|
||||
(passoc (assoc id Tag-comps) Attrs))
|
||||
(@s (make-string "<~S" Tag) (attributes New-attrs) ">"
|
||||
(html Body)
|
||||
(make-string "</~S>" Tag))) where (symbol? Tag)
|
||||
[Tag|Body] -> (html [Tag [:] Body]) where (symbol? Tag)
|
||||
[H|HS] -> (@s (html H) (html HS))
|
||||
[] -> "")
|
||||
|
||||
(define css-parse-symbol
|
||||
{symbol --> [[symbol A]]}
|
||||
Symbol -> (let String (str Symbol)
|
||||
Class-split (split (str .) String)
|
||||
Class (map (function intern) (tl Class-split))
|
||||
Id-split (split (str #) (hd Class-split))
|
||||
Tag (hd Id-split)
|
||||
Id (tl Id-split)
|
||||
((if (= [] Id) (/. X X) (cons [id (intern (hd Id))]))
|
||||
((if (= [] Class) (/. X X) (cons [class Class]))
|
||||
[[tag (intern Tag)]]))))
|
||||
|
||||
(define attributes
|
||||
[] -> ""
|
||||
[[K V]|AS] -> (@s " " (to-str K) "='"
|
||||
(if (cons? V) (join " " (map (function str) V)) (to-str V))
|
||||
"'" (attributes AS)))
|
||||
|
||||
)
|
||||
39
samples/Shen/json.shen
Normal file
39
samples/Shen/json.shen
Normal file
@@ -0,0 +1,39 @@
|
||||
(load "grammar.shen")
|
||||
|
||||
\*
|
||||
|
||||
JSON Lexer
|
||||
|
||||
1. Read a stream of characters
|
||||
2. Whitespace characters not in strings should be discarded.
|
||||
3. Whitespace characters in strings should be preserved
|
||||
4. Strings can contain escaped double quotes. e.g. "\""
|
||||
|
||||
*\
|
||||
|
||||
(define whitespacep
|
||||
\* e.g. ASCII 32 == #\Space. *\
|
||||
\* All the others are whitespace characters from an ASCII table. *\
|
||||
Char -> (member Char ["c#9;" "c#10;" "c#11;" "c#12;" "c#13;" "c#32;"]))
|
||||
|
||||
(define replace-whitespace
|
||||
"" -> ""
|
||||
(@s Whitespace Suffix) -> (@s "" (replace-whitespace Suffix)) where (whitespacep Whitespace)
|
||||
(@s Prefix Suffix) -> (@s Prefix (replace-whitespace Suffix)))
|
||||
|
||||
(define fetch-until-unescaped-doublequote
|
||||
[] -> []
|
||||
["\" "c#34;" | Chars] -> ["\" "c#34;" | (fetch-until-unescaped-doublequote Chars)]
|
||||
["c#34;" | Chars] -> []
|
||||
[Char | Chars] -> [Char | (fetch-until-unescaped-doublequote Chars)])
|
||||
|
||||
\* (define strip-whitespace-chars *\
|
||||
\* [] -> [] *\
|
||||
\* ["c#34;" | Chars] -> ["c#34;" | ( *\
|
||||
\* [WhitespaceChar | Chars] -> (strip-whitespace-chars Chars) where (whitespace? WhitespaceChar) *\
|
||||
\* [Char | Chars] -> [Char | (strip-whitespace-chars Chars)]) *\
|
||||
|
||||
(define tokenise
|
||||
JSONString ->
|
||||
(let CharList (explode JSONString)
|
||||
CharList))
|
||||
Reference in New Issue
Block a user