From af79ad21c85c632f94076bf4012efba1e0c152bc4ff88581557df940118411a7 Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Thu, 10 Apr 2025 11:10:25 +0300 Subject: [PATCH] Package KEKS and KEKS::Schema --- c/lib/cm/default.schema.keks.do | 4 +- go/cm/default.schema.keks.do | 4 +- spec/schema/tcl.texi | 4 +- tcl/keks.tcl | 6 ++- tcl/pkgIndex.tcl | 2 + tcl/{schema-marshal => schema.tcl} | 82 ++++++++++++++++++------------ tcl/test-vector.tcl | 2 +- 7 files changed, 63 insertions(+), 41 deletions(-) create mode 100644 tcl/pkgIndex.tcl rename tcl/{schema-marshal => schema.tcl} (84%) diff --git a/c/lib/cm/default.schema.keks.do b/c/lib/cm/default.schema.keks.do index b361b40..4134f0b 100644 --- a/c/lib/cm/default.schema.keks.do +++ b/c/lib/cm/default.schema.keks.do @@ -1,7 +1,7 @@ n=${2##*/}.tcl cd ../../../tcl/schemas { - echo ../schema-marshal $n + echo ../schema.tcl $n sed -n "s/^schema-include \(.*\)$/\1/p" <$n } | xargs redo-ifchange -../schema-marshal $n | xxd -r -p +TCLLIBPATH=.. ../schema.tcl $n | xxd -r -p diff --git a/go/cm/default.schema.keks.do b/go/cm/default.schema.keks.do index cd2826b..fb10673 100644 --- a/go/cm/default.schema.keks.do +++ b/go/cm/default.schema.keks.do @@ -1,7 +1,7 @@ n=${2##*/}.tcl cd ../../tcl/schemas { - echo ../schema-marshal $n + echo ../schema.tcl $n sed -n "s/^schema-include \(.*\)$/\1/p" <$n } | xargs redo-ifchange -../schema-marshal $n | xxd -r -p +TCLLIBPATH=.. ../schema.tcl $n | xxd -r -p diff --git a/spec/schema/tcl.texi b/spec/schema/tcl.texi index 758e6b5..886a1b7 100644 --- a/spec/schema/tcl.texi +++ b/spec/schema/tcl.texi @@ -6,7 +6,7 @@ Validation commands are pretty low-level and are inconvenient to write by hand, at least because of huge quantity of TAKEs. -@command{tcl/schema-marshal} utility gives ability to convert much more +@command{tcl/schema.tcl} utility gives ability to convert much more nicer schemas written on Tcl language to the KEKS-encoded commands. We call that Tcl-written schemas KEKS/Schema. @@ -30,7 +30,7 @@ and @ref{cm-pub, cm/pub} as: @verbatiminclude ../tcl/schemas/pub-load.tcl @verbatiminclude ../tcl/schemas/pub-sig-tbs.tcl -@command{schema-marshal} calls @code{schemas@{s0 cmds0 s1 cmds1 ...@}} +@command{schema.tcl} calls @code{schemas@{s0 cmds0 s1 cmds1 ...@}} commands to produce an encoded map with @code{cmds*} commands for @code{s*} schemas. There is @code{field} command that helps creation of commands related to the field. diff --git a/tcl/keks.tcl b/tcl/keks.tcl index aa15b61..5f661d3 100755 --- a/tcl/keks.tcl +++ b/tcl/keks.tcl @@ -1,5 +1,5 @@ #!/usr/bin/env tclsh -# TclKEKS -- Tcl KEKS encoder implementation +# keks.tcl -- Tcl KEKS encoder implementation # Copyright (C) 2024-2025 Sergey Matveev # # This program is free software: you can redistribute it and/or modify @@ -16,6 +16,8 @@ namespace eval KEKS { +set version 0.1.0 + proc add {v} { upvar buf buf set buf [string cat $buf $v] @@ -301,6 +303,8 @@ namespace export LIST MAP SET LenFirstSort BLOB } +package provide KEKS $KEKS::version + if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} { namespace import KEKS::* set buf "" diff --git a/tcl/pkgIndex.tcl b/tcl/pkgIndex.tcl new file mode 100644 index 0000000..9b73629 --- /dev/null +++ b/tcl/pkgIndex.tcl @@ -0,0 +1,2 @@ +package ifneeded KEKS 0.1.0 [list source [file join $dir keks.tcl]] +package ifneeded KEKS::Schema 0.1.0 [list source [file join $dir schema.tcl]] diff --git a/tcl/schema-marshal b/tcl/schema.tcl similarity index 84% rename from tcl/schema-marshal rename to tcl/schema.tcl index e26a130..35f7671 100755 --- a/tcl/schema-marshal +++ b/tcl/schema.tcl @@ -1,5 +1,5 @@ #!/usr/bin/env tclsh -# schema-marshal -- Convert Tcl schemas to KEKS representation +# schema.tcl -- Convert Tcl schemas to KEKS representation # Copyright (C) 2024-2025 Sergey Matveev # # This program is free software: you can redistribute it and/or modify @@ -14,8 +14,11 @@ # You should have received a copy of the GNU Lesser General Public # License along with this program. If not, see . -source [file join [file dirname $::argv0] keks.tcl] -namespace import KEKS::* +package require KEKS + +namespace eval KEKS::Schema { + +set version 0.1.0 proc TAKE {k} { if {[string is digit $k]} { @@ -42,33 +45,11 @@ proc SCHEMA {s} {subst {LIST {{STR S} {STR $s}}}} proc TIMEPREC {p} {subst {LIST {{STR TP} {INT $p}}}} proc UTC {} {return {LIST {{STR UTC}}}} -proc schema-process {v} { - upvar _pairs _pairs - foreach {name cmds} $v { - set _cmds {} - if {$name == "schema-include"} { - set fd [open [file join $cmds]] - set inc [read $fd] - close $fd - schema-process $inc - continue - } - foreach cmd $cmds {eval $cmd} - lappend _pairs $name [list LIST $_cmds] - } -} - -proc schemas {v} { - set _pairs {} - schema-process $v - MAP $_pairs -} - set timeprecArgs [dict create s 0 ms 3 us 6 ns 9 ps 12 fs 15 as 18] set knownTypes {bin blob bool hexlet int list magic map nil set str tai} proc field {k types args} { - upvar _cmds _cmds + upvar _cmds _cmds buf buf if {[lindex $types 0] == "with"} { lappend _cmds [TAKE $k] lappend _cmds [SCHEMA [lindex $types 1]] @@ -115,7 +96,7 @@ proc field {k types args} { set i [lsearch -glob $args "prec=*"] if {$i != -1} { set p [string range [lindex $args $i] 5 end] - global timeprecArgs + variable timeprecArgs set p [dict get $timeprecArgs $p] lappend _cmds [TAKE $k] lappend _cmds [TIMEPREC $p] @@ -134,7 +115,7 @@ proc field {k types args} { set s [lindex [lindex $args $i] 1] lappend _cmds [TAKE $k] lappend _cmds [EACH] - global knownTypes + variable knownTypes if {[lsearch -exact $knownTypes $s] == -1} { lappend _cmds [SCHEMA $s] } { @@ -143,8 +124,43 @@ proc field {k types args} { } } -set _schema {} -foreach f $::argv {lappend _schema schema-include $f} -MAGIC schema -schemas $_schema -puts [binary encode hex $::KEKS::buf] +proc process {v} { + upvar _pairs _pairs buf buf + foreach {name cmds} $v { + set _cmds {} + if {$name == "schema-include"} { + set fd [open [file join $cmds]] + set inc [read $fd] + close $fd + process $inc + continue + } + foreach cmd $cmds {eval $cmd} + lappend _pairs $name [list LIST $_cmds] + } +} + +proc do {v} { + upvar buf buf + set _pairs {} + process $v + MAP $_pairs +} + +namespace export TAKE EXISTS !EXISTS EACH EQ TYPE GT LT SCHEMA TIMEPREC UTC +namespace export do process field + +} + +package provide KEKS::Schema $KEKS::Schema::version + +namespace import KEKS::* + +if {[info exists argv0] && ([file tail [info script]] eq [file tail $argv0])} { + set _schema {} + foreach f $::argv {lappend _schema schema-include $f} + set buf "" + MAGIC schema + KEKS::Schema::do $_schema + puts [binary encode hex $buf] +} diff --git a/tcl/test-vector.tcl b/tcl/test-vector.tcl index 2b47135..3dbcf08 100644 --- a/tcl/test-vector.tcl +++ b/tcl/test-vector.tcl @@ -1,4 +1,4 @@ -source keks.tcl +package require KEKS namespace import KEKS::* set buf "" -- 2.48.1