Anonymous user
Simple database: Difference between revisions
no edit summary
(→{{header|Python}}: Add example) |
No edit summary |
||
Line 573:
(main (argv))</lang>
=={{header|Forth}}==
Simple in-memory database. Load/dump database from/to a file.
Works in GNU Forth 0.7.0 shell. Example file `test.sdb':
+: betty 1974.03.03;coworker;reading;
+: geea 1980.01.01;friend;sketch writer;
+: tom 1991.03.07;family member;reading;
+: alice 1987.09.01;coworker;classical music;
+: gammaQ3.14 3045.09.09;friend;watch movies, star walking;
Example usage:
$ gforth sdb.fs
help
[ -erased help message- ]
load test.sdb ok
.keys
gammaQ3.14 alice tom geea betty ok
betty .record betty 1974.03.03;coworker;reading; ok
newline geea .record
geea 1980.01.01;friend;sketch writer; ok
+: theea 1979.04.05;coworker;astronomy; ok
newline .bydate
gammaQ3.14 3045.09.09;friend;watch movies, star walking;
tom 1991.03.07;family member;reading;
alice 1987.09.01;coworker;classical music;
geea 1980.01.01;friend;sketch writer;
theea 1979.04.05;coworker;astronomy;
betty 1974.03.03;coworker;reading;
dump t2.sdb ok
bye
$
$ cat t2.sdb
+: betty 1974.03.03;coworker;reading;
+: geea 1980.01.01;friend;sketch writer;
+: tom 1991.03.07;family member;reading;
+: alice 1987.09.01;coworker;classical music;
+: gammaQ3.14 3045.09.09;friend;watch movies, star walking;
+: theea 1979.04.05;coworker;astronomy;
$
<lang forth>\ sdb.fs Simple database. Gforth 0.7.0 specific
' noop is bootmessage
wordlist constant USER: \ USER functions
wordlist constant SDB \ DB keys
wordlist constant FIELDS \ DB fields
\ MACROS
: |comp| ( MACRO: | code to be compiled | )
char parse evaluate ; immediate
: LIST ( node -- ) ]] BEGIN @ dup WHILE >R [[ ; immediate
: LOOP-LIST ( -- ) ]] R> REPEAT drop [[ ; immediate
: UNLIST ( -- ) POSTPONE rdrop ; immediate
\ Helper words
: .; [char] ; emit ;
: !+ dup cell+ -rot ! ;
: ($+) ( cas us cad ud -- cad us+ud ; append source string to destination )
swap >R 2dup + R> swap >R tuck + swap >R swap move R> R> ;
\ --- Working Record Fields
current @ FIELDS current !
2variable person
2variable birthday
2variable relationship
2variable hobby
current ! FIELDS >order
\ --- Ring list
: new-node ( -- node ; root of circular list )
here dup , ;
: do-link ( node new-node -- ; do link after current node )
over @ over ! swap ! ;
: empty-ring? ( node -- f ) dup @ = ;
: RING ( node -- ) ]] dup BEGIN @ 2dup <> WHILE 2>R [[ ; immediate
: LOOP-RING ( -- ) ]] 2R> REPEAT 2drop [[ ; immediate
: UNRING ( -- ) postpone 2RDROP ; immediate
:noname
s" " person 2! s" 9999.01.01" birthday 2! s" " relationship 2! s" " hobby 2! ;
new-node swap , CONSTANT OLD
\ --- Insertion into ring
: node>xt ( node -- xt ) cell+ @ ;
: bday@ ( node -- ca u ) node>xt execute birthday 2@ ;
: datecmp ( node node -- -1|0|1 ) bday@ rot bday@ compare ;
: search-by-date ( new-node node -- node' ; Linear search by birth date )
dup
RING ( new-node node )
over I datecmp 0<
IF nip UNRING exit
ELSE drop I THEN
LOOP-RING nip ;
: insert-ordered ( new-node -- )
OLD dup empty-ring? 0=
IF over swap search-by-date THEN swap do-link ;
\ --- Field compiling
: fld: [char] ; parse postpone sliteral ; immediate
: _sdb-walk ( MACRO: | xt[--] -- | )
]] here dup SDB cell+
LIST I name>int swap !+ LOOP-LIST [[ 1 cells ]] literal -
DO I @ |comp| [[ -1 cells ]] literal +LOOP [[ ; immediate
\ --- USER definitions
user: >order current @ USER: current !
: bye bye ;
: .s .s ;
: newline cr ;
: godb SDB >order ;
: .keys SDB wordlist-words ;
: .person person 2@ type ;
: .birthday birthday 2@ type ;
: .relationship relationship 2@ type ;
: .hobby hobby 2@ type ;
: .record .person 1 spaces .birthday .; .relationship .; .hobby .; ;
: .last SDB cell+ @ dup
IF name>int execute .record ELSE drop THEN ;
2variable category
: .lastbycategory ( "field-name" -- )
here 0 category 2! parse-name FIELDS search-wordlist
IF sdb cell+
LIST ( xt )
I name>int execute dup execute 2@ category 2@ 2swap search nip nip 0=
IF .record cr dup execute 2@ category 2@ ($+) category 2! THEN
LOOP-LIST drop
ELSE cr ." No such category!" cr THEN ;
: .bydate ( -- )
OLD RING I node>xt execute .record cr LOOP-RING ;
: .sdb _sdb-walk | execute .record cr | ;
: sdb-dump _sdb-walk | execute ." +: " .record cr | ;
: dump ( "db-file" -- )
parse-name w/o
CREATE-FILE throw dup
['] sdb-dump swap OUTFILE-EXECUTE
CLOSE-FILE throw ;
: load ( "db-file" -- ) include ;
: +: ( "person birth-day;relationship;hobby; -- )
new-node dup cell+ >R 0 , \ post `xt'
current @ SDB current ! \ compile into `sdb' wordlist
: latestxt dup R> ! \ fix-up `xt'
]] literal >name name>string person 2! fld: birthday 2! fld: relationship 2! fld: hobby 2! ; [[
current !
insert-ordered ;
: HELP cr
cr ." KEYWORDS: " USER: wordlist-words cr ." ---"
cr ." Prefix `.' means print"
cr ." To add a record, type: +: name birthday;relationship;hobby;"
cr cr ;
current !
SEAL godb</lang>
=={{header|Go}}==
| |||