├── README
├── clp-pvm
├── c
│ ├── c-hdf.c
│ ├── mk
│ │ ├── make.orig
│ │ └── make-pvm
│ ├── mi.c
│ ├── ts-agent.c
│ ├── hdf-agent.c
│ ├── c-frt.c
│ ├── c-lnd.c
│ ├── tsd-agent.c
│ ├── c-msc.c
│ ├── clipsmain.c
│ ├── c-acc.c
│ └── clips-sc-main.c
├── clp
│ ├── mf.clp
│ ├── misc-fnc.clp
│ ├── lib.clp
│ ├── pvm.clp
│ ├── sub.clp
│ ├── proj.clp
│ ├── eval.clp
│ ├── param.clp
│ ├── param-lib.clp
│ ├── rul.clp
│ ├── task.clp
│ └── array.clp
└── README
├── csd.auth.gr
├── R-DEVICE
│ ├── rdf.clp
│ ├── manual.pdf
│ ├── test
│ │ ├── question0.clp
│ │ ├── question1.clp
│ │ ├── question3.clp
│ │ ├── question2.clp
│ │ ├── question4.clp
│ │ ├── question5.clp
│ │ ├── run-test.bat
│ │ ├── question6.clp
│ │ ├── question7.clp
│ │ ├── question8.clp
│ │ ├── dmoz.rdf
│ │ ├── dctype.rdf
│ │ └── dc.rdf
│ ├── arp-only.bat
│ ├── arp.bat
│ ├── r-device.bat
│ ├── restore-classes.clp
│ ├── translation-rules.clp
│ ├── classes.clp
│ ├── aggregates.clp
│ ├── main.clp
│ ├── stratification.clp
│ ├── import.clp
│ └── types.clp
├── o-device
│ ├── j2cf.jar
│ ├── description.txt
│ ├── NOTICE.txt
│ ├── LICENSE.txt
│ ├── readme.txt
│ ├── create-classes.clp
│ ├── exec.bat
│ ├── .note
│ ├── how-to-use.txt
│ ├── order.clp
│ ├── prepare.bat
│ ├── create-objects.clp
│ ├── config.bat
│ ├── release_notes.txt
│ ├── vocabulary-abbr.clp
│ ├── vocabulary.clp
│ └── global.clp
├── .note~
└── .note
├── pontdi2km.sed
├── pins2km.sed
├── f.clp
├── .note
└── u.clp
/README:
--------------------------------------------------------------------------------
1 | Some collected CLIPS code, more to come
2 |
--------------------------------------------------------------------------------
/clp-pvm/c/c-hdf.c:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MBcode/CLIPSmsc/HEAD/clp-pvm/c/c-hdf.c
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/rdf.clp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MBcode/CLIPSmsc/HEAD/csd.auth.gr/R-DEVICE/rdf.clp
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/manual.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MBcode/CLIPSmsc/HEAD/csd.auth.gr/R-DEVICE/manual.pdf
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/j2cf.jar:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/MBcode/CLIPSmsc/HEAD/csd.auth.gr/o-device/j2cf.jar
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question0.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (? (dc:title ?t))
3 | =>
4 | (result (title ?t))
5 | )
6 |
7 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question1.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dc:title ?t))
3 | =>
4 | (result (title ?t))
5 | )
6 |
7 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/arp-only.bat:
--------------------------------------------------------------------------------
1 | java -cp "c:\Program Files\arp\arp.jar;c:\Program Files\xerces\xerces.jar" com.hp.hpl.jena.rdf.arp.NTriple %1.rdf > %1.n3
2 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question3.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t))
3 | =>
4 | (result (title ?t))
5 | )
6 |
7 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question2.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dc:title ?t) (dmoz:newsGroup ?n))
3 | =>
4 | (result (title ?t) (news ?n))
5 | )
6 |
7 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/description.txt:
--------------------------------------------------------------------------------
1 |
2 | For more details about O-DEVICE, please read the corresponding paper
3 |
4 | http://doi.ieeecomputersociety.org/10.1109/TKDE.2007.190699
5 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/NOTICE.txt:
--------------------------------------------------------------------------------
1 |
2 | -O-DEVICE makes use of the Jena API (http://jena.sourceforge.net/)
3 | -O-DEVICE makes use of the CLIPS rule engine (http://clipsrules.sourceforge.net/)
--------------------------------------------------------------------------------
/pontdi2km.sed:
--------------------------------------------------------------------------------
1 | / \"/s/$/))/
2 | / \"/s// (description (\"/
3 | /(defclass /s//(defclass_/
4 | /(defclass_/s/$/ /
5 | /(defclass_/s/ / has /
6 | /(defclass_/s//(/
7 | /(is-a /s/$/))/
8 | /(is-a /s// (superclasses (/
9 |
--------------------------------------------------------------------------------
/pins2km.sed:
--------------------------------------------------------------------------------
1 | / of /s// of /
2 | /^ (/s//\t(/
3 | /\t(/s/)$/))/
4 | /\t(/s/ / (/
5 | /^(\[/s/(\[/(*/
6 | /\] of/s/$/))/
7 | /\] of /s// has (instance-of (/
8 | / (\[/s/\]))/))/
9 | / (\[/s// (*/
10 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/arp.bat:
--------------------------------------------------------------------------------
1 | "c:\Program Files\Libwww\loadtofile.exe" %1 -o %2.rdf
2 | java -cp "c:\Program Files\arp\arp.jar;c:\Program Files\xerces\xerces.jar" com.hp.hpl.jena.rdf.arp.NTriple %1 > %2.n3
3 | rem pause
4 |
--------------------------------------------------------------------------------
/clp-pvm/clp/mf.clp:
--------------------------------------------------------------------------------
1 | (defclass ConsCell
2 | (is-a INITIAL-OBJECT)
3 | (role concrete)
4 | (pattern-match reactive)
5 |
6 | (slot first (create-accessor read-write))
7 | (slot rest (create-accessor read-write))
8 | )
9 |
10 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question4.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t) (dmoz:link $? ?l $?))
3 | ?l <- (dmoz:ExternalPage (dc:title ?lt))
4 | =>
5 | (result (title ?t) (link_title ?lt))
6 | )
7 |
8 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question5.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dmoz:catid "4") (dc:title ?t) (dmoz:link $? ?l $?))
3 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dc:description ?d))
4 | =>
5 | (result (title ?t) (link_title ?lt) (link_desc ?d))
6 | )
7 |
8 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/run-test.bat:
--------------------------------------------------------------------------------
1 | (set-verbose off)
2 | (load-rdf "structure" local)
3 | (load-rdf "content" local)
4 | (import)
5 | (r-device "question8.clp")
6 | (go)
7 | (do-for-all-instances ((?p result)) TRUE (progn (printout t crlf)(send ?p print) (printout t crlf)))
8 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question6.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dmoz:catid ~"4") (dc:title ?t) (dmoz:link $? ?l $?))
3 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dc:description ?d) (dmoz:priority 1))
4 | =>
5 | (result (title ?t) (link_title ?lt) (link_desc ?d))
6 | )
7 |
8 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question7.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dc:title ?top) (dmoz:narrow $? ?n $?))
3 | ?n <- (dmoz:Topic (dc:title ?t) (dmoz:link $? ?l $?))
4 | ?l <- (dmoz:ExternalPage (dc:title ?lt))
5 | =>
6 | (result (top_title ?top) (title ?t) (link_title ?lt))
7 | )
8 |
9 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/question8.clp:
--------------------------------------------------------------------------------
1 | (deductiverule
2 | (dmoz:Topic (dc:title ?top) (dmoz:narrow $? ?n $?))
3 | ?n <- (dmoz:Topic (dc:title ?t) (dmoz:link $? ?l $?))
4 | ?l <- (dmoz:ExternalPage (dc:title ?lt) (dmoz:priority 1))
5 | =>
6 | (result (top_title ?top) (title ?t) (link_title ?lt))
7 | )
8 |
9 |
--------------------------------------------------------------------------------
/clp-pvm/c/mk/make.orig:
--------------------------------------------------------------------------------
1 | #XXX: fix these. DO they need slashes?
2 | DESTDIR=
3 | PREFIX=/usr/local
4 |
5 | all :
6 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) all
7 |
8 | clean :
9 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) clean
10 |
11 | install :
12 | cd src && make DESTDIR=$(DESTDIR) PREFIX=$(PREFIX) install
13 |
--------------------------------------------------------------------------------
/clp-pvm/README:
--------------------------------------------------------------------------------
1 | I haven't looked at this in years, &should of put it on the clips list then.
2 | It has been long forgotten/tossed, so hopefully someone will want to revivie it.
3 | I've been meaning to clean up similar code in Lisp, &see if generic ffi's are easier than clips's.
4 | Not sure of ownership/etc, other than it was made w/public funds(by me)&forgotten.
5 |
--------------------------------------------------------------------------------
/clp-pvm/c/mi.c:
--------------------------------------------------------------------------------
1 | MakeInstance("(gensym) of THECLASS")
2 | > MakeInstance(" of THECLASS")
3 | >
4 | >
5 | >Give a syntax errors for the make-instance function. Is there a way to create
6 | >instances from C without knowing the name beforehand?
7 |
8 | This was an oversight in CLIPS 6.0.2 and will be fixed later. In the
9 | meantime, use the following workaround:
10 |
11 | #include "miscfun.h"
12 |
13 | char myBuffer[80];
14 |
15 | sprintf(myBuffer,"%s of THECLASS",ValueToString(GenSymStarFunction()));
16 | MakeInstance(myBuffer);
17 |
18 |
19 | Brian Donnell
20 | NASA/JSC
21 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/LICENSE.txt:
--------------------------------------------------------------------------------
1 | Copyright 2009 Georgios Meditskos
2 |
3 | Licensed under the Apache License, Version 2.0 (the "License");
4 | you may not use this file except in compliance with the License.
5 | You may obtain a copy of the License at
6 |
7 | http://www.apache.org/licenses/LICENSE-2.0
8 |
9 | Unless required by applicable law or agreed to in writing, software
10 | distributed under the License is distributed on an "AS IS" BASIS,
11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 | See the License for the specific language governing permissions and limitations
13 | under the License.
--------------------------------------------------------------------------------
/csd.auth.gr/.note~:
--------------------------------------------------------------------------------
1 | R-DEVICE code from my last zip of it: -rw-r--r-- 1 bobak 230K Feb 27 2014 r-device.zip
2 | also have: -rw-r--r-- 1 bobak 7.4K Jan 12 13:59 r-device-compiled-rule-class-instances-defeasible-r-device-rules-caleb.clp
3 | O-Device from a copy of: -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar
4 | There might be more, but this is what I can find right now; might be @archive.org's wayback machine/etc too?
5 | Probably more at: http://lpis.csd.auth.gr/projects.asp http://lpis.csd.auth.gr/systems.asp
6 | http://lpis.csd.auth.gr/research.asp?areaID=3 http://lpis.csd.auth.gr/systems/device.html
7 | http://lpis.csd.auth.gr/systems/o-device/o-device.html
8 | http://lpis.csd.auth.gr/systems/r-device.html has r-device.zip
9 | http://lpis.csd.auth.gr/systems/dr-device.html
10 | http://lpis.csd.auth.gr/systems/VDR-Device_Tutorial.htm
11 | & http://lpis.csd.auth.gr/systems/x-device.html http://lpis.csd.auth.gr/systems/practic.html
12 |
--------------------------------------------------------------------------------
/csd.auth.gr/.note:
--------------------------------------------------------------------------------
1 | R-DEVICE code from my last zip of it: -rw-r--r-- 1 bobak 230K Feb 27 2014 r-device.zip
2 | also have: -rw-r--r-- 1 bobak 7.4K Jan 12 13:59 r-device-compiled-rule-class-instances-defeasible-r-device-rules-caleb.clp
3 | O-Device from a copy of: -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar
4 | There might be more, but this is what I can find right now; might be @archive.org's wayback machine/etc too?
5 | Probably more at: http://lpis.csd.auth.gr/projects.asp http://lpis.csd.auth.gr/systems.asp
6 | http://lpis.csd.auth.gr/research.asp?areaID=3 http://lpis.csd.auth.gr/systems/device.html
7 | http://lpis.csd.auth.gr/systems/r-device.html has r-device.zip
8 | http://lpis.csd.auth.gr/systems/o-device/o-device.html
9 | http://lpis.csd.auth.gr/systems/dr-device.html
10 | http://lpis.csd.auth.gr/systems/VDR-Device_Tutorial.htm
11 | & http://lpis.csd.auth.gr/systems/x-device.html http://lpis.csd.auth.gr/systems/practic.html
12 | http://lpis.csd.auth.gr/ontologies/ontolist.html
13 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/r-device.bat:
--------------------------------------------------------------------------------
1 | (defglobal ?*R-DEVICE_PATH* = "C:\\Program Files\\R-DEVICE\\")
2 | (load* (str-cat ?*R-DEVICE_PATH* "rdf.clp"))
3 | (load* (str-cat ?*R-DEVICE_PATH* "classes.clp"))
4 | (load* (str-cat ?*R-DEVICE_PATH* "auxiliary-functions.clp"))
5 | (load* (str-cat ?*R-DEVICE_PATH* "class-functions.clp"))
6 | (load* (str-cat ?*R-DEVICE_PATH* "aggregates.clp"))
7 | (load* (str-cat ?*R-DEVICE_PATH* "types.clp"))
8 | (load* (str-cat ?*R-DEVICE_PATH* "oo-querying.clp"))
9 | (load* (str-cat ?*R-DEVICE_PATH* "second-order.clp"))
10 | (load* (str-cat ?*R-DEVICE_PATH* "stratification.clp"))
11 | (load* (str-cat ?*R-DEVICE_PATH* "translation.clp"))
12 | (load* (str-cat ?*R-DEVICE_PATH* "translation-rules.clp"))
13 | (load* (str-cat ?*R-DEVICE_PATH* "main.clp"))
14 | (load* (str-cat ?*R-DEVICE_PATH* "rdf-auxiliary.clp"))
15 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp"))
16 | (load* (str-cat ?*R-DEVICE_PATH* "import.clp"))
17 | (load* (str-cat ?*R-DEVICE_PATH* "export.clp"))
18 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp"))
19 | (reset)
20 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/readme.txt:
--------------------------------------------------------------------------------
1 |
2 | Details
3 | =======
4 | O-DEVICE is a CLIPS-based rule program that transforms OWL
5 | ontologies into the COOL model of CLIPS. It can be used
6 | either as a standalone module by loading it directly into
7 | CLIPS, or through the JO-DEVICE JAVA API
8 | (https://sourceforge.net/projects/o-device/files/).
9 |
10 | Dependencies
11 | ============
12 | - At runtime, the standalone O-DEVICE requires the j2cf.jar
13 | (https://sourceforge.net/projects/o-device/files/) and the
14 | JENA 2.6 API libraries (http://jena.sourceforge.net/). The j2cf.jar
15 | should exist under the odevice distribution folder (odevice\\j2cf.jar)
16 | and the JENA libraries should exist in a folder lib under the odevice
17 | distribution folder (odevice\\lib\\..)
18 | - The CLIPS executable (http://clipsrules.sourceforge.net/)
19 |
20 | There is a preconfigured distribution of the standalone O-DEVICE at
21 | https://sourceforge.net/projects/o-device/files/
22 |
23 | For more details about O-DEVICE, please read the corresponding paper
24 | http://doi.ieeecomputersociety.org/10.1109/TKDE.2007.190699
--------------------------------------------------------------------------------
/f.clp:
--------------------------------------------------------------------------------
1 | ;load this file before my https://github.com/MBcode/CLIPSmsc/blob/master/utils.clp mike.bobak@gmail.com
2 | ;e.g. alias fclu 'rlwrap fz_clips -l ~/bin/fzutils.clp' where: cat f.clp utils.clp >fzutils.clp
3 | ;https://github.com/rorchard/FuzzyCLIPS seems to have been forked from an older clips version
4 | (deffunction string-to-field (?in) (eval ?in)) ;added as fz_clips doesn't have it
5 | ;docs on it's use at: http://mma.perso.eisti.fr/HTML-SE/Programme/fzdocs.pdf
6 | ;also http://thor.info.uaic.ro/~dcristea/cursuri/SE/fzdocs.pdf
7 | ;http://alumni.cs.ucr.edu/~vladimir/cs171/quickfuzzy.pdf
8 | ;http://math.haifa.ac.il/robotics/Presentations/pdf/Ch7_FuzzyLogic.PDF
9 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/fuzzyShower.html
10 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/fuzzyShowerJess.html
11 | ;http://www.graco.unb.br/alvares/DOUTORADO/omega.enm.unb.br/pub/doutorado/disco2/ai.iit.nrc.ca/IR_public/fuzzy/FuzzyTruck.html
12 | ;http://www.cs.dartmouth.edu/~spl/publications/fuzzy%20talk/FuzzyPendulum.html
13 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/create-classes.clp:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; # Rules for generating the COOL classes
3 | ;;; ######################################################################################
4 |
5 | ;;; owl:Thing is the superclass of all the classes
6 | (defrule realize-owl:Thing
7 | (declare (salience 9910))
8 | (goal (name delegators-defined))
9 | ?T <- (CLASS (name ?term&:(eq ?term ?*owl:Thing*))(slots $?slots)(materialized FALSE))
10 | =>
11 | (define-class ?*owl:Thing* (create$ USER) $?slots)
12 | (modify ?T (materialized TRUE))
13 | )
14 |
15 | ;;; create the class. Note that the restriction classes do not
16 | ;;; participate physically in the OO model
17 | (defrule realize-class
18 | (declare (salience 9909))
19 | (goal (name delegators-defined))
20 | ?CL <- (CLASS (name ?c)(subclass $?superclasses)(slots $?slots)(materialized FALSE))
21 | (not (CLASS (name ?c2 & ~?c &:(member$ ?c2 $?superclasses))(materialized FALSE)))
22 | =>
23 | (define-class ?c $?superclasses $?slots)
24 | (modify ?CL (materialized TRUE))
25 | )
26 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/exec.bat:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; Load the generated files of O-DEVICE and the necessary O-DEVICE source code.
3 | ;;; ######################################################################################
4 | (set-dynamic-constraint-checking FALSE)
5 | (object-pattern-match-delay
6 | (load* (str-cat ?*src-folder* "global.clp"))
7 | (load* (str-cat ?*src-folder* "functions.clp"))
8 | (load* (str-cat ?*src-folder* "order.clp"))
9 | (load* ?*class-file*)
10 | (load-facts ?*fact-file*)
11 | (load* ?*rule-file*)
12 | (restore-instances ?*object-file*))
13 | (set-dynamic-constraint-checking TRUE)
14 |
15 | (assert (goal (name delegators-defined)))
16 |
17 | ;use the 'build' function to define the rule in JAVA
18 | (defrule $refresh$
19 | (declare (salience 8999))
20 | ?UP <- (UPDATE (refresh TRUE))
21 | =>
22 | (debug info "updating...")
23 | (modify ?UP (refresh FALSE))
24 | (load* ?*rule-file*)
25 | (progn$ (?r ?*rule-files*)
26 | (printout t test crlf)
27 | (load* ?r))
28 | (run))
29 |
30 | (run)
31 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/.note:
--------------------------------------------------------------------------------
1 | total 2.6M
2 | -rw-r--r-- 1 bobak 838K Apr 6 2008 CLIPSDOS.exe
3 | -rw-r--r-- 1 bobak 850K Apr 6 2008 CLIPSWin.exe
4 | -rw-r--r-- 1 bobak 2.4K Oct 13 2009 config.bat
5 | -rw-r--r-- 1 bobak 1015 Aug 30 2009 create-classes.clp
6 | -rw-r--r-- 1 bobak 2.2K Sep 7 2009 create-objects.clp
7 | -rw-r--r-- 1 bobak 41K Oct 9 2009 create-templates.clp
8 | -rw-r--r-- 1 bobak 135 Aug 27 2009 description.txt
9 | -rw-r--r-- 1 bobak 1001 Oct 11 2009 exec.bat
10 | -rw-r--r-- 1 bobak 55K Oct 13 2009 functions.clp
11 | -rw-r--r-- 1 bobak 7.0K Oct 13 2009 global.clp
12 | -rw-r--r-- 1 bobak 1.2K Aug 27 2009 how-to-use.txt
13 | -rw-r--r-- 1 bobak 27K Oct 14 2009 j2cf.jar
14 | -rw-r--r-- 1 bobak 576 Aug 20 2009 LICENSE.txt
15 | -rw-r--r-- 1 bobak 151 Aug 20 2009 NOTICE.txt
16 | -rw-r--r-- 1 bobak 664K Feb 27 2014 odevice_v2.rar
17 | -rw-r--r-- 1 bobak 1.7K Oct 11 2009 order.clp
18 | -rw-r--r-- 1 bobak 1.9K Oct 14 2009 prepare.bat
19 | -rw-r--r-- 1 bobak 1022 Aug 27 2009 readme.txt
20 | -rw-r--r-- 1 bobak 2.9K Oct 14 2009 release_notes.txt
21 | -rw-r--r-- 1 bobak 25K Oct 6 2009 rule-generator.clp
22 | -rw-r--r-- 1 bobak 4.5K Oct 9 2009 vocabulary-abbr.clp
23 | -rw-r--r-- 1 bobak 7.1K Oct 9 2009 vocabulary.clp
24 |
--------------------------------------------------------------------------------
/.note:
--------------------------------------------------------------------------------
1 | do NOT use pins2km nor km-tax considering malecoli cl-kb then lisa.sf.net
2 | cl-kb just has pprj&xml file, but can export the pont&pins but just sys-slots vs. full hierarchy
3 | change pprj type to pont/pins looses the same info; assume it was the experimental-xml file,might be able to convert this
4 |
5 | Look at r-device code again, when I can, as a way to get triples out &more?; though protege has mult save-as/transform opts
6 | Found it after the o-device code; it still loads, might try o code next; could be useful, but would still like2get back2lisp
7 |
8 | using agraph&gruff and asking for connections might be nice
9 |
10 | ;still prolog-tab &km-tax if it worked better
11 | also
12 | pins2km .sed
13 | small fix to sed, can handle some more files, but use clean input
14 | it turns out that doing an agrep to get a subset of instances can break some(long?)lines
15 | 100+M files take @least on the order of the time(longer) that clips takes to load ;not sure abt lisa
16 |
17 | ;aside i've always wanted a fwd chainer on agraph, more like lispworks knowledge-based product
18 |
19 | find-ins-str was written&commited on another machine, but didn't show up; have to check on this
20 |
21 | save*ins2 can be useful to restrict what to load, and for greping seperated files
22 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/restore-classes.clp:
--------------------------------------------------------------------------------
1 | (defrule restore-classes
2 | (goal restore-classes)
3 | ?x <- (redefined-class (name ?class) (isa-slot $?super-classes) (slot-definitions $?slot-defs) (class-refs-defaults $?class-refs) (aliases-defaults $?aliases))
4 | (not (redefined-class (name ?super-class&:(member$ ?super-class $?super-classes))))
5 | =>
6 | (verbose "Restoring class: " ?class crlf)
7 | (my-build (str-cat$
8 | "(" defclass ?class
9 | "(" is-a
10 | (if (> (length$ $?super-classes) 0)
11 | then
12 | $?super-classes
13 | else
14 | rdfs:Resource
15 | )
16 | ")"
17 | $?slot-defs
18 | "(" multislot class-refs
19 | "(" source composite ")"
20 | "(" default (unique-pairs (create$ $?class-refs (collect-defaults class-refs $?super-classes))) ")"
21 | ")"
22 | "(" multislot aliases
23 | "(" source composite ")"
24 | "(" default (unique-pairs (create$ $?aliases (collect-defaults aliases $?super-classes))) ")"
25 | ")"
26 | ")"
27 | ))
28 | (retract ?x)
29 | )
30 |
31 |
32 | (defrule restore-instances
33 | (goal restore-classes)
34 | (not (redefined-class))
35 | ?x <- (backup-instances ?filename)
36 | =>
37 | (restore-instances ?filename)
38 | (retract ?x)
39 | (remove ?filename)
40 | )
41 |
42 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/how-to-use.txt:
--------------------------------------------------------------------------------
1 |
2 | How to Use
3 | =============
4 | -> Modify the file odevice/config.bat in order to
5 | match your configuration. In principle, only the
6 | folder path of O-DEVICE needs to be defined.
7 |
8 | -> Add to the odevice/prepare.bat file the ontology(ies)
9 | you want to transform using the load-ontology function, e.g.
10 | (load-ontology "http://www..." "http://www" "file:c:/work/..")
11 |
12 | -> Start the CLIPS rule engine
13 |
14 | -> Execute the odevice/config.bat file, i.e.
15 | CLIPS> (batch* odevice/config.bat)
16 |
17 | -> Execute the odevice/prepare.bat file, i.e.
18 | CLIPS> (batch* odevice/prepare.bat)
19 |
20 | -> Execute the (clear) function of CLIPS or run a complete
21 | new instance of the CLIPS rule engine.
22 |
23 | -> Execute the odevice/exec.bat file, i.e.
24 | CLIPS> (batch* odevice/exec.bat)
25 |
26 | -> CLIPS contains now the OO model of the ontologies,
27 | as well as some entailment rules in order to preserve
28 | some semantics of OWL in the OO model. Any new instance
29 | should be created using the O-DEVICE function
30 | (owl-make-instance instance-name class-name) and the
31 | values should be inserted into object slots using the
32 | O-DEVICE function (owl-insert-value instance-name slot value).
33 |
34 |
--------------------------------------------------------------------------------
/clp-pvm/c/ts-agent.c:
--------------------------------------------------------------------------------
1 | /*---------------------------------------------------------------------------
2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes:
3 | // "C" Language Integrated Production System, CLIPS Version 6.02
4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center
5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules
6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada
7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL
8 | /----------------------------------------------------------------------------*/
9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)"
10 | or ts-agt -r "(batch b)" where the file b has the above commands*/
11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */
12 |
13 | /*c-l-fncs.c c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/
14 |
15 | #include "c-misc-fncs.c"
16 | #include "c-pvm-fncs.c"
17 | #include "c-l-fncs.c"
18 | #include "clipsmain.c"
19 |
20 | /*---------------------------------------------------------------USERFUNCTIONS*/
21 | VOID UserFunctions()
22 | {
23 | #include "c-misc-defs.c"
24 | #include "c-pvm-defs.c"
25 | /*defines for c-l-fncs.c
26 | DefineFunction2("tpn_n_out",'i',PTIF tpn_n_out,"tpn_n_out","44ikuik");
27 | DefineFunction2("tpn_n_in",'i',PTIF tpn_n_in,"tpn_n_in","44ikuik");
28 | */
29 | DefineFunction2("tpn_n_c",'i',PTIF tpn_n_c,"tpn_n_c","45ikuikk");
30 | }
31 | /*----------------------------------------------------------------EOF*/
32 |
--------------------------------------------------------------------------------
/u.clp:
--------------------------------------------------------------------------------
1 | ;This was at the end of my utils.clp at one point, from this work: http://lpis.csd.auth.gr/systems/r-device/manual.pdf
2 | ;-----------------------------------------EOF
3 | (defglobal ?*R-DEVICE_PATH* = "\/Users\/bobak\/Documents\/downloads\/ai\/prot\/rdf\/R-DEVICE\/")
4 | (deffunction loadr-device ()
5 | "r-device rdf code loading"
6 | (load* (str-cat ?*R-DEVICE_PATH* "rdf.clp"))
7 | (load* (str-cat ?*R-DEVICE_PATH* "classes.clp"))
8 | (load* (str-cat ?*R-DEVICE_PATH* "auxiliary-functions.clp"))
9 | (load* (str-cat ?*R-DEVICE_PATH* "class-functions.clp"))
10 | (load* (str-cat ?*R-DEVICE_PATH* "aggregates.clp"))
11 | (load* (str-cat ?*R-DEVICE_PATH* "types.clp"))
12 | (load* (str-cat ?*R-DEVICE_PATH* "oo-querying.clp"))
13 | (load* (str-cat ?*R-DEVICE_PATH* "second-order.clp"))
14 | (load* (str-cat ?*R-DEVICE_PATH* "stratification.clp"))
15 | (load* (str-cat ?*R-DEVICE_PATH* "translation.clp"))
16 | (load* (str-cat ?*R-DEVICE_PATH* "translation-rules.clp"))
17 | (load* (str-cat ?*R-DEVICE_PATH* "main.clp"))
18 | (load* (str-cat ?*R-DEVICE_PATH* "rdf-auxiliary.clp"))
19 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp"))
20 | (load* (str-cat ?*R-DEVICE_PATH* "import.clp"))
21 | (load* (str-cat ?*R-DEVICE_PATH* "export.clp"))
22 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp"))
23 | (reset)
24 | )
25 | ;---------------------------------------------------------
26 | ;This is still in utils.clp but not every machine has the other code.
27 | ;Even though Protege can work between formats, might still use this.
28 | ; 1plc would be to save gen ins ;as well as taking triples2frames
29 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/order.clp:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; Manage class is-a ordering. In some cases, especially when there is a complex
3 | ;;; subclass hierarchy, an error may occur relevant to the class precedence list
4 | ;;; that CLIPS maintains. This set of rules holds the order of the classes in the
5 | ;;; is-a constraint and it makes potential reorderings to the initially defined
6 | ;;; subclass values of the CLASS facts, in order to prevent such errors.
7 | ;;; ######################################################################################
8 |
9 | ;;; this rule checks for mutual subclass relationships between two classes
10 | ;;; and stops the execution
11 | (defrule $detect-cyrcles
12 | (declare (salience 9916))
13 | (goal (name delegators-defined))
14 | (strong-order (c1 ?x)(c2 ?y))
15 | (strong-order (c1 ?y)(c2 ?x))
16 | =>
17 | (debug error "Subclass circle has been detected: " ?x ", " ?y)
18 | )
19 | ;;;
20 | (defrule $strong-order "subclass order"
21 | (declare (salience 9915))
22 | (goal (name delegators-defined))
23 | (CLASS (name ?c)(subclass $? ?sup&~?c $?))
24 | (not (strong-order (c1 ?c)(c2 ?sup)))
25 | =>
26 | (assert (strong-order (c1 ?c)(c2 ?sup))))
27 |
28 | ;;;
29 | (defrule $strong-order-transitive "order transitivity"
30 | (declare (salience 9915))
31 | (goal (name delegators-defined))
32 | (strong-order (c1 ?x)(c2 ?y))
33 | (strong-order (c1 ?y)(c2 ?z&~?x))
34 | (not (strong-order (c1 ?x)(c2 ?z)))
35 | =>
36 | (assert (strong-order (c1 ?x)(c2 ?z))))
37 |
38 | ;;; make reorderings in order to prevent errors
39 | (defrule $modify-classes
40 | (declare (salience 9915))
41 | (goal (name delegators-defined))
42 | (strong-order (c1 ?c)(c2 ?d))
43 | ?class <- (CLASS (subclass $?H ?d $?M ?c $?T))
44 | =>
45 | (modify ?class (subclass (create$ $?H ?c ?d $?M $?T)))
46 | )
47 |
--------------------------------------------------------------------------------
/clp-pvm/clp/misc-fnc.clp:
--------------------------------------------------------------------------------
1 | ;misc-fnc.clp has various misc functions MTB
2 | ;----------------------------------------time etc
3 | (deffunction elapse-time () (- (time) ?*start-time*))
4 |
5 | (deffunction rt () (round (time)))
6 | (deffunction rt1 () (round (/ (time) 10)))
7 | (deffunction rt2 () (round (/ (time) 100)))
8 |
9 | (deffunction debug (?level) (setopt 2 ?level)) ;sets it up for debugs
10 | (deffunction rr () (reset) (run 1) (agenda) (debug 1)) ;to start it up
11 | (deffunction e () (agenda) (exit_pvm) (exit)) ;exit in a clean way
12 |
13 | (deffunction ri (?file) (load-instances ?file))
14 | (deffunction sleep (?t) (system (format nil "sleep %d" ?t)))
15 |
16 | (deffunction is () (initsend 1)) ;1=no encodeing,0=xdr (avoid 2 for strs)
17 | (deffunction bi () (bufinfo))
18 | (deffunction rbi () (progn (recv_ -1) (bufinfo)))
19 | (deffunction lrbi (?i) (loop-for-count ?i (printout t (rbi) crlf)))
20 |
21 | ;----------------------------------------------------------------DEBUG FNCS
22 | (deffunction wa () (watch all))
23 | (deffunction wmsg () (watch messages))
24 | (deffunction whnd () (watch message-handlers))
25 | (deffunction uwa () (unwatch all))
26 | (deffunction wdf ($?fncs) (funcall watch deffunctions ?fncs))
27 | (deffunction uwdf ($?fncs) (funcall unwatch deffunctions ?fncs))
28 | (deffunction wmh ($?fncs) (funcall watch message-handlers ?fncs))
29 | (deffunction uwmh ($?fncs) (funcall unwatch message-handlers ?fncs))
30 | (deffunction insm (?class) (instances MAIN ?class))
31 | (deffunction list-insts (?class) (instances MAIN ?class))
32 | (deffunction list-insts-from (?class) (instances MAIN ?class))
33 | ;might make a (wa) that takes extra args that would be fncs to (uwdf)
34 | ;----------------------------------------------------------------
35 | (deffunction list ($?stuff) (create$ ?stuff))
36 | ;(deffunction let* ($?l2) (map-skip 2 bind ?l2))
37 | ;--------------------------------------------------------EOF
38 |
--------------------------------------------------------------------------------
/clp-pvm/c/hdf-agent.c:
--------------------------------------------------------------------------------
1 | /*---------------------------------------------------------------------------
2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes:
3 | // "C" Language Integrated Production System, CLIPS Version 6.02
4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center
5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules
6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada
7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL
8 | /----------------------------------------------------------------------------*/
9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)"
10 | or ts-agt -r "(batch b)" where the file b has the above commands*/
11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */
12 |
13 | /*c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/
14 |
15 | #include "c-misc-fncs.c"
16 | #include "c-pvm-fncs.c"
17 | #include "c-hdf.c"
18 | #include "clipsmain.c"
19 |
20 | /*---------------------------------------------------------------USERFUNCTIONS*/
21 | VOID UserFunctions()
22 | {
23 | #include "c-misc-defs.c"
24 | #include "c-pvm-defs.c"
25 |
26 | DefineFunction2("hdf_data",'i',PTIF hdf_data,"hdf_data","4*ikkxi");
27 | DefineFunction2("hdf_nt",'i',PTIF hdf_nt,"hdf_nt","01kk");
28 | DefineFunction2("hdf_dims",'i',PTIF hdf_dims,"hdf_dims","2*iki");
29 | DefineFunction2("hdf_clear",'i',PTIF hdf_clear,"hdf_clear","00i");
30 | DefineFunction2("hdf_strs",'i',PTIF hdf_strs,"hdf_strs","14iikkk");
31 | DefineFunction2("hdf_dimscale",'i',PTIF hdf_dimscale,"hdf_dimscale","13ii");
32 | DefineFunction2("hdf_setlengths",'i',PTIF hdf_setlengths,"hdf_setlengths","44iiiii");
33 | DefineFunction2("hdf_range",'i',PTIF hdf_range,"hdf_range","02nnn");
34 | DefineFunction2("hdf_cal",'i',PTIF hdf_cal,"hdf_cal","05nnnnni");
35 |
36 | }
37 | /*----------------------------------------------------------------EOF*/
38 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/prepare.bat:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; Load the source files
3 | ;;; ######################################################################################
4 | (load* (str-cat ?*src-folder* "global.clp"))
5 | (load* (str-cat ?*src-folder* "functions.clp"))
6 | (load* (str-cat ?*src-folder* "create-templates.clp"))
7 | (load* (str-cat ?*src-folder* "order.clp"))
8 | (load* (str-cat ?*src-folder* "create-classes.clp"))
9 | (load* (str-cat ?*src-folder* "create-objects.clp"))
10 | (load* (str-cat ?*src-folder* "rule-generator.clp"))
11 |
12 | ;;; ######################################################################################
13 | ;;; Define the addresses or the local paths of the ontologies
14 | ;;; *Note*: This function should not be called in the case where
15 | ;;; O-DEVICE is used through JAVA (using JO-DEVICE or in any other
16 | ;;; attempt to integrate O-DEVICE in JAVA applications). In these
17 | ;;; cases, the j2cf module should be called independenly in order
18 | ;;; to create the ?*fact-file*.
19 | ;;; ######################################################################################
20 | ;examples
21 | ;(load-ontology "http://127.0.0.1/1-ub-dl-univ0-dept0.owl")
22 | ;(load-ontology "http://www.loa-cnr.it/ontologies/DOLCE-Lite.owl")
23 | ;(load-ontology "file:c:/omconfig.owl" "ontology2" "ontology3" "ontology...")
24 |
25 |
26 |
27 | ;;; ######################################################################################
28 | ;;; Load the generated triple-based facts (from ?*triple-facts*)
29 | ;;; ######################################################################################
30 | (batch* ?*triple-facts*)
31 | (assert (UPDATE (refresh FALSE)))
32 |
33 | ;;; ######################################################################################
34 | ;;; Run and save O-DEVICE
35 | ;;; ######################################################################################
36 | (run)
37 | (save-o-device)
38 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/translation-rules.clp:
--------------------------------------------------------------------------------
1 | (defrule translate-derived-attribute-rules
2 | (goal translate-derived-attribute-rules)
3 | ?rule-idx <- (derivedattrule ?rule-string)
4 | =>
5 | (bind $?classes (build-dependency-network ?rule-string))
6 | ;(verbose "classes: " $?classes crlf)
7 | (translate-derived-attribute-rule ?rule-string $?classes)
8 | (retract ?rule-idx)
9 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1))
10 | )
11 |
12 | (defrule translate-aggregate-attribute-rules
13 | (goal translate-aggregate-attribute-rules)
14 | ?rule-idx <- (aggregateattrule ?rule-string)
15 | =>
16 | (bind $?classes (build-dependency-network ?rule-string))
17 | ;(verbose "classes: " $?classes crlf)
18 | (translate-aggregate-attribute-rule ?rule-string $?classes)
19 | (retract ?rule-idx)
20 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1))
21 | )
22 |
23 | (defrule translate-2nd-order-rules
24 | (goal translate-2nd-order-rules)
25 | ?rule-idx <- (2nd-order-rule ?rule-string $?results-2nd-order)
26 | =>
27 | (translate-2nd-order-rule ?rule-string $?results-2nd-order)
28 | (retract ?rule-idx)
29 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1))
30 | )
31 |
32 | (defrule pre-compile-deductive-rules
33 | (goal pre-compile-deductive-rules)
34 | ?rule-idx <- (deductiverule ?rule-string)
35 | =>
36 | (pre-compile-deductive-rule ?rule-string)
37 | (retract ?rule-idx)
38 | (bind ?*untranslated_rules* (- ?*untranslated_rules* 1))
39 | )
40 |
41 | (defrule translate-deductive-rules
42 | (goal translate-deductive-rules)
43 | ?rule-idx <- (deductive-rule (deductive-rule ?rule-string) (production-rule "") (depends-on $? ?class $?))
44 | (not (deductive-rule (production-rule "") (implies ?class)))
45 | =>
46 | (translate-deductive-rule ?rule-idx ?rule-string)
47 | )
48 |
49 | (defrule insert-pending-rules
50 | (goal insert-pending-rules)
51 | ?rule-idx <- (pending-rule (production-rule ?pr) (delete-production-rule ?dpr) (non-existent-classes $?classes))
52 | =>
53 | (insert-pending-rule ?pr ?dpr $?classes)
54 | (retract ?rule-idx)
55 | )
56 |
57 | (defrule calc-stratum-for-all
58 | (goal calc-stratum-for-all)
59 | ?rule-idx <- (deductive-rule (production-rule ?rule-condition&~"") (derived-class ?class&~nil))
60 | =>
61 | (calc-stratum-afterwards ?rule-condition ?class)
62 | )
63 |
64 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/classes.clp:
--------------------------------------------------------------------------------
1 | (defglobal
2 | ?*verbose_status* = off
3 | ?*untranslated_rules* = 0
4 | )
5 |
6 | (defclass TYPED-CLASS
7 | (is-a USER)
8 | (role concrete)
9 | (pattern-match reactive)
10 | (multislot class-refs
11 | (type SYMBOL)
12 | (storage shared)
13 | (access read-only)
14 | )
15 | (slot namespace
16 | (type SYMBOL)
17 | (storage shared)
18 | (access read-only)
19 | )
20 | )
21 |
22 | ;(defclass DERIVED-CLASS
23 | ; (is-a TYPED-CLASS)
24 | ; (slot counter (type INTEGER) (default 1))
25 | ; (multislot derivators (type STRING))
26 | ; (multislot derivators (type INSTANCE-NAME))
27 | ; (multislot derivators)
28 | ;)
29 |
30 | (defclass DERIVED-CLASS
31 | (is-a TYPED-CLASS RDF-CLASS)
32 | (slot counter (type INTEGER) (default 1))
33 | (multislot derivators)
34 | )
35 |
36 | (deftemplate deductive-rule
37 | (slot name (type SYMBOL))
38 | (slot del-name (type SYMBOL))
39 | (slot deductive-rule (type STRING))
40 | (slot production-rule (type STRING))
41 | ;(slot delete-production-rule (type STRING))
42 | (slot derived-class (type SYMBOL))
43 | (multislot depends-on (type SYMBOL))
44 | (slot implies (type SYMBOL))
45 | )
46 |
47 | (deftemplate derived-attribute-rule
48 | (slot name (type SYMBOL))
49 | (slot del-name (type SYMBOL))
50 | (slot derived-attribute-rule (type STRING))
51 | ;(slot production-rule (type STRING))
52 | ;(slot delete-production-rule (type STRING))
53 | ; (slot derived-class (type SYMBOL))
54 | (multislot depends-on (type SYMBOL))
55 | (slot implies (type SYMBOL))
56 | )
57 |
58 | (deftemplate aggregate-attribute-rule
59 | (slot name (type SYMBOL))
60 | (slot del-name (type SYMBOL))
61 | (slot aggregate-attribute-rule (type STRING))
62 | ;(slot production-rule (type STRING))
63 | ;(slot delete-production-rule (type STRING))
64 | ; (slot derived-class (type SYMBOL))
65 | (multislot depends-on (type SYMBOL))
66 | (slot implies (type SYMBOL))
67 | )
68 |
69 | (deftemplate derived-class
70 | (slot name (type SYMBOL))
71 | (slot stratum (type INTEGER) (default 1))
72 | (multislot deductive-rules (type SYMBOL))
73 | )
74 |
75 | (deftemplate namespace
76 | (slot name (type SYMBOL))
77 | (slot address (type STRING))
78 | (multislot classes (type SYMBOL))
79 | )
80 |
81 | (deftemplate pending-rule
82 | (slot production-rule (type STRING))
83 | (slot delete-production-rule (type STRING))
84 | (multislot non-existent-classes (type SYMBOL))
85 | )
86 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/create-objects.clp:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; Rules for generating the objects. O-DEVICE uses two user-defined functions
3 | ;;; for creating objects and inserting slot values, namely owl-make-instance and
4 | ;;; owl-insert-values, respectively (see functions.clp for more details)
5 | ;;; ######################################################################################
6 | ;;; create the object based on the rdf:type value
7 | (defrule create-object
8 | (declare (salience 9900))
9 | (goal (name delegators-defined))
10 | ?t <- (triple (subject ?o) (predicate ?term&:(eq ?term ?*rdf:type*))(object ?class))
11 | (CLASS(name ?class))
12 | =>
13 | (owl-make-instance ?o ?class)
14 | (retract ?t)
15 | )
16 |
17 | ;;; manage owl:oneOf
18 | (defrule owl:oneOf
19 | (declare (salience 9900))
20 | (goal (name delegators-defined))
21 | ?t <- (triple (subject ?c)(predicate ?term&:(eq ?term ?*owl:oneOf*))(object ?oneof))
22 | (CLASS (name ?c))
23 | =>
24 | (bind $?objects (collect-list-elements ?oneof))
25 | (progn$ (?obj $?objects)
26 | (owl-make-instance ?obj ?c))
27 | (retract ?t)
28 | )
29 |
30 | ;;; owl:allDifferent construct
31 | (defrule owl:allDifferent
32 | (declare (salience 9900))
33 | (goal (name delegators-defined))
34 | ?t1 <- (triple (subject ?c)(predicate ?term1&:(eq ?term1 ?*rdf:type*))
35 | (object ?term2&:(eq ?term2 ?*owl:AllDifferent*)))
36 | ?t2 <- (triple (subject ?c)(predicate ?term3&:(eq ?term3 ?*owl:distinctMembers*))(object ?list))
37 | =>
38 | (bind $?objects (collect-list-elements ?list))
39 | (progn$ (?o1 $?objects)
40 | (progn$ (?o2 $?objects)
41 | (owl-insert-value ?o1 ?*owl:differentFrom* ?o2)))
42 | (retract ?t1)
43 | (retract ?t2)
44 | )
45 |
46 | ;;; owl:hasValue construct
47 | (defrule owl:hasValue-object
48 | (declare (salience 9899))
49 | (goal (name delegators-defined))
50 | (RESTRICTION (onProperty ?p)(restriction hasValue)(value ?o))
51 | (PROPERTY (name ?p&: (is-object-property ?p)))
52 | (test (not (instance-existp ?o)))
53 | =>
54 | (owl-make-instance ?o ?*owl:Thing*)
55 | )
56 |
57 | ;;; insert values into the objects
58 | (defrule insert-object-value
59 | (declare (salience 9899))
60 | (goal (name delegators-defined))
61 | ?t <- (triple (subject ?o)(predicate ?p)(object ?v))
62 | (PROPERTY (name ?p))
63 | =>
64 | (owl-insert-value ?o ?p ?v)
65 | (retract ?t)
66 | )
67 |
68 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/config.bat:
--------------------------------------------------------------------------------
1 | ;;; ######################################################################################
2 | ;;; ******* Modify these gloabals according to your configuration ******
3 | ;;; ######################################################################################
4 |
5 | ;*******************************
6 | ;*** Display infos, warnings ***
7 | ;*******************************
8 | (defglobal ?*warn* = TRUE)
9 | (defglobal ?*info* = TRUE)
10 |
11 | ;***************
12 | ;*** FOLDERS ***
13 | ;***************
14 | ;the folder path where the distribution folder of O-DEVICE exists
15 | (defglobal ?*odevice-folder* = "c:/Users/George/Desktop/@work/_code/odevice/")
16 |
17 | ;the folder path with the source files of O-DEVICE
18 | (defglobal ?*src-folder* = (str-cat ?*odevice-folder* "src/"))
19 |
20 | ;the folder path where the generated files will be stored
21 | (defglobal ?*bundle-folder* = (str-cat ?*odevice-folder* "bundle/"))
22 |
23 | ;the folder path where the facts will be stored by the J2CF module
24 | (defglobal ?*triple-folder* = (str-cat ?*odevice-folder* "triple-facts/"))
25 |
26 |
27 |
28 | ;*************
29 | ;*** FILES ***
30 | ;*************
31 | ;the file path where the dynamic rules will be stored
32 | (defglobal ?*rule-file* = (str-cat ?*bundle-folder* "$rules.clp"))
33 |
34 | ;the file path where the facts of O-DEVICE will be stored
35 | (defglobal ?*fact-file* = (str-cat ?*bundle-folder* "$facts.clp"))
36 |
37 | ;the file path where the classes of O-DEVICE will be stored
38 | (defglobal ?*class-file* = (str-cat ?*bundle-folder* "$classes.clp"))
39 |
40 | ;the file path where the generated objects will be stored
41 | (defglobal ?*object-file* = (str-cat ?*bundle-folder* "$objects.clp"))
42 |
43 | ;the file path where the triple-based facts will be stored
44 | (defglobal ?*triple-facts* = (str-cat ?*triple-folder* "$triples.clp"))
45 |
46 | ;the path of the index file where the instances will be saved (restore-instances*).
47 | (defglobal ?*ins-idx* = (str-cat ?*odevice-folder* "$ins.idx"))
48 |
49 |
50 |
51 |
52 |
53 | ;************
54 | ;*** MISC ***
55 | ;************
56 |
57 | ;whether to use prefixes or complete namespaces. It is recommended to
58 | ;use TRUE since it results in faster execution
59 | (defglobal ?*abbr* = TRUE)
60 |
61 | ;whether the imported ontologies should be processed or not
62 | (defglobal ?*imports* = TRUE)
63 |
64 | ;Load the ontology vocabulary in the form of defglobal variables
65 | (if ?*abbr*
66 | then (load* (str-cat ?*src-folder* "vocabulary-abbr.clp"))
67 | else (load* (str-cat ?*src-folder* "vocabulary.clp"))
68 | )
69 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/aggregates.clp:
--------------------------------------------------------------------------------
1 | (defclass aggregate-function
2 | (is-a USER)
3 | (role concrete)
4 | (pattern-match reactive)
5 | (slot class (type SYMBOL))
6 | (slot instance (type INSTANCE-NAME))
7 | (slot attribute (type SYMBOL))
8 | (multislot values)
9 | (multislot objects)
10 | )
11 |
12 | (defmessage-handler aggregate-function calc-result ($?result)
13 | $?result
14 | )
15 |
16 | (defclass sum
17 | (is-a aggregate-function)
18 | )
19 |
20 | (defmessage-handler sum calc-result ($?result)
21 | (sum$ $?result)
22 | )
23 |
24 | (defclass count
25 | (is-a aggregate-function)
26 | )
27 |
28 | (defmessage-handler count calc-result ($?result)
29 | (length$ $?result)
30 | )
31 |
32 | (defclass avg
33 | (is-a aggregate-function)
34 | )
35 |
36 | (defmessage-handler avg calc-result ($?result)
37 | (if (> (length$ $?result) 0)
38 | then
39 | (/ (sum$ $?result) (length$ $?result))
40 | else
41 | 0
42 | )
43 | )
44 |
45 | (defclass max
46 | (is-a aggregate-function)
47 | )
48 |
49 | (defmessage-handler max calc-result ($?result)
50 | (bind ?class (send ?self get-class))
51 | (bind ?att (send ?self get-attribute))
52 | (bind $?types (slot-types ?class ?att))
53 | (if (or (member$ INTEGER $?types)
54 | (member$ FLOAT $?types))
55 | then
56 | (max-int $?result)
57 | else
58 | (max-string $?result)
59 | )
60 | )
61 |
62 | (defclass min
63 | (is-a aggregate-function)
64 | )
65 |
66 | (defmessage-handler min calc-result ($?result)
67 | (bind ?class (send ?self get-class))
68 | (bind ?att (send ?self get-attribute))
69 | (bind $?types (slot-types ?class ?att))
70 | (if (or (member$ INTEGER $?types)
71 | (member$ FLOAT $?types))
72 | then
73 | (min-int $?result)
74 | else
75 | (min-string $?result)
76 | )
77 | )
78 |
79 | (defclass list
80 | (is-a aggregate-function)
81 | )
82 |
83 | (defclass ord_list
84 | (is-a aggregate-function)
85 | )
86 |
87 | (defmessage-handler ord_list calc-result ($?list)
88 | (bind ?class (send ?self get-class))
89 | (bind ?att (send ?self get-attribute))
90 | (bind $?types (slot-types ?class ?att))
91 | (if (or (member$ INTEGER $?types)
92 | (member$ FLOAT $?types))
93 | then
94 | (sort > $?list)
95 | else
96 | (sort string> $?list)
97 | )
98 | )
99 |
100 | (defclass string
101 | (is-a aggregate-function)
102 | )
103 |
104 | (defmessage-handler string calc-result ($?list)
105 | (funcall str-cat $?list)
106 | )
107 |
108 | (defclass phrase
109 | (is-a aggregate-function)
110 | )
111 |
112 | (defmessage-handler phrase calc-result ($?list)
113 | (str-cat$ $?list)
114 | )
115 |
116 | (deffunction is-aggregate-function (?x)
117 | (and
118 | (class-existp ?x)
119 | (subclassp ?x aggregate-function)
120 | )
121 | )
122 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/release_notes.txt:
--------------------------------------------------------------------------------
1 |
2 | Version 2.0
3 | ===========
4 | - Support for owl:AllDisjointClasses
5 |
6 | - Add (load-rules) function for loading rule programs
7 | on top of O-DEVICE.
8 |
9 |
10 | Version 1.2
11 | ===========
12 | - Support for owl:propertyChainAxiom
13 |
14 | - New function: (owl-insert-values$) for inserting multiple
15 | instance slot values
16 |
17 | - New defglobal variable (?*imports*) in order to control
18 | the processing of the imported ontologies
19 |
20 | - Support for qualified cardinality restrictions (partially)
21 |
22 | - Support for owl:hasKey property
23 |
24 | - Add functions for backing-up/restoring instances
25 |
26 | - The restore-instance* function checks also for the
27 | existence of the instance slots
28 |
29 |
30 | Version 1.1
31 | ===========
32 | - Code optimizations:
33 | - many functions have been re-written
34 | - some redundant rules have been removed (e.g. the collect-restrictions.clp)
35 |
36 |
37 | Version 1.0
38 | ===========
39 | - Major source code reorganization: only the relevant constructs are
40 | loaded using the exec.bat, resulting in faster rule execution
41 |
42 | - The (run) function is not executed any more by the functions
43 | owl-make-instance and owl-insert-value. Use instead the functions
44 | owl-make-instance-run and owl-insert-value-run
45 |
46 |
47 | Version 0.3
48 | ===========
49 | - Support for the owl:complementOf construct (checks if there are
50 | objects that belong to complement classes)
51 |
52 | - The call to the j2cf module needs to specify the ?*abbr* flag (config.bat)
53 | that denotes whether the prefixes or the namespaces should be used during the
54 | generation of the triple-based facts (create-facts function). It is recommended
55 | to use ?*abbr* = TRUE in config.bat, since it results in faster execution.
56 |
57 | - Enhanced slot type mappings regarding boolean, nonNegativeInteger, positiveInteger,
58 | nonPositiveInteger and short ranges
59 |
60 | - Only the generated code is stored into the bundle folder, without the source
61 | code of O-DEVICE (modified exec.bat file).
62 |
63 | - defglobals for OWL and RDF/RDFS vocabulary
64 |
65 |
66 | Version 0.2
67 | ===========
68 | - The namespaces are mapped on prefixes for better performance.
69 |
70 | - Parameterizes the file/folder paths (through the config.bat).
71 |
72 | - Allows the definition of more than one ontology
73 | as parameters for the function load_ontology, for
74 | example, (load-ontology "file:c:\\..." "file:c:\\..." ...)
75 |
76 | - Fixes some performance problems regarding the
77 | loading of ontologies with large number of classes.
78 |
79 | - Facts of the template PrefixNsMap are generated that
80 | contain information about the prefixes mapping on namespaces
81 | of the loaded ontologies (these mappings are computed
82 | by Jena)
83 |
84 | - The function "ns" has been added for substituting the prefix
85 | with the corresponding namespace.
86 |
87 | - The function mapPrefixNs has been added that allows the
88 | definition of new mappings for prefixes/namespaces.
89 |
90 | - CLIPS cannot process symbols that contain the character '~'.
91 | This character is removed.
--------------------------------------------------------------------------------
/clp-pvm/c/c-frt.c:
--------------------------------------------------------------------------------
1 | #define PTIF (int (*)(VOID_ARG))
2 | #define VPTIF (void (*)(VOID_ARG))
3 | /* DefineFunction2("DF2"",'i',PTIF DF2,"DF2","45iskuss"); */
4 | int
5 | DF2()
6 | {
7 | char c1, chr1[9] ,str1[99] ,str2[99] ,str3[99];
8 | /*PTIF fncptr; at the worst might have to give the return type &do a switch*/
9 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
10 | fncptr = PTIF get_ptr(3);
11 | if((int)fncptr < 999) printf("[fncptr=%d]",(int)fncptr); /*return(0);*/
12 | sprintf(str1,"%s",(char *)RtnLexeme(1));
13 | sprintf(chr1,"%s",(char *)RtnLexeme(2));
14 | sprintf(str2,"%s",(char *)RtnLexeme(4));
15 | c1= chr1[0];
16 | printf("[DefineFunction2 for:%s with type=%c]\n",str1,c1);
17 | if(RtnArgCount()>4)
18 | {
19 | sprintf(str3,"%s",(char *)RtnLexeme(5));
20 | DefineFunction2(str1,c1,PTIF fncptr,str2,str3);
21 | }
22 | else DefineFunction(str1,c1,PTIF fncptr,str2);
23 | return(1);
24 | }
25 | /*if this could be done interactively then a compiled model could print out
26 | a batch file that would desribe all the fnc(in C) directly as clips fncs
27 | -it might still be a good idea to have instances to call the fncs
28 | it would at least save putting ifs in, allowing for direct calling*/
29 | /*problem is turning the cmndline version of the fnc into the fnc ptr
30 | don't think it will work. the only way is if all the possible functions
31 | where compiled in extern&all, in a big switch -then there is the opt
32 | to make it a clips deffunction or if something is linked in use that
33 | ---could be done on arg types.. or vararg wrappers to Cfncs---??*/
34 |
35 | /*could have any obj files print out the fnc ptrs in a SUBROUTINE inst
36 | then DF2 could be called with this #, as part of a handler call
37 | -this might even be able to done w/ fortran code w/out having to use f2c*/
38 | /*start including val_ptr slots in the subroutines and try DF2 w/ this #*/
39 |
40 | /*can at least use these fnc ptrs for some basic in C array ops*/
41 |
42 | /*Don't need to use DF2, can just call using the ptr to the fnc/sub &
43 | all the ptrs to the args, (all wrapped in a fnc/sub clips inst)*/
44 |
45 | /* DefineFunction2("cf0i"",'i',PTIF cf0i,"cf0i","11ii"); */
46 | int
47 | cf0i()
48 | {
49 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
50 | int i;
51 | fncptr = PTIF get_ptr(1);
52 | printf("[cf0i:calling %d]\n",(int)fncptr);
53 | i=fncptr();
54 | return(i);
55 | }
56 | /* DefineFunction2("cf0v"",'i',PTIF cf0v,"cf0v","11ii"); */
57 | int
58 | cf0v()
59 | {
60 | void (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
61 | fncptr = VPTIF get_ptr(1);
62 | printf("[cf0v:calling %d]\n",(int)fncptr);
63 | fncptr();
64 | return(1);
65 | }
66 | /*will want a version that can handle a arbitrary number of arg ptrs*/
67 |
68 | /* (DF2 "tst" i tst "tst" "11ik"); */
69 | /* (DF2 "srrf" i # "srrf" "00i"); */
70 | int tst() {
71 | char str1[99];
72 | sprintf(str1,"%s",(char *)RtnLexeme(1));
73 | printf("[test fnc tst can print out:%s]\n",str1);
74 | return(1);
75 | }
76 |
77 | extern int ftst_();
78 |
79 | int ctst()
80 | {
81 | printf("(ftst of FUNC (val_ptr %d))",(int)ftst_);
82 | fflush(stdout);
83 | }
84 |
85 | /* DefineFunction2("ftst",'i',PTIF ftst_,"ftst","00i"); */
86 | /* DefineFunction2("ctst",'i',PTIF ctst,"ctst","00i"); */
87 | /*----------------------------------------------------------------EOF*/
88 |
--------------------------------------------------------------------------------
/clp-pvm/clp/lib.clp:
--------------------------------------------------------------------------------
1 | ;-------------------util fncs
2 | (deffunction s-atoi (?str)
3 | (if (or (null ?str) (eq ?str "")) then 0 else (atoi ?str)))
4 | ;(deffunction gn (?ins) (instance-name-to-symbol ?ins))
5 | ;(deffunction gn (?ins) (sub-string 11 55 (str-cat (sym-cat ?ins))))
6 | (deffunction gn (?ins) ?ins) ;just use instance-name
7 | ;=================================================================UPDATEABLE
8 | ;anything which is updated/ has a time-stamp /needs an explanation
9 | (defclass UPDATEABLE
10 | (is-a INITIAL-OBJECT)
11 | (role concrete)
12 | (pattern-match reactive)
13 | ;set these in advance
14 | (slot expl (type STRING) ;short description
15 | (create-accessor read-write) (visibility public))
16 | (slot time (type INTEGER) ;time of last update
17 | (create-accessor read-write) (visibility public))
18 | ;get/put deamons will update, so can be used for 'freshness'/matching
19 | (slot get-time (type INTEGER) ;time of last put bind
20 | (create-accessor read-write) (visibility public))
21 | (slot put-time (type INTEGER) ;time of last get request
22 | (create-accessor read-write) (visibility public))
23 | (slot fresh (default FALSE) ;if the proj is newly filled
24 | (create-accessor read-write))
25 | )
26 | ;-----------------------------------make-fresh
27 | (deffunction make-fresh (?p)
28 | (send ?p put-fresh TRUE)
29 | (if (slot-existp (class ?p) params) then
30 | (map1 make-fresh (send ?p get-params))))
31 | ;will be done during an unpack & by running appropriate subs ?
32 |
33 | ;-------------------------------------------updateable INIT after
34 | (defmessage-handler UPDATEABLE init after ()
35 | (bind ?self:time (round (elapse-time))))
36 | ;-------------------
37 | ;=================================================================ACCESSIBLE
38 | ;-------------------
39 | ;used for any instance that will be transmitted between unix processes
40 | (defclass ACCESSIBLE
41 | (is-a UPDATEABLE) ; (is-a INITIAL-OBJECT)
42 | (role concrete)
43 | (pattern-match reactive)
44 |
45 | ;this will be even more of a numeric (rather than str) id, (no necc. msgtag)
46 | (slot msgtag (type INTEGER) ;the flag used in the model (vid,fid)
47 | (create-accessor read-write) (visibility public))
48 | ;set at runtime
49 | (slot in-task ;task it is in
50 | (create-accessor read-write) (visibility public))
51 | (slot in-tid (type INTEGER) ;task-id it is in ??
52 | (create-accessor read-write) (visibility public))
53 | (slot count (type INTEGER) ;number of this type of instance made
54 | (create-accessor read-write) (storage shared))
55 | )
56 | ;-------------------------------------------accessible INIT after
57 | (defmessage-handler ACCESSIBLE init after ()
58 | (bind ?self:put-time (round (elapse-time)))
59 | (if (instance-existp ?self:in-task) then
60 | (printout t "[filling in-tid slot]")
61 | (bind ?self:in-tid (get-tid ?self:in-task))))
62 | ;--------------------------------------------------------GET-TAG(s)
63 | (deffunction get-tag (?acc) ;send in and accessible|| tag get out a tag
64 | (if (numberp ?acc) then ?acc else (send ?acc get-msgtag)))
65 |
66 | (deffunction get-tags ($?accs) (map1 get-tag ?accs)) ;outputs the tags
67 |
68 | ;--------------------------------------------------------
69 | ;keep simulated real time/ real clock time ratio -to see how its doing
70 | ;--------------------------------------------------------EOF
71 |
--------------------------------------------------------------------------------
/clp-pvm/clp/pvm.clp:
--------------------------------------------------------------------------------
1 | ;start of pvm clips code, Mike B. ;-needs:util.clp
2 |
3 | ;-------------------send/recv functions
4 | ;----------------------------------------send-str
5 | ;general send a string to a task w/ tid (takes an int||task & string, w/opt int)
6 | (deffunction send-str (?task ?str $?msgtag)
7 | (initsend 0)
8 | (if (and (integerp (bind ?tid (get-tid ?task))) (lexemep ?str)) then
9 | (pkstr ?str) ;might use stringp
10 | (send_ ?tid (first-dflt ?msgtag 0))
11 | else (printout t "[bad send-str " ?task ", " ?str "]")))
12 | ;----------------------------------------send-str-to
13 | ;(deffunction send-str-to (?str ?task)
14 | ; (initsend 1)
15 | ; (if (and (integerp (bind ?tid (get-tid ?task))) (stringp ?str)) then
16 | ; (pkstr ?str) (send_ ?tid 0)
17 | ; else (printout t "[bad send-str-to " ?task ", " ?str "]")))
18 |
19 | ;----------------------------------------send_0
20 | ;(deffunction send_0 (?task)
21 | ; (if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0)
22 | ; else (printout t "[bad send_0 " ?tid "]")))
23 | ;task can be a task-inst a tid or a group-string, msgtag will=0
24 | (deffunction send_0 (?task)
25 | (if (integerp (bind ?tid (get-tid ?task))) then (send_ ?tid 0)
26 | else (if (stringp ?task) then (bcast ?task 0)
27 | else (printout t "[bad send_0 " ?tid "]"))))
28 |
29 | ;----------------------------------------SEND-STR-TO
30 | (deffunction send-str-to (?str $?tasks)
31 | (initsend 1)
32 | (if (stringp ?str) then (pkstr ?str) (map1 send_0 ?tasks)
33 | else (printout t "[bad send-str-to " ?tasks ", " ?str "]")))
34 |
35 |
36 | ;----------------------------------------send-str-to-deem
37 | ;(deffunction send-str-to-deem (?str)
38 | ; (initsend 1) (pkstr ?str) (bcast "deem" 0))
39 | ;----------------------------------------send-str-to-models
40 | ;(deffunction send-str-to-models (?str)
41 | ; (initsend 1) (pkstr ?str) (bcast "models" 0))
42 |
43 | ;---------------------------------------------------(u)pk strings by bytes
44 | (deffunction pkstrb (?str)
45 | (bind ?l (+ (str-length ?str) 1))
46 | (printout t "[pkstrb of len=" ?l "]")
47 | ;(free (pkbyte (deref b (imalloc ?l) ?str) ?l))
48 | (pkbyte (deref b (imalloc ?l) ?str) ?l))
49 | ;-------------------
50 | ;(deffunction upkstrb (?l) (deref b (upkbyte (imalloc ?l) ?l)))
51 | (deffunction upkstrb (?l)
52 | (bind ?p (imalloc ?l))
53 | (printout t "[upkstrb of len=" ?l "into " ?p "]")
54 | (bind ?p2 (upkbyte ?p ?l))
55 | (printout t "final ptr=" ?p2)
56 | (deref b ?p2))
57 | ;-------------------
58 | ;----------------------------------------send-cl
59 | ;general send a string to a task w/ tid (takes an int & string)
60 | ;pkbyte for sends to fortran, probably won't be used
61 | (deffunction send-cl (?tid ?str ?len)
62 | (initsend 0)
63 | (pkbyte ?str ?len)
64 | (send_ ?tid 1))
65 |
66 | (deffunction send-c (?tid ?str)
67 | (send-cl ?tid ?str (str-length ?str)))
68 |
69 | ;----------------------------------------TRECV_EVAL
70 | ;timed receive, which expects a string, and will evaluate it.
71 | (deffunction trecv_eval ($?time)
72 | (bind ?t (first-dflt ?time 10))
73 | (if (<> (trecv -1 0 ?t) 0) then ;(eval (upkstr))
74 | (bind ?str (upkstr))
75 | (if (lexemep ?str) then (eval ?str)
76 | else (printout t "[bad trecv_eval:" ?str "]"))
77 | ))
78 | ;----------------------------------------recv-eval
79 | ;general receive any string and eval it (run this periodically)
80 | (deffunction recv-eval ($?tid)
81 | (recv_ (first-dflt ?tid -1) 0)
82 | (eval (upkstr)))
83 | ;-------------------------------------------------EOF
84 |
--------------------------------------------------------------------------------
/clp-pvm/c/mk/make-pvm:
--------------------------------------------------------------------------------
1 | # Object files for the CLIPS engine
2 | ENGINEOBJS = watch.o utility.o userdata.o tmpltutl.o tmpltrhs.o \
3 | tmpltpsr.o tmpltlhs.o tmpltfun.o tmpltdef.o tmpltcmp.o tmpltbsc.o \
4 | tmpltbin.o textpro.o sysdep.o symbol.o symblcmp.o symblbin.o strngrtr.o \
5 | strngfun.o sortfun.o scanner.o rulepsr.o rulelhs.o ruledlt.o ruledef.o \
6 | rulecstr.o rulecom.o rulecmp.o rulebsc.o rulebld.o rulebin.o router.o \
7 | retract.o reteutil.o reorder.o proflfun.o prntutil.o prdctfun.o prcdrpsr.o \
8 | prcdrfun.o prccode.o pprint.o pattern.o parsefun.o objrtmch.o objrtgen.o \
9 | objrtfnx.o objrtcmp.o objrtbld.o objrtbin.o objcmp.o objbin.o multifun.o \
10 | multifld.o msgpsr.o msgpass.o msgfun.o msgcom.o modulutl.o modulpsr.o \
11 | moduldef.o modulcmp.o modulbsc.o modulbin.o miscfun.o memalloc.o \
12 | lgcldpnd.o iofun.o insqypsr.o insquery.o inspsr.o insmult.o insmoddp.o \
13 | insmngr.o insfun.o insfile.o inscom.o inherpsr.o incrrset.o immthpsr.o \
14 | globlpsr.o globldef.o globlcom.o globlcmp.o globlbsc.o globlbin.o \
15 | genrcpsr.o genrcfun.o genrcexe.o genrccom.o genrccmp.o genrcbin.o \
16 | generate.o filertr.o filecom.o factrhs.o factrete.o factprt.o factmngr.o \
17 | factmch.o factlhs.o facthsh.o factgen.o factfun.o factcom.o factcmp.o \
18 | factbld.o factbin.o extnfunc.o exprnpsr.o exprnops.o exprnbin.o expressn.o \
19 | evaluatn.o envrnmnt.o engine.o emathfun.o edterm.o edstruct.o edmisc.o \
20 | edmain.o edbasic.o drive.o dfinscmp.o dfinsbin.o dffnxpsr.o dffnxfun.o \
21 | dffnxexe.o dffnxcmp.o dffnxbin.o dffctpsr.o dffctdef.o dffctcmp.o \
22 | dffctbsc.o dffctbin.o developr.o defins.o default.o cstrnutl.o cstrnpsr.o \
23 | cstrnops.o cstrncmp.o cstrnchk.o cstrnbin.o cstrcpsr.o cstrccom.o \
24 | cstrcbin.o crstrtgy.o constrnt.o constrct.o conscomp.o commline.o \
25 | clsltpsr.o classpsr.o classini.o classinf.o classfun.o classexm.o \
26 | classcom.o bsave.o bmathfun.o bload.o argacces.o analysis.o agenda.o
27 | ENGINELIBS = -lm
28 |
29 | # Objects for the XWindows interface
30 | XWINDOWSOBJS = xclips.o xclipstext.o xedit.o xmain.o xmenu.o \
31 | xmenu_exec.o xmenu_file.o xmenu_opt.o xmenu_watch.o xmenu_wind.o
32 | XWINDOWSLIBS = -L/usr/X11R6/lib -I/usr/X11R6/include -lXaw -lXmu -lXt -lXext -lX11 -L./ -lclips
33 |
34 | # Objects for the command line interface
35 | #COMMANDLINEOBJS = main.o
36 | COMMANDLINEOBJS = c-main.o
37 | CMDLIBS = -ltermcap -L./ -lclips
38 |
39 | # Programs that may be produced
40 | PROGS = clips${exeext} xclips${exeext}
41 | ENGINE = libclips.so
42 |
43 | .c.o :
44 | gcc -c -Wall -Wundef -Wpointer-arith -Wshadow -Wcast-qual \
45 | -Wcast-align -Winline -Wmissing-declarations -Wredundant-decls \
46 | -Woverloaded-virtual -Wmissing-prototypes -Wnested-externs \
47 | -Wstrict-prototypes -Waggregate-return -Wno-implicit $(CFLAGS) $<
48 |
49 | all: clips xclips
50 |
51 | clips : $(ENGINE) $(COMMANDLINEOBJS)
52 | gcc $(CMDLIBS) -o clips${exeext} $(COMMANDLINEOBJS)
53 |
54 | xclips : $(ENGINE) $(XWINDOWSOBJS)
55 | gcc $(XWINDOWSLIBS) -o xclips${exeext} $(XWINDOWSOBJS)
56 |
57 | $(ENGINE) : $(ENGINEOBJS)
58 | gcc $(ENGINELIBS) -shared -o libclips.so $(ENGINEOBJS)
59 |
60 | clean :
61 | @rm -f $(ENGINEOBJS) $(COMMANDLINEOBJS) $(XWINDOWSOBJS) $(PROGS) $(ENGINE)
62 |
63 | install :
64 | install -d -m 755 $(DESTDIR)/$(PREFIX)/bin
65 | install -m 755 clips${exeext} $(DESTDIR)/$(PREFIX)/bin/clips${exeext}
66 | install -d -m 755 $(DESTDIR)/$(PREFIX)/lib/clips
67 | install -m 755 $(ENGINE) $(DESTDIR)/$(PREFIX)/lib/$(ENGINE)
68 | install -m 644 ../doc/clips.hlp $(DESTDIR)/$(PREFIX)/lib/clips/clips.hlp
69 |
70 | setup.h :
71 | sed -e "s:XXX_HELP_FILE:$(PREFIX)/lib/clips/clips.hlp:g" setup.h.in > setup.h
72 |
--------------------------------------------------------------------------------
/clp-pvm/clp/sub.clp:
--------------------------------------------------------------------------------
1 | ;=================================================================SUBROUTINE
2 | ;-------can be similar to Lambda Fncs (but no args as of yet)<-(objs for now)*
3 | ;used to hold the information on how to run a subroutine in a model
4 | ;can include the variables that need to be current to run, and the ones wich
5 | ;will be updated/or returned when the subroutine is finished
6 | (defclass SUBROUTINE
7 | (is-a ACCESSIBLE)
8 | (role concrete)
9 | (pattern-match reactive)
10 | (slot sub ;subroutine code to eval
11 | (create-accessor read-write))
12 |
13 | (slot busy (default FALSE) ;wether the subroutine is busy
14 | (create-accessor read-write))
15 |
16 | (slot val_ptr (type INTEGER) ;LOC(sub-name)
17 | (create-accessor read-write)) ;to be used by DF2
18 | (multislot args (type INSTANCE) ;instances it will be called w/
19 | (create-accessor read-write)) ; used to get arg typ/ptrs &#?
20 |
21 | ;might not use these-----------------get more data dict
22 | (multislot vars-needed (type INSTANCE) ;vars used /needed
23 | (create-accessor read-write)) ;can check if updated
24 | (multislot proj-needed (type INSTANCE) ;vars used /needed
25 | (create-accessor read-write)) ;can check if updated
26 | (multislot sub-needed (type INSTANCE) ;vars used /needed
27 | (create-accessor read-write)) ;can check if updated
28 | (slot count (type INTEGER) ;number of this type of instance made
29 | (create-accessor read-write) (storage shared))
30 | ) ;even id/fid/msgtag because nothing is returned
31 | ;-------------------------------------------subroutine INIT after
32 | (defmessage-handler SUBROUTINE init after ()
33 | ; (if (and (stringp ?self:expl) (neq ?self:expl "")) then
34 | ; (printout t "[ " ?self:expl " ]"))
35 | (printout t ?self ","))
36 |
37 | ;------------------------------------make-busy
38 | (deffunction make-busy (?sub)
39 | (send ?sub put-busy TRUE))
40 |
41 | ;------------------------------------------------------CALL
42 | (defmessage-handler SUBROUTINE call primary ()
43 | (if (stringp ?self:sub) then
44 | (if (and (stringp ?self:expl) (neq ?self:expl "")) then
45 | (printout t "[ " ?self:expl " ]"))
46 | (eval ?self:sub)
47 | else
48 | (printout t "[call->ptag " ?self:msgtag "]")
49 | (ptag ?self:msgtag)
50 | ))
51 |
52 | (deffunction call-a-sub (?sub)
53 | (if (not (instance-existp ?sub)) then
54 | (printout t "[WARNING: sub:" ?sub " not there]")
55 | (return nil)
56 | else
57 | (printout t "[sub:" ?sub "]")
58 | (send ?sub call)))
59 |
60 | ;takes a list of subs and send the call msg to them
61 | (deffunction call ($?subs)
62 | (apply-1 call-a-sub ?subs))
63 |
64 |
65 | ;------------------------------------rcall
66 | (deffunction rcall (?task $?subs)
67 | (send-str-to (quotes call ?subs) ?task)
68 | (map1 make-busy ?subs))
69 |
70 | ;=====================================================FUNCTION
71 | ;similar to a subroutine instance, but has a specific return value to look at
72 | (defclass FUNCTION
73 | (is-a SUBROUTINE)
74 | (role concrete)
75 | (pattern-match reactive)
76 | (multislot ret-value ;a 'future' to be filled latter
77 | (create-accessor read-write))
78 | )
79 | ;-------------------a handler should construct the ret val send
80 | ;(quote send-str ?self:sub ?*my-tid*)
81 | ;will use: (send-back-to-param ?str ?task ?param)
82 | ;where the string gets eval-ed on the other side and
83 | ; the resulting value (not str) is put into the param's value slot
84 |
85 | ;------------------------------------------------------------------
86 | ;------------------------------------------------------------------EOF
87 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/main.clp:
--------------------------------------------------------------------------------
1 | (deffunction load-rule-file (?filename)
2 | (bind ?rule-string "")
3 | (open ?filename rule "r")
4 | (bind ?line (readline rule))
5 | ;(verbose "line: " ?line crlf)
6 | (while (neq ?line EOF)
7 | do
8 | (bind ?rule-string (str-cat ?rule-string ?line))
9 | (bind ?line (readline rule))
10 | ;(verbose "line: " ?line crlf)
11 | )
12 | (close rule)
13 | ;(verbose "rule-string: " ?rule-string crlf)
14 | (bind $?rule-list (my-explode$ ?rule-string))
15 | ;(verbose "Rules: " $?rule-list crlf)
16 | (while (> (length$ $?rule-list) 0)
17 | do
18 | (bind ?p2 (get-token $?rule-list))
19 | (bind $?rule (subseq$ $?rule-list 1 ?p2))
20 | ;(bind ?rule-string (str-cat$ "(" (nth$ 2 $?rule) (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1))) ")"))
21 | ;(funcall assert (nth$ 2 $?rule) (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1))))
22 | (bind ?rule-type (nth$ 2 $?rule))
23 | (bind ?rule-string (str-cat$ (subseq$ $?rule 3 (- (length$ $?rule) 1))))
24 | (switch ?rule-type
25 | (case deductiverule
26 | then
27 | (assert (deductiverule ?rule-string))
28 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1))
29 | )
30 | (case derivedattrule
31 | then
32 | (assert (derivedattrule ?rule-string))
33 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1))
34 | )
35 | (case aggregateattrule
36 | then
37 | (assert (aggregateattrule ?rule-string))
38 | (bind ?*untranslated_rules* (+ ?*untranslated_rules* 1))
39 | )
40 | (default (printout t "Unknown rule type: " crlf (str-cat$ $?rule) crlf))
41 | )
42 | (bind $?rule-list (subseq$ $?rule-list (+ ?p2 1) (length$ $?rule-list)))
43 | )
44 | TRUE
45 | )
46 |
47 | (deffunction load-rule-files ($?file-list)
48 | (bind ?end (length$ $?file-list))
49 | (loop-for-count (?n 1 ?end)
50 | do
51 | (load-rule-file (nth$ ?n $?file-list))
52 | )
53 | )
54 |
55 | (deffunction go ()
56 | (verbose "Running rules..." crlf)
57 | (bind ?old-strategy (get-strategy))
58 | (bind ?old-salience (get-salience-evaluation))
59 | (set-strategy breadth)
60 | (set-salience-evaluation when-activated)
61 | (bind ?objects-before -1)
62 | (bind ?objects-after (no-of-derived-objects))
63 | (while (<> ?objects-after ?objects-before)
64 | do
65 | (bind ?ind (assert (run-deductive-rules)))
66 | (bind ?objects-before ?objects-after)
67 | (run)
68 | (bind ?objects-after (no-of-derived-objects))
69 | (retract ?ind)
70 | )
71 | (set-salience-evaluation ?old-salience)
72 | (set-strategy ?old-strategy)
73 | (verbose "End of inferencing!" crlf)
74 | TRUE
75 | )
76 |
77 | ; Loading should distinguish between .bat and .clp files
78 | (deffunction device (?rule-files ?class-files ?object-files ?verbose)
79 | (set-verbose ?verbose)
80 | (verbose "Loading classes...")
81 | (load-files (explode$ ?class-files))
82 | (verbose " ok" crlf)
83 | (reset)
84 | (set-verbose ?verbose)
85 | (verbose "Loading rules...")
86 | (load-rule-files (explode$ ?rule-files))
87 | (verbose " ok" crlf)
88 | (verbose "Loading objects...")
89 | (load-files (explode$ ?object-files))
90 | (verbose " ok" crlf)
91 | ;(run)
92 | (verbose "Translating rules..." )
93 | (translate-device-rules)
94 | (verbose " ok" crlf)
95 | TRUE
96 | )
97 |
98 | (deffunction r-device (?rule-files)
99 | (verbose "Loading rules...")
100 | (load-rule-files (explode$ ?rule-files))
101 | (verbose " ok" crlf)
102 | ;(reset)
103 | ;(run)
104 | (verbose "Translating rules..." )
105 | (translate-device-rules)
106 | (verbose " ok" crlf)
107 | TRUE
108 | )
109 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/dmoz.rdf:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Index of /rdf
5 |
6 |
7 | Index of /rdf
8 | 
Name Last modified Size Description
9 |
10 | ![[DIR]](/icons/back.gif)
Parent Directory 12-Dec-2002 22:00 -
11 | ![[TXT]](/icons/text.gif)
Changes.html 23-Jul-2002 13:17 6k
12 | ![[ ]](/icons/unknown.gif)
brasil-content.rdf.u8 24-Apr-2002 11:15 812k
13 | brasil-structure.rdf.u8 24-Apr-2002 11:15 159k
14 | ![[CMP]](/icons/compressed.gif)
catmv.log.gz 11-Dec-2002 12:56 10.0M
15 | charsets.txt 19-Jan-2000 11:22 2k
16 | content.example.txt 28-Jan-1999 13:19 23k
17 | content.rdf.u8.gz 22-Sep-2002 09:17 205M
18 | content.rdf.u8.gz.old 26-Aug-2002 09:18 12k
19 | kt-content.rdf.u8.gz 22-Sep-2002 09:22 1.4M
20 | kt-structure.rdf.u8.gz 22-Sep-2002 09:22 169k
21 | kt-terms.rdf.u8.gz 22-Sep-2002 09:22 7k
22 | netscape-content.rdf..> 22-Sep-2002 09:33 1021k
23 | netscape-structure.r..> 22-Sep-2002 09:33 11k
24 | netscape-terms.rdf.u..> 22-Sep-2002 09:33 1k
25 | nohup.out 18-Sep-2002 13:29 0k
26 | ![[DIR]](/icons/folder.gif)
old/ 17-Sep-2002 15:29 -
27 | rand.cats 27-Mar-2001 10:20 263k
28 | redirect.rdf.gz 11-Jan-2001 23:49 3.7M
29 | redirect.rdf.u8.gz 22-Sep-2002 13:22 5.8M
30 | sample.rdf.u8.gz 17-Jan-2001 15:03 50.3M
31 | structure.example.txt 28-Jan-1999 13:19 32k
32 | structure.rdf.u8.gz 22-Sep-2002 09:17 36.7M
33 | tags.html 09-Dec-2002 18:35 7k
34 | terms.rdf 11-Jan-2001 22:38 388k
35 | terms.rdf.u8 16-Mar-2002 06:13 485k
36 | terms.rdf.u8.gz 22-Sep-2002 09:17 76k
37 |
38 |
39 |
--------------------------------------------------------------------------------
/clp-pvm/c/c-lnd.c:
--------------------------------------------------------------------------------
1 | /*clips glenda (Linda using PVM) fncs MTB*/
2 | /* #include "../gts/gluser.c"
3 | might compile like gts?*/
4 | #include
5 | #include
6 | #include "glenda.h"
7 |
8 | #if defined(__cplusplus)
9 | extern "C" {
10 | #endif
11 | extern int gl_out(char*,...);
12 | extern int gl_in(char*,...);
13 | extern int gl_inp(char*,...);
14 | extern int gl_rd(char*,...);
15 | extern int gl_rdp(char*,...);
16 | #if defined(__cplusplus)
17 | }
18 | #endif
19 |
20 | /*-----------------------------------------------------------------*/
21 | /*DefineFunction2("tpn_n_out",'i',PTIF tpn_n_out,"tpn_n_out","45ikuikk"); */
22 | /*args: type,ptr to memory,
23 | # of elts to put into OR max# to take out of the tuple space, tuple name
24 | and one of 5 commands: out=O in=I inp=i rd=R rdp=r*/
25 | /*return: #of elts actually recieved/sent*/
26 | /*VOID tpn_n_out(DATA_OBJECT_PTR rp) be able to return a mf
27 | if ever want to send >1 array in a tuple*/
28 | int tpn_n_c()
29 | {
30 | int num=1,*pi,rnum;
31 | float *pf;
32 | double *pd;
33 | char tstr[49],type,t1[2],cmnd;
34 | t1[1]='\0';
35 | /*get the type of the array*/
36 | sprintf(tstr,"%s",(char *)RtnLexeme(1));
37 | type = tolower(tstr[0]);
38 | if(type!='i' && type!='f' && type!='d' && type!='b')
39 | {
40 | printf("[1st arg=type:i or f or d]");
41 | return(-1);
42 | }
43 | /*figure out which command is being executed*/
44 | if(RtnArgCount()>4)
45 | {
46 | sprintf(tstr,"%s",(char *)RtnLexeme(5));
47 | if(!strncasecmp(tstr,"out",3)) cmnd='O';
48 | else if(!strncasecmp(tstr,"inp",3)) cmnd='i';
49 | else if(!strncasecmp(tstr,"in",2)) cmnd='I';
50 | else if(!strncasecmp(tstr,"rdp",3)) cmnd='r';
51 | else if(!strncasecmp(tstr,"rd",2)) cmnd='R';
52 | else cmnd='O';
53 | }
54 | else cmnd='O';
55 | /*get the name of the tupel*/
56 | sprintf(tstr,"%s",(char *)RtnLexeme(4));
57 |
58 | /*get the number to put out or take in*/
59 | if(RtnArgCount() > 2) num=(int)RtnLong(3);
60 |
61 | printf("[tpn_n_c:%c for %s with %d elts]",cmnd,tstr,num);
62 |
63 | switch(type)
64 | {
65 | case 'i': pi = (int *)get_ptr(2);
66 | printf("[pi=%d]",(int)pi);
67 | switch(cmnd)
68 | {
69 | case 'O': gl_out(tstr,A_INT,num,pi,NULL); rnum=num; break;
70 | case 'I': gl_in(tstr,A_INT,num,pi,&rnum,NULL); break;
71 | case 'i': gl_inp(tstr,A_INT,num,pi,&rnum,NULL); break;
72 | case 'R': gl_rd(tstr,A_INT,num,pi,&rnum,NULL); break;
73 | case 'r': gl_rdp(tstr,A_INT,num,pi,&rnum,NULL); break;
74 | }
75 | break;
76 | case 'f': pf = (float *)get_ptr(2);
77 | printf("[pf=%d]",(int)pf);
78 | switch(cmnd)
79 | {
80 | case 'O': gl_out(tstr,A_FLOAT,num,pf,NULL); rnum=num; break;
81 | case 'I': gl_in(tstr,A_FLOAT,num,pf,&rnum,NULL); break;
82 | case 'i': gl_inp(tstr,A_FLOAT,num,pf,&rnum,NULL); break;
83 | case 'R': gl_rd(tstr,A_FLOAT,num,pf,&rnum,NULL); break;
84 | case 'r': gl_rdp(tstr,A_FLOAT,num,pf,&rnum,NULL); break;
85 | }
86 | break;
87 | case 'd': pd = (double *)get_ptr(2);
88 | printf("[pd=%d]",(int)pd);
89 | switch(cmnd)
90 | {
91 | case 'O': gl_out(tstr,A_DOUBLE,num,pd,NULL); rnum=num; break;
92 | case 'I': gl_in(tstr,A_DOUBLE,num,pd,&rnum,NULL); break;
93 | case 'i': gl_inp(tstr,A_DOUBLE,num,pd,&rnum,NULL); break;
94 | case 'R': gl_rd(tstr,A_DOUBLE,num,pd,&rnum,NULL); break;
95 | case 'r': gl_rdp(tstr,A_DOUBLE,num,pd,&rnum,NULL); break;
96 | }
97 | break;
98 | }
99 | return(rnum);
100 | }
101 | /*presently this only puts 1 array into the tuple-space
102 | so for now, every array will have to go w/ a different tuple*/
103 | /*-----------------------------------------------------------------*/
104 | /*-------------------------------------------------------------------EOF--*/
105 |
--------------------------------------------------------------------------------
/clp-pvm/clp/proj.clp:
--------------------------------------------------------------------------------
1 | ;defn & msg-handlers for the PROJ class MTB
2 | ;=================================================================PROJection
3 | (defclass PROJ
4 | (is-a ACCESSIBLE)
5 | (role concrete)
6 | (pattern-match reactive)
7 | (slot from (type INSTANCE) ;where is comes from ??
8 | (create-accessor read-write))
9 | (slot to (type INSTANCE) ;where is goes to ??
10 | (create-accessor read-write))
11 | (slot for (type INSTANCE) ;what subroutine gets called after ??
12 | (create-accessor read-write)) ;it gets this data (redo so data-driven)
13 | (multislot params ;(default (create$)) ;param instances which hold values
14 | (create-accessor read-write) (visibility public))
15 | )
16 | ;-----------------------------------------------------
17 |
18 | ;-----------------------------------------------------proj SEND-TO
19 | ;pack the upk cmd in a string then pack all the params
20 | ;(map1 pack-byte ?self:params ?tid) ;then one send
21 |
22 | ;-----------------------------------------------------(U)PK-(G)-PARAM
23 | (deffunction pk-param (?param) (send (send ?param get-array) pack-byte))
24 | (deffunction upk-param (?param) (send (send ?param get-array) upack-byte))
25 |
26 | ;----------------------------------------------------send-to
27 | ;(defmessage-handler PROJ send-to primary (?task)
28 | ; (if (< (length ?self:params) 1) then
29 | ; (printout t "[WARNING: PROJ send-to has no params " ?self:params "]"))
30 | ; (initsend 1)
31 | ;;need to have params stay a mf, but can't (quote (quote)) w/out messed up ""
32 | ; (pkstr (quotes map1 upk-param (quote create$ ?self:params)))
33 | ; (map1 pk-param ?self:params)
34 | ; (send_0 ?task))
35 | ;
36 | ;(defmessage-handler PROJ send_to_n primary (?task)
37 | ; (initsend 1)
38 | ; (pkstr (quotes apply-2 send (quote create$ ?self:params) upack-n))
39 | ; (apply-2 send ?self:params pack-n)
40 | ;;this is more like mark's proj-param-array send
41 | ;;(pkstr (quotes apply-2 send (quote create$ ?self:params) upack-byte))
42 | ;;(apply-2 send ?self:params pack-byte)
43 | ; (send_0 ?task))
44 | ;then the trecv-eval loop on the other side will get the string & upk the params
45 | ;assumes the glob params are set up the same on the other side
46 | ;the string that is sent along, runs upk-param which can updates/touchs the inst
47 | ;this is more efficient than the presend deem++send, so it should be reworked
48 |
49 | ;----------------------------------------------------proj SEND_TO
50 | (defmessage-handler PROJ send_to primary (?task $?opt)
51 | (initsend 1)
52 | (pkstr (quotes apply-2 send (quote create$ ?self:params) upack-it ?opt))
53 | (apply-2 send ?self:params pack-it ?opt)
54 | (send_0 ?task))
55 |
56 | ;then the trecv-eval loop on the other side will get the string & upk the params
57 | ;----------------------
58 | ;----------------------------------------------------GET_FROM
59 | ;(defmessage-handler PROJ get_from primary (?task $?to-opt)
60 | ; (bind ?to-task (first-dflt ?to-opt (mytid))) (initsend 1)
61 | ; (pkstr (quotes send ?self send_to ?to-task ?to-opt))
62 | ; (send_0 ?task)) ;this only works if that proj is on the other side
63 | ;could do (send [clim-to-bats-init-proj] get_from [clim] [bats])
64 | ;if could assume the proper proj was there (could copy it)
65 |
66 | ;do by using a send_to for PARAM
67 | (defmessage-handler PROJ get_from primary (?task $?opt)
68 | (initsend 1)
69 | (pkstr (quotes apply-2 send (quote create$ ?self:params) send_to (mytid) ?opt))
70 | (send_0 ?task)) ;this only works if params are on the other side
71 |
72 | ;(pkstr (quotes apply-2 send (quote create$ ?self:params) pack-it ?opt))
73 | ;(apply-2 send ?self:params pack-it ?opt)
74 |
75 | ;param version of eval-send-to & send-back-to (in eval.clp)
76 | ;----------------------------------------------------
77 | ;probably have to reconfigure to synch w/ st
78 | ;----------------------------------------------------EOF
79 |
--------------------------------------------------------------------------------
/clp-pvm/clp/eval.clp:
--------------------------------------------------------------------------------
1 | ;-------fnc/hndlers to eval stuff on the other side MTB
2 | ;will need util.clp & pvm.clp (a send-str-to fnc)
3 | ;=====================
4 | ;----------------------------------------EVAL-SEND-TO
5 | (deffunction eval-send-to (?str ?task)
6 | (send-str-to (str-cat (eval ?str)) ?task))
7 |
8 | ;will evaluate the string and turn the result into a strin & send it to ?task
9 | ;often called remotely to get a result back from an eval
10 | ;-more in eval.clp -all use send-str-to
11 |
12 | ;----------------------------------------SEND-BACK-TO
13 | (deffunction send-back-to (?str ?task $?to-opt)
14 | (bind ?to-task (first-dflt ?to-opt (mytid)))
15 | (send-str-to (quotes eval-send-to ?str ?to-task) ?task))
16 |
17 | ;send a str ready for evaluation to task, it is eval-ed and the result is
18 | ; sent back in string form to your task (or optionally to another task).
19 | ;--make a send-back-to-param & eval-send-to-param (which sticks it in the value)
20 |
21 | ;=====================
22 | ;----------------------------------------------------EVAL-SEND-TO-ARRAY
23 | (deffunction eval-send-to-array (?str ?task ?array)
24 | (send-str-to (quotes send ?array put-value (eval ?str)) ?task))
25 |
26 | ;(send-str-to (quote send ?array put-value (str-cat (eval ?str))) ?task)
27 | ;don't want string, but the real value now, make sure it's the right type
28 |
29 | ;will evaluate the string and turn the result into a strin & send it to ?task
30 | ; (& this version puts it in the value slot of the given array)
31 | ;often called remotely to get a result back from an eval
32 |
33 | ;----------------------------------------------------SEND-BACK-TO-ARRAY
34 | (deffunction send-back-to-array (?str ?task ?array)
35 | (send-str-to (quotes eval-send-to-array ?str (mytid) ?array) ?task))
36 |
37 | ;?task could default to (mytid) so would always get sent back
38 | ;or the other side could do a bufinfo to see what the source is
39 |
40 | ;send a str ready for evaluation to task, it is eval-ed and the result is
41 | ; sent back in string form to your task.
42 | ; (& this version puts it in the value slot of the given array)
43 | ;---want to make sure that it puts in the correct type
44 |
45 | ;-might have a version that can send a mf back to the values slot
46 | ;-might have a version that lets you pick the slot to put it into -better
47 |
48 | ;=====================
49 | ;a version that
50 | ;lets you return the ?str eval-ed at ?task and put it in the ?slot of your ?ins
51 |
52 | ;----------------------------------------------------EVAL-SEND-TO-INS
53 | (deffunction eval-send-to-ins (?str ?task ?ins ?slot)
54 | (send-str-to (quotes send ?ins (sym-cat put- ?slot) (eval ?str)) ?task))
55 |
56 | ;----------------------------------------------------SEND-BACK-TO-INS
57 | (deffunction send-back-to-ins (?str ?task ?ins ?slot)
58 | (send-str-to (quotes eval-send-to-ins ?str (mytid) ?ins ?slot) ?task))
59 |
60 | ;=================================================================COPY routines=
61 | ;----------------------turn slot & value into a parened symbol
62 | (deffunction sv-sym (?ins ?sn) (quote ?sn (slot-value ?ins ?sn)))
63 | ;----------------------------------------------------COPY-NEW-INS-TO
64 | (deffunction copy-new-ins-to (?task ?ins $?sn-s)
65 | (if (not (instance-existp ?ins)) then
66 | (printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil))
67 | (bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s))
68 | (send-str-to
69 | (quotes make-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns))
70 | ?task))
71 | ;----------------------------------------------------COPY-OLD-INS-TO
72 | (deffunction copy-old-ins-to (?task ?ins $?sn-s)
73 | (if (not (instance-existp ?ins)) then
74 | (printout t "[WARNING: No " ?ins " in copy-ins-to]") (return nil))
75 | (bind ?sns (if (eq (length ?sn-s) 0) then (slotnames ?ins) else ?sn-s))
76 | (send-str-to
77 | (quotes modify-instance ?ins of (class ?ins) (map2 sv-sym ?ins ?sns))
78 | ?task))
79 | ;later give another name to copy it too
80 | ;;;;-------------------------------------------------------------
81 | ;;;;-------------------------------------------------------------EOF
82 |
83 |
--------------------------------------------------------------------------------
/clp-pvm/clp/param.clp:
--------------------------------------------------------------------------------
1 | ;defn & msg-handlers for the PARAM class MTB
2 | ;-sometimes what was a glob-pram will be made of a few of what where loc-params
3 | ; should references to them be sent along, or by transfering the 'glob-param'
4 | ; does it calc it from the locals, if they have been updated
5 |
6 | ;be able to mark if the array is in a model or malloced
7 | ;& if that array is in fortran or C format
8 |
9 | ;=========================================================projection_PARAMeter
10 | (defclass PARAM
11 | (is-a ACCESSIBLE)
12 | (role concrete)
13 | (pattern-match reactive)
14 | (slot count (type INTEGER) ;number of this type of instance made
15 | (create-accessor read-write) (storage shared))
16 | ;---------------------------------------------------------------has-a instances
17 | ;---------------------description of gridding of data
18 | (slot grid (type INSTANCE) ;inst w/gridding info
19 | (create-accessor read-write) (visibility public))
20 | ;---------------------description of gridding of data
21 | (slot units (type INSTANCE) ;inst w/units info
22 | (create-accessor read-write) (visibility public))
23 | ;---------------------holds the array (is in array.clp)
24 | (slot array (type INSTANCE) ;inst w/memory &assoc descript
25 | (create-accessor read-write) (visibility public))
26 | ;---------------------holds the constraint instances
27 | (multislot cnstrs (type INSTANCE)
28 | (create-accessor read-write) (visibility public))
29 | ;---------------------holds the process/sub instances which act of the inst
30 | ;=have the lists only be for the current & last simulation timesteps
31 | ;(finest grain or diferrent in each model- except for reasoning)
32 | ;-can use something like journal to show the goal state params
33 | ; or state at the begin/end of any process (as the annotation)
34 | ;This annotation will have to use the abstract process name (eg. [srfx])
35 | (multislot journal (type INSTANCE) ;would be nice to also add the time
36 | (create-accessor read-write) (visibility public))
37 | (multislot journal-time (type INTEGER) ;time of the journal entry
38 | (create-accessor read-write) (visibility public))
39 | (multislot journal-use (type INTEGER) ;used as in out in-out
40 | (create-accessor read-write) (visibility public)) ;assume only 'out'?
41 | ;-journal might get really long quickly with looping
42 | ; easier to keep a journal of calls, & then reconstruct the params-touched ?
43 | ;;---------------------description of type of data (meaning??)
44 | ; (slot descript (type INSTANCE) ;might hold constraints
45 | ; (create-accessor read-write) (visibility public))
46 | ;----------------------------------------------------------------extra val rep??
47 | ;for viewing & matching, which can be done with (param)arrays
48 | ;w/deamons can get and set val_ptr ed space, and update get/put-time
49 | (slot value ;first value (usually only if xyz=111)??
50 | (create-accessor read-write) (visibility public))
51 | (multislot values ;first values(usually only if xyz=n11)??
52 | (create-accessor read-write) (visibility public)))
53 | ;if copy over all the slots, then the refered to instances latter, they can
54 | ; be chekced with a sim-time stamp, and the value(s) slot too
55 | ;-----------------------------------------------------------------
56 | ;constraints checked when the value is updated (maybe for get/put seperately)
57 | ; might have w/>1 param so put in each to be 2way
58 | ;-----------------------------------------------------------------
59 | ;use descriptive/(standard) names (so could even do defaults from the name)
60 | ;defclass GRID in param-lib.clp
61 | ;defclass UNITS in param-lib.clp
62 | ;defclass CONSTR in param-lib.clp
63 | ;defclass ARRAY in array.clp
64 | ;if copy param to another task,refer to has-a as needed,use in-task slot to find
65 | ;------------------------------------------------------------------
66 | (defmessage-handler PARAM pack-it primary ($?n-off)
67 | (send ?self:array pack-it ?n-off))
68 | (defmessage-handler PARAM upack-it primary ($?n-off)
69 | (send ?self:array upack-it ?n-off))
70 | ;-------------------
71 | ;Linda-like fncs/hndlers should be written around the param-
72 | ;------------------------------------------------------------------EOF
73 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/vocabulary-abbr.clp:
--------------------------------------------------------------------------------
1 | ;OWL
2 | (defglobal ?*owl:AllDifferent* = owl:AllDifferent)
3 | (defglobal ?*owl:allValuesFrom* = owl:allValuesFrom)
4 | (defglobal ?*owl:AnnotationProperty* = owl:AnnotationProperty)
5 | (defglobal ?*owl:backwardCompatibleWith* = owl:backwardCompatibleWith)
6 | (defglobal ?*owl:cardinality* = owl:cardinality)
7 | (defglobal ?*owl:Class* = owl:Class)
8 | (defglobal ?*owl:complementOf* = owl:complementOf)
9 | (defglobal ?*owl:DataRange* = owl:DataRange)
10 | (defglobal ?*owl:DatatypeProperty* = owl:DatatypeProperty)
11 | (defglobal ?*owl:DeprecatedClass* = owl:DeprecatedClass)
12 | (defglobal ?*owl:DeprecatedProperty* = owl:DeprecatedProperty)
13 | (defglobal ?*owl:differentFrom* = owl:differentFrom)
14 | (defglobal ?*owl:disjointWith* = owl:disjointWith)
15 | (defglobal ?*owl:distinctMembers* = owl:distinctMembers)
16 | (defglobal ?*owl:equivalentClass* = owl:equivalentClass)
17 | (defglobal ?*owl:equivalentProperty* = owl:equivalentProperty)
18 | (defglobal ?*owl:FunctionalProperty* = owl:FunctionalProperty)
19 | (defglobal ?*owl:hasValue* = owl:hasValue)
20 | (defglobal ?*owl:imports* = owl:imports)
21 | (defglobal ?*owl:incompatibleWith* = owl:incompatibleWith)
22 | (defglobal ?*owl:intersectionOf* = owl:intersectionOf)
23 | (defglobal ?*owl:InverseFunctionalProperty* = owl:InverseFunctionalProperty)
24 | (defglobal ?*owl:inverseOf* = owl:inverseOf)
25 | (defglobal ?*owl:maxCardinality* = owl:maxCardinality)
26 | (defglobal ?*owl:minCardinality* = owl:minCardinality)
27 | (defglobal ?*owl:Nothing* = owl:Nothing)
28 | (defglobal ?*owl:ObjectProperty* = owl:ObjectProperty)
29 | (defglobal ?*owl:oneOf* = owl:oneOf)
30 | (defglobal ?*owl:onProperty* = owl:onProperty)
31 | (defglobal ?*owl:Ontology* = owl:Ontology)
32 | (defglobal ?*owl:OntologyProperty* = owl:OntologyProperty)
33 | (defglobal ?*owl:priorVersion* = owl:priorVersion)
34 | (defglobal ?*owl:Restriction* = owl:Restriction)
35 | (defglobal ?*owl:sameAs* = owl:sameAs)
36 | (defglobal ?*owl:someValuesFrom* = owl:someValuesFrom)
37 | (defglobal ?*owl:SymmetricProperty* = owl:SymmetricProperty)
38 | (defglobal ?*owl:Thing* = owl:Thing)
39 | (defglobal ?*owl:TransitiveProperty* = owl:TransitiveProperty)
40 | (defglobal ?*owl:unionOf* = owl:unionOf)
41 | (defglobal ?*owl:versionInfo* = owl:versionInfo)
42 | (defglobal ?*owl:hasKey* = owl:hasKey)
43 | (defglobal ?*owl:onClass* = owl:onClass)
44 | (defglobal ?*owl:minQualifiedCardinality* = owl:minQualifiedCardinality)
45 | (defglobal ?*owl:maxQualifiedCardinality* = owl:maxQualifiedCardinality)
46 | (defglobal ?*owl:qualifiedCardinality* = owl:qualifiedCardinality)
47 | (defglobal ?*owl:propertyChainAxiom* = owl:propertyChainAxiom)
48 | (defglobal ?*owl:AllDisjointClasses* = owl:AllDisjointClasses)
49 | (defglobal ?*owl:members* = owl:members)
50 |
51 |
52 |
53 | ;RDF/RDFS
54 | (defglobal ?*rdfs:Resource* = rdfs:Resource)
55 | (defglobal ?*rdfs:Literal* = rdfs:Literal)
56 | (defglobal ?*rdf:XMLLiteral* = rdf:XMLLiteral)
57 | (defglobal ?*rdfs:Class* = rdfs:Class)
58 | (defglobal ?*rdf:Property* = rdf:Property)
59 | (defglobal ?*rdfs:Datatype* = rdfs:Datatype)
60 | (defglobal ?*rdf:Statement* = rdf:Statement)
61 | (defglobal ?*rdf:Bag* = rdf:Bag)
62 | (defglobal ?*rdf:Seq* = rdf:Seq)
63 | (defglobal ?*rdf:Alt* = rdf:Alt)
64 | (defglobal ?*rdfs:Container* = rdfs:Container)
65 | (defglobal ?*rdfs:ContainerMembershipProperty* = rdfs:ContainerMembershipProperty)
66 | (defglobal ?*rdf:List* = rdf:List)
67 | (defglobal ?*rdf:type* = rdf:type)
68 | (defglobal ?*rdfs:subClassOf* = rdfs:subClassOf)
69 | (defglobal ?*rdfs:subPropertyOf* = rdfs:subPropertyOf)
70 | (defglobal ?*rdfs:domain* = rdfs:domain)
71 | (defglobal ?*rdfs:range* = rdfs:range)
72 | (defglobal ?*rdfs:label* = rdfs:label)
73 | (defglobal ?*rdfs:comment* = rdfs:comment)
74 | (defglobal ?*rdfs:member* = rdfs:member)
75 | (defglobal ?*rdf:first* = rdf:first)
76 | (defglobal ?*rdf:rest* = rdf:rest)
77 | (defglobal ?*rdf:nil* = rdf:nil)
78 | (defglobal ?*rdfs:seeAlso* = rdfs:seeAlso)
79 | (defglobal ?*rdfs:isDefinedBy* = rdfs:isDefinedBy)
80 | (defglobal ?*rdf:value* = rdf:value)
81 | (defglobal ?*rdf:subject* = rdf:subject)
82 | (defglobal ?*rdf:predicate* = rdf:predicate)
83 | (defglobal ?*rdf:object* = rdf:object)
84 |
85 | ;Some xsd types
86 | (defglobal ?*xsd:int* = xsd:int)
87 | (defglobal ?*xsd:float* = xsd:float)
88 | (defglobal ?*xsd:short* = xsd:short)
89 | (defglobal ?*xsd:byte* = xsd:byte)
90 | (defglobal ?*xsd:boolean* = xsd:boolean)
91 | (defglobal ?*xsd:string* = xsd:string)
92 | (defglobal ?*xsd:nonNegativeInteger* = xsd:nonNegativeInteger)
93 | (defglobal ?*xsd:Integer* = xsd:Integer)
94 | (defglobal ?*xsd:integer* = xsd:integer)
95 | (defglobal ?*xsd:anyURI* = xsd:anyURI)
96 | (defglobal ?*xsd:positiveInteger* = xsd:positiveInteger)
97 | (defglobal ?*xsd:nonPositiveInteger* = xsd:nonPositiveInteger)
98 | (defglobal ?*xsd:dateTime* = xsd:dateTime)
99 |
100 |
--------------------------------------------------------------------------------
/clp-pvm/c/tsd-agent.c:
--------------------------------------------------------------------------------
1 | /*---------------------------------------------------------------------------
2 | /* FuzzyClips w/ PVM (Model)/'Agent' code includes:
3 | // "C" Language Integrated Production System, CLIPS Version 6.02
4 | // Gary D. Riley, Software Technology Branch of NASA-Johnson Space Center
5 | // Fuzzy reasoning extensions w/ certainty factors for facts and rules
6 | // Bob Orchard, NRCC - Nat'l Research Council of Canada
7 | // PVM (Parallel Virtual Machine) communication extentions, Mike Bobak, ANL
8 | /----------------------------------------------------------------------------*/
9 | /* Use: ts-agt -r "(load util.clp)" -r "(load pvm.clp)"
10 | or ts-agt -r "(batch b)" where the file b has the above commands*/
11 | /* To include model specific code, add lines like those in pvm[ud]fncs.c */
12 |
13 | /*c-l-fncs.c c-misc-fncs.c c-pvm-fncs.c c-misc-defs.c c-pvm-defs.c ts-agent.c*/
14 |
15 | #include "c-misc-fncs.c"
16 | #include "c-pvm-fncs.c"
17 | #include "c-l-fncs.c"
18 | #include "clipsmain.c"
19 | #define PTIF (int (*)(VOID_ARG))
20 | #define VPTIF (void (*)(VOID_ARG))
21 | /* DefineFunction2("DF2"",'i',PTIF DF2,"DF2","45iskuss"); */
22 | int
23 | DF2()
24 | {
25 | char c1, chr1[9] ,str1[99] ,str2[99] ,str3[99];
26 | /*PTIF fncptr; at the worst might have to give the return type &do a switch*/
27 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
28 | fncptr = PTIF get_ptr(3);
29 | if((int)fncptr < 999) printf("[fncptr=%d]",(int)fncptr); /*return(0);*/
30 | sprintf(str1,"%s",(char *)RtnLexeme(1));
31 | sprintf(chr1,"%s",(char *)RtnLexeme(2));
32 | sprintf(str2,"%s",(char *)RtnLexeme(4));
33 | c1= chr1[0];
34 | printf("[DefineFunction2 for:%s with type=%c]\n",str1,c1);
35 | if(RtnArgCount()>4)
36 | {
37 | sprintf(str3,"%s",(char *)RtnLexeme(5));
38 | DefineFunction2(str1,c1,PTIF fncptr,str2,str3);
39 | }
40 | else DefineFunction(str1,c1,PTIF fncptr,str2);
41 | return(1);
42 | }
43 | /*if this could be done interactively then a compiled model could print out
44 | a batch file that would desribe all the fnc(in C) directly as clips fncs
45 | -it might still be a good idea to have instances to call the fncs
46 | it would at least save putting ifs in, allowing for direct calling*/
47 | /*problem is turning the cmndline version of the fnc into the fnc ptr
48 | don't think it will work. the only way is if all the possible functions
49 | where compiled in extern&all, in a big switch -then there is the opt
50 | to make it a clips deffunction or if something is linked in use that
51 | ---could be done on arg types.. or vararg wrappers to Cfncs---??*/
52 |
53 | /*could have any obj files print out the fnc ptrs in a SUBROUTINE inst
54 | then DF2 could be called with this #, as part of a handler call
55 | -this might even be able to done w/ fortran code w/out having to use f2c*/
56 | /*start including val_ptr slots in the subroutines and try DF2 w/ this #*/
57 |
58 | /*can at least use these fnc ptrs for some basic in C array ops*/
59 |
60 | /*Don't need to use DF2, can just call using the ptr to the fnc/sub &
61 | all the ptrs to the args, (all wrapped in a fnc/sub clips inst)*/
62 |
63 | /* DefineFunction2("cf0i"",'i',PTIF cf0i,"cf0i","11ii"); */
64 | int
65 | cf0i()
66 | {
67 | int (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
68 | int i;
69 | fncptr = PTIF get_ptr(1);
70 | printf("[cf0i:calling %d]\n",(int)fncptr);
71 | i=fncptr();
72 | return(i);
73 | }
74 | /* DefineFunction2("cf0v"",'i',PTIF cf0v,"cf0v","11ii"); */
75 | int
76 | cf0v()
77 | {
78 | void (*fncptr)(); /*might only be wrapping fnc that rtn ints anyway*/
79 | fncptr = VPTIF get_ptr(1);
80 | printf("[cf0v:calling %d]\n",(int)fncptr);
81 | fncptr();
82 | return(1);
83 | }
84 | /*will want a version that can handle a arbitrary number of arg ptrs*/
85 |
86 | /* (DF2 "tst" i tst "tst" "11ik"); */
87 | /* (DF2 "srrf" i # "srrf" "00i"); */
88 | int tst() {
89 | char str1[99];
90 | sprintf(str1,"%s",(char *)RtnLexeme(1));
91 | printf("[test fnc tst can print out:%s]\n",str1);
92 | return(1);
93 | }
94 |
95 | extern int ftst_();
96 |
97 | int ctst()
98 | {
99 | printf("(ftst of FUNC (val_ptr %d))",(int)ftst_);
100 | fflush(stdout);
101 | }
102 |
103 | /*---------------------------------------------------------------USERFUNCTIONS*/
104 | VOID UserFunctions()
105 | {
106 | #include "c-misc-defs.c"
107 | #include "c-pvm-defs.c"
108 | DefineFunction2("tpn_n_c",'i',PTIF tpn_n_c,"tpn_n_c","45ikuikk");
109 | DefineFunction2("DF2",'i',PTIF DF2,"DF2","45iskuss");
110 | DefineFunction2("cf0i",'i',PTIF cf0i,"cf0i","11ii");
111 | DefineFunction2("cf0v",'v',PTIF cf0v,"cf0v","11ii");
112 | DefineFunction2("ftst",'i',PTIF ftst_,"ftst","00i");
113 | DefineFunction2("ctst",'i',PTIF ctst,"ctst","00i");
114 | }
115 | /*----------------------------------------------------------------EOF*/
116 |
--------------------------------------------------------------------------------
/clp-pvm/clp/param-lib.clp:
--------------------------------------------------------------------------------
1 | ;defn & msg-handlers for some of the PARAM class (has-a classes) MTB
2 | ;-sometimes what was a glob-pram will be made of a few of what where loc-params
3 | ; should references to them be sent along, or by transfering the 'glob-param'
4 | ; does it calc it from the locals, if they have been updated
5 | ;=========================================================projection_PARAMeter
6 | ;defclass PARAM in param.clp
7 | ;=================================================================GRID
8 | (defclass GRID
9 | (is-a ACCESSIBLE)
10 | (role concrete)
11 | (pattern-match reactive)
12 | (slot units (type SYMBOL) ;actuall units (eg: ft,mi,m,km,deg)
13 | (create-accessor read-write) (visibility public))
14 | ;could take any 2 opposite corners, but this is easier for now
15 | (multislot corner-sw (type FLOAT) ;location of SW-lower corner
16 | (create-accessor read-write) (visibility public))
17 | (multislot corner-ne (type FLOAT) ;location of NE-upper corner
18 | (create-accessor read-write) (visibility public))
19 | (multislot delta (type FLOAT) ;length of delta-x-y-z segments
20 | (create-accessor read-write) (visibility public))
21 | (multislot nseg (type INTEGER) ;# of segments (should=array's xyz)
22 | (create-accessor read-write) (visibility public))
23 | )
24 | ;deg would be in deg-min-sec, but can't do z this way
25 | ;will be able to have relation like subgrid-p & eq-sp-subgrid-p
26 | ;& fncs like grid-intersection & grid-union
27 | ;-----------------------------------------------------------------
28 | ;=================================================================UNITS
29 | ;SI base-units: meter, kilogram, second, ampere, Kelvin, mole, and candela
30 | ; length, mass, time, current, temprature, mole, illum
31 | ; l(m) m(kg) t(s) c(A) t(K) (M) Cnd
32 | ;force=newton=kg m / s s
33 | ;--might not need an instance for this? (more just standardization of names)
34 | (defclass UNITS ;name the instance w/ the basic-unit types (above order)
35 | (is-a ACCESSIBLE)
36 | (role concrete)
37 | (pattern-match reactive)
38 | (multislot units (type SYMBOL) ;actuall units (eg: ft / sec sec) orStr?
39 | (create-accessor read-write) (visibility public))
40 | (multislot units-type (type SYMBOL) ;type equiv (eg: length / time time)
41 | (create-accessor read-write) (visibility public))
42 | (multislot units-si (type SYMBOL) ;SI equiv (eg: m / sec sec) [7 types]
43 | (create-accessor read-write) (visibility public))
44 | (multislot syn (type SYMBOL) ;list of eqv unit defns (use member$)
45 | (create-accessor read-write) (visibility public)))
46 | ;have all numerator terms a / then all the denominator terms
47 | ;-----------------------------------------------------------------
48 | ;=================================================================DESCRIPT
49 | ;(defclass DESCRIPT ;describe maybe hold constraints -ref?
50 | ; (is-a ACCESSIBLE)
51 | ; (role concrete)
52 | ; (pattern-match reactive)
53 | ;(slot journal (type INSTANCE) ;list of proceedures applied to the param
54 | ;(create-accessor read-write) (visibility public))
55 | ;(slot constr (type INSTANCE) ;list of constraint instances
56 | ;(create-accessor read-write) (visibility public))
57 | ;;maybe put these in contraint objs:
58 | ;(multislot range ;min & max of the values
59 | ; (create-accessor read-write) (visibility public))
60 | ;(slot default ;default value for the array value(s)
61 | ; (create-accessor read-write) (visibility public)))
62 | ;for units ft/(sec sec), ft/sec sec, ft/sec/sec or num= ft den= sec sec
63 | ;range/default values could be another param-inst
64 | ; which could mean use its range/default slots or the sep vals of the array
65 | ;could have get-actual-min get-actual-max get-mean get-median <-for arrays
66 | ;dumping the normed values or histogram of val bins to a fuz-fact ?
67 | ;would be nice to make arrays a base clips obj -or not
68 | ;------------------------------------------------------------------
69 | ;=================================================================CONSTR
70 | (defclass CONSTR ;constraints
71 | (is-a SUBROUTINE)
72 | (role concrete)
73 | (pattern-match reactive)
74 | )
75 | ;use the constraint obj that updates slots/params/etc
76 | ;make it general, maybe like a subroutine, have good backup fncs
77 | ;---------------------------------------------------------------------------
78 | ;---still want to have params which are composed of other params,so need map-fnc
79 | ;-------------------
80 | ;instead of mapping, just have full description which can be mapped between
81 | ; (multislot from-var (type SYMBOL) ;variable(s) mapped from (usually 1)
82 | ; (create-accessor read-write) (visibility public))
83 | ; (slot to-var (type SYMBOL) ;variable mapped to
84 | ; (create-accessor read-write) (visibility public))
85 | ;;;have to list the model separtely, if no proxy around
86 | ;;(multislot from-mod (type SYMBOL) ;model(s) mapped from (almost always 1)
87 | ; (create-accessor read-write) (visibility public))
88 | ;;(slot to-mod (type SYMBOL) ;model mapped to
89 | ; (create-accessor read-write) (visibility public))
90 | ; (slot map-fnc (type SYMBOL) ;fnc to map between them
91 | ; (create-accessor read-write) (visibility public)) )
92 | ;-------------------
93 | ;Linda-like fncs/hndlers should be written around the param-
94 | ;------------------------------------------------------------------EOF
95 |
--------------------------------------------------------------------------------
/clp-pvm/c/c-msc.c:
--------------------------------------------------------------------------------
1 | /*misc functions to be included in the clips main file, M. Bobak, ANL*/
2 |
3 | #define ISMETH(m,ts,ac) (!strcasecmp((m),(ts)) && ((ac)+2)==get_ac())
4 | /*---------------------------------------------------------INCLUDES*/
5 | /*---------------------------------------------------------general*/
6 | #include
7 | #include
8 | #include
9 | #include
10 | #include
11 | #include
12 | #include
13 | /*---------------------------------------------------------extern C*/
14 | #ifdef __cplusplus
15 | extern "C" {
16 | #endif
17 | /*---------------------------------------------------------clips*/
18 | #include "clips.h" /*has Rtn*fncs, so fnc can get args from clips*/
19 | #include "setup.h"
20 | #include "sysdep.h"
21 | #include "extnfunc.h"
22 | #include "commline.h"
23 | #define PTIF2 (void (*)(VOID_ARG))
24 | /*---------------------------------------------------------*/
25 | #include "symbol.h"
26 | #include "router.h"
27 | #include "engine.h"
28 | #include "argacces.h"
29 | #include "prntutil.h"
30 | /*---------------------------------------------------------*/
31 | #ifdef __cplusplus
32 | }
33 | #endif
34 | /*---------------------------------------------------------clipsmain*/
35 | /*#include "incl/clipsmain.c"*/
36 | /*the idea is to not have to store it in clips,*/
37 | /*---------------------------------------------------------TYPELEN*/
38 | /*DefineFunction2("typelen",'i',PTIF typelen,"typelen","11kk"); */
39 | int typelen()
40 | {
41 | int r;
42 | char c,type[14];
43 | sprintf(type,"%s",(char *)RtnLexeme(1)); /*type = *RtnLexeme(2);*/
44 | c = type[0];
45 | switch(tolower(c))
46 | {
47 | case 'b' : r = 1; break;
48 | case 'i' : r = sizeof(int); break;
49 | case 'f' : r = sizeof(float); break;
50 | case 'd' : r = sizeof(double); break;
51 | case 'l' : r = sizeof(long); break;
52 | default : r = sizeof(float); break;
53 | }
54 | return(r);
55 | }
56 | /*=======================================================--CLIPS fncs*/
57 | /*might want to break out the fncs that don't have wrappers
58 | so they can be included by any file that does have wrappers
59 | and wants to use them (not necc if all incl in 1 big file)
60 | (better to link in wrapper files seperately though)*/
61 | /*would be nice to have fncs to set/get vals from mf-s*/
62 | /*=======================================================--internal fncs*/
63 | /*----------------------------------------------------------PTR_TO_INT*/
64 | /*DefineFunction2("ptr_to_int",'l',PTIF ptr_to_int,"ptr_to_int","11uu");*/
65 | /*args: 1 ptr (accesible from get_ptr)*/
66 | /*ret: the long int version of the ptr(so does anything if started as a long)*/
67 | long ptr_to_int()
68 | {
69 | return((long)get_ptr(1));
70 | }
71 | /*---------------------------------------------------------*/
72 | /*=======================================================-- clips fncs*/
73 | /*---------------------------------------------------------ADDRUNFNC*/
74 | /*DefineFunction2("addrunfnc",'i',PTIF addrunfnc,"addrunfnc","25iss"); */
75 | /*engine.h: LOCALE BOOLEAN AddRunFunction(char *,VOID (*)(void),int);*/
76 | /*eg. (addrunfnc "nrecv_route" "nrecv_route" 1)*/
77 | int addrunfnc()
78 | {
79 | char str[99],fnc[99];
80 | int priority=1,start=0,remove=0,cnt;
81 | cnt= RtnArgCount();
82 | sprintf(str,"%s",(char *)RtnLexeme(1));
83 | sprintf(fnc,"%s",(char *)RtnLexeme(2));
84 | if(cnt>2) priority = (int)RtnLong(3);
85 | if(cnt>3) start = (int)RtnLong(4);
86 | if(cnt>4) remove = (int)RtnLong(5);
87 | if(!remove)
88 | {
89 | /* if(start==1) return(AddRunStartFunction(str,PTIF fnc,priority));*/
90 | /* else if(start==2) return(AddRunStopFunction(str,PTIF fnc,priority));*/
91 | /* else */
92 | /*bad argument 2 type for AddRunFunction(): int (*)() ( void (*)() expected)*/
93 | return(AddRunFunction(str,PTIF2 fnc,priority));
94 | } else
95 | {
96 | /* if(start==1) return(RemoveRunStartFunction(str));*/
97 | /* else if(start==2) return(RemoveRunStopFunction(str));*/
98 | /* else */
99 | return(RemoveRunFunction(str));
100 | }
101 | }
102 | /*=======================================================--utility fncs*/
103 | /*str-cat sym-cat sub-string str-index upcase lowcase p155*/
104 | /*---------------------------------------------------------STR-CMP*/
105 | /*DefineFunction2("str-cmp",'i',PTIF str-cmp,"str-cmp","24iss"); */
106 | int str_cmp()
107 | {
108 | int cnt,len=0;
109 | char s1[44],s2[44];
110 | sprintf(s1,"%s",(char *)RtnLexeme(1));
111 | sprintf(s2,"%s",(char *)RtnLexeme(2));
112 | cnt= RtnArgCount();
113 | if(cnt>2)
114 | {
115 | len = (int)RtnLong(3);
116 | if(len>0)
117 | {
118 | if(cnt>3) return(strncasecmp(s1,s2,len));
119 | else return(strncmp(s1,s2,len));
120 | } else
121 | {
122 | if(cnt>3) return(strcasecmp(s1,s2));
123 | else return(strcmp(s1,s2));
124 | }
125 | } else return(strcmp(s1,s2));
126 | } /*there is already a str-compare*/
127 | /*---------------------------------------------------------ATOI*/
128 | /*DefineFunction2("atoi",'i',PTIF catoi,"catoi","11s"); */
129 | int catoi()
130 | {
131 | char s1[44];
132 | sprintf(s1,"%s",(char *)RtnLexeme(1));
133 | return(atoi(s1));
134 | }
135 | /*---------------------------------------------------------ATOF*/
136 | /*DefineFunction2("atof",'f',PTIF catof,"catof","11s"); */
137 | float catof()
138 | {
139 | char s1[44];
140 | sprintf(s1,"%s",(char *)RtnLexeme(1));
141 | return(atof(s1));
142 | }
143 | /*moved memeory fncs to c-ary.c*/
144 | /*---------------------------------------------------------*/
145 | /*---------------------------------------------------------EOF*/
146 |
--------------------------------------------------------------------------------
/clp-pvm/c/clipsmain.c:
--------------------------------------------------------------------------------
1 | /*--this is the main loop for clips, to be included
2 | //M. Bobak, ANL
3 | //---------------------------------------------------------*/
4 | /*******************************************************/
5 | /* "C" Language Integrated Production System */
6 | /* A Product Of The */
7 | /* Software Technology Branch */
8 | /* NASA - Johnson Space Center */
9 | /* CLIPS Version 6.00 05/12/93 */
10 | /* MAIN MODULE */
11 | /*******************************************************/
12 | /*************************************************************/
13 | /* Principal Programmer: Gary D. Riley */
14 | /* Contributing Programmer(s): */
15 | /* Bob Orchard (NRCC - Nat'l Research Council of Canada)*/
16 | /* (Fuzzy reasoning extensions) */
17 | /* (certainty factors for facts and rules) */
18 | /* Mike Bobak (PVM extentions) */
19 | /*************************************************************/
20 | #if FUZZY_DEFTEMPLATES
21 | #include "fuzzyutl.h"
22 | #include "fuzzymod.h"
23 | #endif
24 | /*---------------------------------------------------------just added fuzzymod*/
25 | /***********************************************************/
26 | /* RerouteStdin: Reroutes stdin to read initially from the */
27 | /* file specified on the command line with -r option. */
28 | /***********************************************************/
29 | globle VOID RerouteStdin2(int argc, char** argv) /*int argc; char *argv[];*/
30 | {
31 | int i;
32 | /* If no arguments return */
33 | if (argc < 3) { return; }
34 | /* If argv was not passed then forget it */
35 | if (argv == NULL) return;
36 |
37 | for (i = 1 ; i < argc ; i++)
38 | {
39 | if (strcmp(argv[i],"-r") == 0)
40 | {
41 | if (i > (argc-1))
42 | {
43 | PrintErrorID("SYSDEP",1,CLIPS_FALSE);
44 | PrintCLIPS(WERROR,"No string found for -r option\n");
45 | return;
46 | }
47 | else
48 | {
49 | printf("Doing a: RouteCommand(%s)\n",argv[++i]); fflush(stdout);
50 | RouteCommand(argv[i]);
51 | }
52 | }
53 | }
54 | }
55 | /*---------------------------------------------------------
56 | //RUN: Starts execution of rules. Rules fire until agenda is empty or
57 | // the number of rule firings limit specified by the first argument
58 | // is reached (infinity if unspecified).
59 | // A fuzzyCLIPS extension assigns a special meaning to the rule limit
60 | // value -2 and values less than -2. For -2 the inference cycle will
61 | // continue forever (or until a break, control-C, is encountered).
62 | // Even when the agenda is empty the cycle will continue and any
63 | // functions added to the runtime list will be executed. If the
64 | // value is less than -2 then the cycle will continue until |limit|
65 | // rules have been fired even if the agenda becomes empty at some time.
66 | //(run [])
67 | //---------------------------------------------------------*/
68 | #if defined(__cplusplus)
69 | extern "C" {
70 | #endif
71 |
72 | #if ANSI_COMPILER
73 | int main(int,char *[]);
74 | VOID UserFunctions(void);
75 | #else
76 | int main();
77 | VOID UserFunctions();
78 | #endif
79 |
80 | #if defined(__cplusplus)
81 | }
82 | #endif
83 | /***************************************************************/
84 | /* MAIN: Start execution of CLIPS. This function must be */
85 | /* redefined in order to embed CLIPS within another program. */
86 | /* Example of redefined main: */
87 | /* main() */
88 | /* { */
89 | /* InitializeCLIPS(); */
90 | /* . */
91 | /* . */
92 | /* ProcessData(); */
93 | /* RunCLIPS(-1); */
94 | /* EvaluateData(); */
95 | /* . */
96 | /* . */
97 | /* FinalResults(); */
98 | /* } */
99 | /***************************************************************/
100 | #if defined(__cplusplus)
101 | int main (int argc, char *argv[])
102 | #else
103 | int main(argc,argv)
104 | int argc;
105 | char *argv[] ;
106 | #endif /* defined(__cplusplus) */
107 | {
108 | InitializeCLIPS();
109 | RerouteStdin(argc,argv); /*handles batch files (done in CommandLoop)*/
110 | /* RerouteStdin2(argc,argv); //my version -r "any command to route" (done now)
111 | // the new lib has the -r option in RerouteStdin */
112 | CommandLoop();
113 | return(-1);
114 | }
115 | /*************************************************************/
116 | /* UserFunctions: The function which informs CLIPS of any */
117 | /* user defined functions. In the default case, there are */
118 | /* no user defined functions. To define functions, either */
119 | /* this function must be replaced by a function with the */
120 | /* same name within this file, or this function can be */
121 | /* deleted from this file and included in another file. */
122 | /* User defined functions may be included in this file or */
123 | /* other files. */
124 | /* Example of redefined UserFunctions: */
125 | /* UserFunctions() */
126 | /* { */
127 | /* DefineFunction("fun1",'i',fun1,"fun1"); */
128 | /* DefineFunction("other",'f',other,"other"); */
129 | /* } */
130 | /*************************************************************/
131 |
--------------------------------------------------------------------------------
/clp-pvm/clp/rul.clp:
--------------------------------------------------------------------------------
1 | ;-----------------------------------------------------new:
2 | (defclass TID ;task obj id ;mirror globals for now
3 | (is-a INITIAL-OBJECT)
4 | (role concrete) (pattern-match reactive)
5 | (slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id)
6 | (slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id)
7 | (slot start-time (type FLOAT) (create-accessor read-write)) ;also was a global ;try diff type
8 | (slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global ;does it change w/time?
9 | (slot elapse-time (type FLOAT) (create-accessor read-write)) ;was a fact
10 | (slot model (type INTEGER) (create-accessor read-write)) ;also was a global
11 | (multislot inst-tids (create-accessor read-write)) ;also was a global
12 | )
13 | ;------------------------------------------------RULES
14 | ;the first rule to run (goes only once/reset),
15 | ;sets globals & some other stuff.
16 | (defrule startup-TIME
17 | (initial-fact)
18 | =>
19 | ;(add_nrcv_route)
20 | ;(assert (TIME (rt2)))
21 | (assert (TIME 0.0))
22 | (bind ?*my-tid* (mytid))
23 | (bind ?*parent-tid* (parent))
24 | (printout t " mytid= " ?*my-tid* crlf)
25 | (bind ?*start-time* (time))
26 | ;-new
27 | (make-instance mytid of TID ;new
28 | (start-time ?*start-time*)
29 | (tid ?*my-tid*)
30 | (pid ?*parent-tid*)
31 | )
32 | ;(send [mytid] put-start-time ?*start-time*)
33 | ;(send [mytid] put-tid ?*my-tid*)
34 | ;(send [mytid] put-pid ?*parent-tid*)
35 | ;
36 | ;(make-tasks) ;set up the TASK instances
37 | ;(bcast-str (tasks ?*my-tid*)) ;make sure others get this new 1
38 | (initsend)
39 | (agenda)
40 | )
41 |
42 | ;the problem is after the 1st time test fails, it is never checked again
43 | ;until the fact chages, (could try tick tock w/ nrecv_rout)
44 |
45 | ;updates the time, and does receives of command-strings
46 | (defrule UPDATE-TIME
47 | (declare (salience -50)) ;could go up w/time
48 | ?t <- (TIME ?old-time)
49 | ; (test (neq (rt2) ?old-time))
50 | =>
51 | (printout t "UT=" (rt2) " ")
52 | ;(if (not (nrecv_route)) then (system "sleep 1"))
53 | (trecv_eval ?*recv-d-time*)
54 | (send [mytid] put-recv-d-time ?*recv-d-time*) ;new
55 | (send [mytid] put-elapse-time (elapse-time)) ;new
56 | (retract ?t)
57 | ;(assert (TIME (rt2)))
58 | ;(assert (TIME (- (time) ?*start-time*)))
59 | (assert (TIME (elapse-time)))
60 | (agenda)
61 | )
62 | ;-------------------------------------------------context rules
63 | ;;;;;;--this is out of date, latest work is in the tmp rul files
64 | ;(deffunction find-pp (?ppname)
65 | ; (find-instance (?pp PROVIDED-PARAM)
66 | ; (eq ?pp:gname ?ppname)))
67 | ;fix for all.clp -mb ;no class or gname elsewhere, glenda, howto-fix? ;also not called
68 | (defclass PROVIDED-PARAM ;add this, as this file was probably lost.
69 | (is-a PARAM) ;(is-a ACCESSIBLE)
70 | (role concrete)
71 | (pattern-match reactive)
72 | (slot gname (create-accessor read-write)) ;maybe w/glenda?
73 | ) ;it is used in 'inputs' slot below, so there was even a produced|similar subclass?
74 | (defclass PROCESS ;add this, as this file was probably lost, which really sucks. -mb
75 | (is-a ACCESSIBLE)
76 | (role concrete)
77 | (pattern-match reactive)
78 | (multislot inputs (create-accessor read-write)) ;
79 | (multislot outputs (create-accessor read-write)) ;
80 | (multislot comp-proc (create-accessor read-write)) ;
81 | )
82 | (deffunction find-pp (?ppname)
83 | (find-instance ((?pp PROVIDED-PARAM))
84 | (eq ?pp:gname ?ppname)))
85 | (deffunction maprm (?l1 ?l2) (set-difference ?l1 ?l2)) ;just a guess right now-mb
86 | ;-------------------------------------------------FIND-PROC-PROVIDES
87 | (defrule FIND-PROC-PROVIDES
88 | (declare (salience 5)) ;doing before make-proc-chunks could save time?
89 | ?p1 <- (object (is-a PROCESS) (inputs ?in1) ;mved a paren back up-mb
90 | (outputs ?out1)
91 | (comp-proc ?cp1))
92 | =>
93 | ;(map1 find-pp ?in1) ;gives a list of params that are provided for the proc
94 | ;this process's params should then be marked as being available
95 | ; and can be taken out of the active input list
96 | ;-would be good to save the old list or mark as not matchable
97 | (send ?p1 put-inputs (maprm (map1 find-pp ?in1) ?in1))
98 | )
99 | ;-------------------------------------------------MAKE-PROC-CHUNKS
100 | ;make a process out of 2 processes (refire till no more chunking/its usable)
101 | (defrule MAKE-PROC-CHUNKS
102 | ?p1 <- (object (is-a PROCESS) (inputs $?in1)
103 | (outputs $?out1)
104 | (comp-proc $?cp1))
105 | ?p2 <- (object (is-a PROCESS) (inputs $?in2)
106 | (outputs $?out2)
107 | (comp-proc $?cp2))
108 | (test (and (neq ?p1 ?p2) ;not combining the same process
109 | (not (member$ ?p1 ?cp2)) ;process not alread a component
110 | (not (member$ ?p2 ?cp1)) ; of a (chunked) process
111 | (null-lv (intersection ?cp1 ?cp2))))
112 | =>
113 | (bind ?int1to2 (intersection ?in1 ?out2)) ;calc any out to input matches
114 | (bind ?int2to1 (intersection ?in2 ?out1))
115 | ;if there are any make a chunked process
116 | (if (full-lv ?int1to2) then (make-instance
117 | (sym-cat (instance-name ?p1) - (instance-name ?p2))
118 | of PROCESS
119 | (inputs (union- ?in1 (set-difference ?in2 ?int1to2)))
120 | (outputs (union- ?out1 ?out2))
121 | (comp-proc (create$ ?p1 ?p2 ?cp1 ?cp2))))
122 | (if (full-lv ?int2to1) then (make-instance
123 | (sym-cat (instance-name ?p2) - (instance-name ?p1))
124 | of PROCESS
125 | (inputs (union- ?in2 (set-difference ?in1 ?int2to1)))
126 | (outputs (union- ?out2 ?out1))
127 | (comp-proc (create$ ?p2 ?p1 ?cp2 ?cp1))))
128 | )
129 | ;inputs are all of the first ones and of of the 2nd except what the 1st provieds
130 | ;outputs are the combined outputs (even though used, still available-branch out)
131 | ;comprised proceedures are the 2 put together & all of there comp-proc s
132 | ;-------------------------------------------------
133 | ;(sym-cat (format nil "%s-%s" (instance-name ?p1) (instance-name ?p2)))
134 | ;-------------------------------------------------EOF
135 |
136 |
--------------------------------------------------------------------------------
/clp-pvm/c/c-acc.c:
--------------------------------------------------------------------------------
1 | /*misc functions to be included in the clips main file, M. Bobak, ANL*/
2 |
3 | #define ISMETH(m,ts,ac) (!strcasecmp((m),(ts)) && ((ac)+2)==get_ac())
4 | /*---------------------------------------------------------INCLUDES*/
5 | /*---------------------------------------------------------general*/
6 | #include
7 | #include
8 | #include
9 | #include
10 | #include
11 | #include
12 | #include
13 | /*---------------------------------------------------------extern C*/
14 | #ifdef __cplusplus
15 | extern "C" {
16 | #endif
17 | /*---------------------------------------------------------clips*/
18 | #include "clips.h" /*has Rtn*fncs, so fnc can get args from clips*/
19 | #include "setup.h"
20 | #include "sysdep.h"
21 | #include "extnfunc.h"
22 | #include "commline.h"
23 | #define PTIF2 (void (*)(VOID_ARG))
24 | /*---------------------------------------------------------*/
25 | #include "symbol.h"
26 | #include "router.h"
27 | #include "engine.h"
28 | #include "argacces.h"
29 | #include "prntutil.h"
30 | /*---------------------------------------------------------*/
31 | #ifdef __cplusplus
32 | }
33 | #endif
34 | /*---------------------------------------------------------clipsmain*/
35 | /*#include "incl/clipsmain.c"*/
36 | /*the idea is to not have to store it in clips,*/
37 | /*=======================================================--CLIPS access fncs*/
38 | /*might want to break out the fncs that don't have wrappers
39 | so they can be included by any file that does have wrappers
40 | and wants to use them (not necc if all incl in 1 big file)
41 | (better to link in wrapper files seperately though)*/
42 | /*would be nice to have fncs to set/get vals from mf-s*/
43 | /*=======================================================--internal fncs*/
44 | /*---------------------------------------------------------ADDSYMB*/
45 | /*if want this from CLIPS use sym-cat*/
46 | VOID *AddSymb(char *str)
47 | {
48 | char *t;
49 | VOID *ret;
50 | t=strdup(str);
51 | ret=AddSymbol(t);
52 | free(t);
53 | return(ret);
54 | }
55 | /*---------------------------------------------------------*/
56 | /*--------------------------------------------------------wrapper for Rtn-fncs*/
57 | /*---------------------------------------------------------GET_STR*/
58 | char *get_str(int n,char *m) /*a shorthand for returning a string*/
59 | { sprintf(m,"%s",(char *)RtnLexeme(n)); return(m); }
60 | /*---------------------------------------------------------GET_CHAR*/
61 | char get_char(int n)
62 | {
63 | char tmpstr[22];
64 | sprintf(tmpstr,"%s",(char *)RtnLexeme(n)); return(m);
65 | return(tmpstr[0]);
66 | }
67 | /*----------------------------------------------------------*/
68 | float get_ac() { return( RtnArgCount());}
69 | /*----------------------------------------------------------*/
70 | /*a shorthand for returning a float,int (inline sometime)*/
71 | /*---------------------------------------------------------GET_FLOAT*/
72 | float get_float(int n) { return((float)RtnDouble(n)); }
73 | double get_double(int n){ return( RtnDouble(n)); }
74 | /*---------------------------------------------------------GET_INT*/
75 | int get_int(int n) { return( (int)RtnLong(n)); }
76 | long get_long(int n) { return( RtnLong(n)); }
77 | /*might have these use RtnUnknown like in get_ptr*/
78 | /*---------------------------------------------------------GET_INT_ARRAY*/
79 | void get_int_array(int start, int *array)
80 | {
81 | int i;
82 | for(i=start; i=n) return(*fp=(float)RtnDouble(n)); else return(0.0); }
93 | double get_double_if(int n,double *dp){
94 | if(get_ac()>=n) return(*dp= RtnDouble(n)); else return(0.0); }
95 | /*---------------------------------------------------------GET_INT*/
96 | int get_int_if(int n,int *ip) {
97 | if(get_ac()>=n) return(*ip=(int)RtnLong(n)); else return(0); }
98 | long get_long_if(int n,long *lp) {
99 | if(get_ac()>=n) return(*lp= RtnLong(n)); else return(0); }
100 | /*----------------------------------------------------------GET_PTR*/
101 | VOID *get_ptr(int num)
102 | {
103 | DATA_OBJECT tmp;
104 | VOID *ret=(VOID *)NULL;
105 | long i;
106 | RtnUnknown(num,&tmp);
107 | switch(GetType(tmp))
108 | {
109 | case INTEGER:
110 | i=DOToLong(tmp);
111 | if(i<999) printf("[bad int for ptr = %d]\n",i);
112 | else ret = (VOID *)i;
113 | break;
114 | case EXTERNAL_ADDRESS: ret = (VOID *)DOToPointer(tmp); break;
115 | case SYMBOL:
116 | case INSTANCE_NAME:
117 | printf("will take ins ptr and use DirectGetSlot(ins,sn,&tmp)\n");
118 | /* case INSTANCE: */
119 | break;
120 | }
121 | return(ret);
122 | }
123 | /*----------------------------------------------------------wrap unk returns*/
124 | /*like AddSymb, but for numbers, &symb*/
125 | /*----------------------------------------------------------set_float*/
126 | VOID set_float(DATA_OBJECT_PTR ptr,float f)
127 | {
128 | SetpType(ptr,FLOAT);
129 | SetpValue(ptr,AddDouble((double)f));
130 | return;
131 | }
132 | /*----------------------------------------------------------set_double*/
133 | VOID set_double(DATA_OBJECT_PTR ptr,double f)
134 | {
135 | SetpType(ptr,FLOAT);
136 | SetpValue(ptr,AddDouble(f));
137 | return;
138 | }
139 | /*----------------------------------------------------------set_int*/
140 | VOID set_int(DATA_OBJECT_PTR ptr,int i)
141 | {
142 | SetpType(ptr,INTEGER);
143 | SetpValue(ptr,AddLong((long)i));
144 | return;
145 | }
146 | /*----------------------------------------------------------set_long*/
147 | VOID set_long(DATA_OBJECT_PTR ptr,long i)
148 | {
149 | SetpType(ptr,INTEGER);
150 | SetpValue(ptr,AddLong(i));
151 | return;
152 | }
153 | /*----------------------------------------------------------set_symb*/
154 | VOID set_symb(DATA_OBJECT_PTR ptr,char *s)
155 | { /*might want a tmp str like w/ addsymb (just using addsymb now)*/
156 | SetpType(ptr,SYMBOL);
157 | SetpValue(ptr,AddSymb(s));
158 | return;
159 | }
160 | /*----------------------------------------------------------*/
161 | /*---------------------------------------------------------*/
162 | /*tpn_to-mf could almost be used as a subfnc*/
163 | /*---------------------------------------------------------*/
164 | /*---------------------------------------------------------EOF*/
165 |
--------------------------------------------------------------------------------
/clp-pvm/clp/task.clp:
--------------------------------------------------------------------------------
1 | ;start of pvm clips task code, Mike B. ;-needs:util.clp
2 | (defglobal ?*my-tid* = 0)
3 | (defglobal ?*parent-tid* = 0)
4 | (defglobal ?*model* = 0) ;compiled w/ the model, or talking to it
5 | (defglobal ?*inst-tids* = (create$ )) ;tids of all the task instances
6 | (defglobal ?*start-time* = 0)
7 | (defglobal ?*recv-d-time* = 10)
8 | ;------------------------------------------------util
9 | ;(deffunction elapse-time () (- (time) ?*start-time*)) in misc-fnc.clp
10 | (deffunction elapse-time () (- (time) ?*start-time*)) ;in misc-fnc.clp
11 | (deffunction upk1int () (upkint))
12 |
13 | ;holds the information on how to contact another unix process on the
14 | ;virtual machine (note: pvm's virtual machine can include many machines)
15 | (defclass TASK
16 | (is-a INITIAL-OBJECT)
17 | (role concrete) (pattern-match reactive)
18 | (slot init-time (create-accessor read-write))
19 | (slot active (create-accessor read-write))
20 | (slot tid (create-accessor read-write))
21 | (slot tpid (create-accessor read-write))
22 | (slot host (create-accessor read-write))
23 | (slot flag (create-accessor read-write))
24 | ;(multislot msgtags (create-accessor read-write)) ;tags of possible interest
25 | (slot global-name ;(type INSTANCE)
26 | (create-accessor read-write) (visibility public))
27 | (slot Name (create-accessor read-write)))
28 |
29 | ;a type of task which will be a clips process which controls a model
30 | (defclass CNTRL-TASK
31 | (is-a TASK)
32 | (role concrete) (pattern-match reactive)
33 | (slot init-time (create-accessor read-write)))
34 |
35 | ;a type of task which will be the actual FORTRAN/C(++) model
36 | (defclass MODEL-TASK
37 | (is-a TASK)
38 | (role concrete) (pattern-match reactive)
39 | (slot init-time (create-accessor read-write)))
40 |
41 | ;send-str (implode$ (local-slotnames ?inst))
42 | ;send-str (implode$ (slot-local-values ?inst))
43 | ;can use to-str & to-pstr=quote now for any list of args
44 |
45 | ;-------------------------------------------------------send_to_tasks
46 | ;so can send whatever is packed up to many different tasks
47 | ;can use mcast too, or bcast & a group name
48 | (deffunction send_to_tasks ($?tasks)
49 | ;(map2 send_ (map1 get-tid ?tasks) 0)
50 | ;(map2 send_0 ?tasks) ;in my orig file
51 | (map2 send_0 ?tasks 0) ;a guess at a fix, mb
52 | )
53 |
54 | ;-------------------------------------------------------GET-TID
55 | (deffunction get-tid (?task)
56 | (if (numberp ?task) then ?task
57 | else (if (instancep ?task) then (send ?task get-tid)
58 | else (printout t "[get-tid:bad-arg " ?task "]"))))
59 | ;(if (numberp ?task) then ?task else (send ?task get-tid))
60 | ; else if (stringp ?task) then return all the tids
61 |
62 | ;-------------------TASK msg handlers-----------------
63 | ;-------------------send/recv handlers
64 |
65 | ;(deffunction send-str-to (?str $?tasks)
66 | ; (printout t "[send-str to defined below]"))
67 | (deffunction send-str-to (?str $?tasks)
68 | (printout t "[send-str to defined below]"))
69 | ;------------------------------------------------------task EVAL
70 | ;take the args make into a parened string, and send to task for evaluation
71 | ;(defmessage-handler TASK eval primary ($?args)
72 | ; (send-str-to (quotes ?args) ?self))
73 |
74 | ;-------------------TASK init handler -------------
75 | ;makes sure that a newly created task has many of its slots filled in.
76 | (defmessage-handler TASK init after ()
77 | (send ?self put-init-time (elapse-time))
78 | ;if active slot isn't set, the task is waiting (by default)
79 | ;if spawned or gotton from tasks it should be set to active (if it is)
80 | ;flag has some of that status info
81 | (if (not (symbolp ?self:active)) then (send ?self put-active waiting))
82 | ;set host if not set
83 | (if (and (numberp ?self:tid) (not (numberp ?self:host))) then
84 | (send ?self put-host (tidtohost ?self:tid)))
85 | (insert$ ?*inst-tids* 1 ?self:tid)
86 |
87 | ;if there is a global-name for the task make that inst w/ the same tid
88 | (if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil]))
89 | (stringp ?self:global-name)) then
90 | (make-instance ?self:global-name of TASK (tid ?self:tid)))
91 | )
92 |
93 | (defmessage-handler TASK get-tid before ()
94 | (if (null ?self:tid) then (printout t "[" ?self " has no tid, so put-tid]")))
95 |
96 |
97 | ;--ADD-TASK (takes 2 strings & and int right now)
98 | ;makes an instance of a task
99 | (deffunction add-process (?name ?where ?tid)
100 | (make-instance (sym-cat task- ?name - ?tid) of TASK
101 | (tid ?tid)
102 | (host ?where)
103 | (Name ?name)))
104 |
105 | ;--MAKE-TASK (takes 2 strings right now)
106 | ;makes an instance of a task
107 | (deffunction make-process (?name ?where)
108 | (bind ?tid
109 | (spawn ?name "(load pvm-agt)" 1 ?where (if (stringp ?where) then 1 else 0)) )
110 | (add-process ?name ?where ?tid))
111 | ;latter will just incr the #, and use the tid slot for sends
112 |
113 | ;might still want something like above, so when you have a task/spawn it
114 | ;that the rest of the (tasks tid) info can be parsed into the new instance
115 |
116 | ;------------------------------------------------------task EVAL
117 | ;take the args make into a parened string, and send to task for evaluation
118 | (defmessage-handler TASK eval primary ($?args)
119 | (send-str-to (quotes ?args) ?self))
120 | ;------------------------------------------------------
121 | ;------------------------------------------------------OID
122 | (defclass OID ;obj id (~= cORB-NAME)
123 | (is-a INITIAL-OBJECT)
124 | (role concrete) (pattern-match reactive)
125 | (slot tid (create-accessor read-write)) ;task id ([inst] or int id)
126 | (slot iid (create-accessor read-write)) ;inst id ([inst] or str id)
127 | (slot orb-name (create-accessor read-write))) ;name given by naming service
128 | ;to have a globally seperate name, need 1 naming service
129 | ;either inst-name or orb-name slot should be unique
130 | ;-----------------------------------------------------new:
131 | ;(defclass TID ;task obj id ;mirror globals for now
132 | ; (is-a INITIAL-OBJECT)
133 | ; (role concrete) (pattern-match reactive)
134 | ; (slot tid (type INTEGER) (create-accessor read-write)) ;task id ([inst] or int id)
135 | ; (slot pid (type INTEGER) (create-accessor read-write)) ;parent task id ([inst] or int id)
136 | ; (slot start-time (type INTEGER) (create-accessor read-write)) ;also was a global
137 | ; (slot recv-d-time (type INTEGER) (create-accessor read-write)) ;also was a global
138 | ; (slot model (type INTEGER) (create-accessor read-write)) ;also was a global
139 | ; (multislot inst-tids (create-accessor read-write)) ;also was a global
140 | ;)
141 | ;-----------------------------------------------------EOF
142 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/stratification.clp:
--------------------------------------------------------------------------------
1 |
2 |
3 | (deffunction collect-positive-class-names ($?condition)
4 | )
5 |
6 | (deffunction collect-positive-class-names-one ($?cond-elem)
7 | (if (eq (nth$ 2 $?cond-elem) not)
8 | then
9 | (create$)
10 | else
11 | (if (or (eq (nth$ 2 $?cond-elem) or)
12 | (eq (nth$ 2 $?cond-elem) and))
13 | then
14 | (collect-positive-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1)))
15 | else
16 | (if (eq (nth$ 2 $?cond-elem) <-)
17 | then
18 | (if (eq (nth$ 4 $?cond-elem) object)
19 | then
20 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem))
21 | else
22 | (bind ?class (nth$ 4 $?cond-elem))
23 | )
24 | else
25 | (if (eq (nth$ 2 $?cond-elem) object)
26 | then
27 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem))
28 | else
29 | (bind ?class (nth$ 2 $?cond-elem))
30 | )
31 | )
32 | (if (is_derived ?class)
33 | then
34 | ?class
35 | else
36 | (create$)
37 | )
38 | )
39 | )
40 | )
41 |
42 | (deffunction collect-positive-class-names ($?condition)
43 | (bind $?result (create$))
44 | (while (> (length$ $?condition) 0)
45 | do
46 | (bind ?p2 (get-token $?condition))
47 | ;(bind $?first-cond-elem (subseq$ $?condition 1 ?p2))
48 | (bind $?result (create$ $?result (collect-positive-class-names-one (subseq$ $?condition 1 ?p2))))
49 | (bind $?condition (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
50 | )
51 | $?result
52 | )
53 |
54 | (deffunction collect-negative-class-names ($?condition)
55 | )
56 |
57 | (deffunction collect-negative-class-names-one ($?cond-elem)
58 | (if (eq (nth$ 2 $?cond-elem) not)
59 | then
60 | (collect-positive-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1)))
61 | else
62 | (if (or (eq (nth$ 2 $?cond-elem) or)
63 | (eq (nth$ 2 $?cond-elem) and))
64 | then
65 | (collect-negative-class-names (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1)))
66 | else
67 | (create$)
68 | )
69 | )
70 | )
71 |
72 | (deffunction collect-negative-class-names ($?condition)
73 | (bind $?result (create$))
74 | (while (> (length$ $?condition) 0)
75 | do
76 | (bind ?p2 (get-token $?condition))
77 | ;(bind $?first-cond-elem (subseq$ $?condition 1 ?p2))
78 | (bind $?result (create$ $?result (collect-negative-class-names-one (subseq$ $?condition 1 ?p2))))
79 | (bind $?condition (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
80 | )
81 | $?result
82 | )
83 |
84 |
85 | (deffunction calc-positive-stratum (?no-of-derived-classes ?current-stratum $?positive-condition-classes)
86 | (if (> ?current-stratum ?no-of-derived-classes)
87 | then
88 | -1
89 | else
90 | (if (= (length$ $?positive-condition-classes) 0)
91 | then
92 | ?current-stratum
93 | else
94 | ;(bind ?pos-class (nth$ 1 $?positive-condition-classes))
95 | ;(bind ?pos-class-id (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?positive-condition-classes))))
96 | (bind ?body-class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?positive-condition-classes))) stratum))
97 | (if (< ?current-stratum ?body-class-stratum)
98 | then
99 | (calc-positive-stratum ?no-of-derived-classes ?body-class-stratum (rest$ $?positive-condition-classes))
100 | else
101 | (calc-positive-stratum ?no-of-derived-classes ?current-stratum (rest$ $?positive-condition-classes))
102 | )
103 | )
104 | )
105 | )
106 |
107 | (deffunction calc-negative-stratum (?no-of-derived-classes ?current-stratum $?negative-condition-classes)
108 | (if (> ?current-stratum ?no-of-derived-classes)
109 | then
110 | -1
111 | else
112 | (if (= (length$ $?negative-condition-classes) 0)
113 | then
114 | ?current-stratum
115 | else
116 | (bind ?body-class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name (nth$ 1 $?negative-condition-classes))) stratum))
117 | (if (<= ?current-stratum ?body-class-stratum)
118 | then
119 | (calc-negative-stratum ?no-of-derived-classes (+ ?body-class-stratum 1) (rest$ $?negative-condition-classes))
120 | else
121 | (calc-negative-stratum ?no-of-derived-classes ?current-stratum (rest$ $?negative-condition-classes))
122 | )
123 | )
124 | )
125 | )
126 |
127 | (deffunction calc-stratum (?derived-class $?condition)
128 | ;(bind $?positive-condition-classes (remove-duplicates$ (collect-positive-class-names $?condition)))
129 | ;(bind $?negative-condition-classes (remove-duplicates$ (collect-negative-class-names $?condition)))
130 | (bind ?no-of-derived-classes (length$ (get-template-specific-facts derived-class (get-fact-list))))
131 | (bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?derived-class)))
132 | (if (eq ?derived-class-index nil)
133 | then
134 | 1
135 | else
136 | ;(bind ?current-stratum (fact-slot-value ?derived-class-index stratum))
137 | ;(bind ?next-stratum (calc-positive-stratum ?no-of-derived-classes (fact-slot-value ?derived-class-index stratum) (remove-duplicates$ (collect-positive-class-names $?condition))))
138 | (calc-negative-stratum ?no-of-derived-classes (calc-positive-stratum ?no-of-derived-classes (fact-slot-value ?derived-class-index stratum) (remove-duplicates$ (collect-positive-class-names $?condition))) (remove-duplicates$ (collect-negative-class-names $?condition)))
139 | )
140 | )
141 |
142 |
143 |
144 | (deffunction calc-stratum-afterwards (?production-rule-condition ?class)
145 | ;(bind $?pr (explode$ ?production-rule))
146 | ;(bind ?imp_pos (member$ => $?pr))
147 | ;(bind $?condition (subseq$ $?pr 17 (- ?imp_pos 1))) ;avoid initial stuff
148 | ;(bind $?condition (explode$ ?production-rule-condition))
149 | (bind ?stratum (calc-stratum ?class (my-explode$ ?production-rule-condition)))
150 | (if (= ?stratum -1)
151 | then
152 | (printout t "Rules are not stratified!" crlf)
153 | (halt)
154 | else
155 | (if (> ?stratum 1)
156 | then
157 | (bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?class)))
158 | (modify ?derived-class-index (stratum ?stratum))
159 | )
160 | )
161 | )
162 |
163 | (deffunction calc-salience (?class)
164 | ;(bind ?derived-class-index (nth$ 1 (get-specific-facts derived-class name ?class)))
165 | ;(bind ?class-stratum (fact-slot-value (nth$ 1 (get-specific-facts derived-class name ?class)) stratum))
166 | (- 1000 (fact-slot-value (nth$ 1 (get-specific-facts derived-class name ?class)) stratum))
167 | )
168 |
--------------------------------------------------------------------------------
/clp-pvm/c/clips-sc-main.c:
--------------------------------------------------------------------------------
1 | /*--this is the main loop for clips, to be included
2 | //-this is the version that has libscheme embedded in it
3 | //M. Bobak, ANL
4 | //---------------------------------------------------------*/
5 | /*******************************************************/
6 | /* "C" Language Integrated Production System */
7 | /* A Product Of The */
8 | /* Software Technology Branch */
9 | /* NASA - Johnson Space Center */
10 | /* CLIPS Version 6.00 05/12/93 */
11 | /* MAIN MODULE */
12 | /*******************************************************/
13 | /*************************************************************/
14 | /* Principal Programmer: Gary D. Riley */
15 | /* Contributing Programmer(s): */
16 | /* Bob Orchard (NRCC - Nat'l Research Council of Canada)*/
17 | /* (Fuzzy reasoning extensions) */
18 | /* (certainty factors for facts and rules) */
19 | /* Mike Bobak (PVM extentions) */
20 | /*************************************************************/
21 | #if FUZZY_DEFTEMPLATES
22 | #include "fuzzyutl.h"
23 | #include "fuzzymod.h"
24 | #endif
25 | /*---------------------------------------------------------just added fuzzymod*/
26 | /***********************************************************/
27 | /* RerouteStdin: Reroutes stdin to read initially from the */
28 | /* file specified on the command line with -r option. */
29 | /***********************************************************/
30 | globle VOID RerouteStdin2(int argc, char** argv) /*int argc; char *argv[];*/
31 | {
32 | int i;
33 | /* If no arguments return */
34 | if (argc < 3) { return; }
35 | /* If argv was not passed then forget it */
36 | if (argv == NULL) return;
37 |
38 | for (i = 1 ; i < argc ; i++)
39 | {
40 | if (strcmp(argv[i],"-r") == 0)
41 | {
42 | if (i > (argc-1))
43 | {
44 | PrintErrorID("SYSDEP",1,CLIPS_FALSE);
45 | PrintCLIPS(WERROR,"No string found for -r option\n");
46 | return;
47 | }
48 | else
49 | {
50 | printf("Doing a: RouteCommand(%s)\n",argv[++i]); fflush(stdout);
51 | RouteCommand(argv[i]);
52 | }
53 | }
54 | }
55 | }
56 | /*---------------------------------------------------------
57 | //RUN: Starts execution of rules. Rules fire until agenda is empty or
58 | // the number of rule firings limit specified by the first argument
59 | // is reached (infinity if unspecified).
60 | // A fuzzyCLIPS extension assigns a special meaning to the rule limit
61 | // value -2 and values less than -2. For -2 the inference cycle will
62 | // continue forever (or until a break, control-C, is encountered).
63 | // Even when the agenda is empty the cycle will continue and any
64 | // functions added to the runtime list will be executed. If the
65 | // value is less than -2 then the cycle will continue until |limit|
66 | // rules have been fired even if the agenda becomes empty at some time.
67 | //(run [])
68 | //---------------------------------------------------------*/
69 |
70 | #include "scheme.h"
71 |
72 | /*---------------------------------------------------------*/
73 | int sc-eval()
74 | {
75 | obj = scheme_read (scheme_stdin_port); /*how to read 1st*/
76 | if (obj == scheme_eof)
77 | {
78 | printf ("\n; done\n");
79 | exit (0);
80 | }
81 | obj = SCHEME_CATCH_ERROR(scheme_eval (obj, global_env),0);
82 | if (obj)
83 | {
84 | scheme_write (obj, scheme_stdout_port); /*then how to get as clips obj*/
85 | printf ("\n");
86 | }
87 | }
88 | /*---------------------------------------------------------*/
89 | #if defined(__cplusplus)
90 | extern "C" {
91 | #endif
92 |
93 | #if ANSI_COMPILER
94 | int main(int,char *[]);
95 | VOID UserFunctions(void);
96 | #else
97 | int main();
98 | VOID UserFunctions();
99 | #endif
100 |
101 | #if defined(__cplusplus)
102 | }
103 | #endif
104 | /***************************************************************/
105 | /* MAIN: Start execution of CLIPS. This function must be */
106 | /* redefined in order to embed CLIPS within another program. */
107 | /* Example of redefined main: */
108 | /* main() */
109 | /* { */
110 | /* InitializeCLIPS(); */
111 | /* . */
112 | /* . */
113 | /* ProcessData(); */
114 | /* RunCLIPS(-1); */
115 | /* EvaluateData(); */
116 | /* . */
117 | /* . */
118 | /* FinalResults(); */
119 | /* } */
120 | /***************************************************************/
121 | #if defined(__cplusplus)
122 | int main (int argc, char *argv[])
123 | #else
124 | int main(argc,argv)
125 | int argc;
126 | char *argv[] ;
127 | #endif /* defined(__cplusplus) */
128 | {
129 | Scheme_Env *global_env;
130 | Scheme_Object *obj, *in_port;
131 | int i;
132 | /*FILE *fp; blow of loading files from command line for now*/
133 |
134 | global_env = scheme_basic_env ();
135 |
136 | InitializeCLIPS();
137 | RerouteStdin(argc,argv); /*handles batch files (done in CommandLoop)*/
138 | /* RerouteStdin2(argc,argv); //my version -r "any command to route" (done now)
139 | // the new lib has the -r option in RerouteStdin */
140 | CommandLoop();
141 | return(-1);
142 | }
143 | /*************************************************************/
144 | /* UserFunctions: The function which informs CLIPS of any */
145 | /* user defined functions. In the default case, there are */
146 | /* no user defined functions. To define functions, either */
147 | /* this function must be replaced by a function with the */
148 | /* same name within this file, or this function can be */
149 | /* deleted from this file and included in another file. */
150 | /* User defined functions may be included in this file or */
151 | /* other files. */
152 | /* Example of redefined UserFunctions: */
153 | /* UserFunctions() */
154 | /* { */
155 | /* DefineFunction("fun1",'i',fun1,"fun1"); */
156 | /* DefineFunction("other",'f',other,"other"); */
157 | /* } */
158 | /*************************************************************/
159 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/vocabulary.clp:
--------------------------------------------------------------------------------
1 | ;OWL
2 | (defglobal ?*owl:AllDifferent* = http://www.w3.org/2002/07/owl#AllDifferent)
3 | (defglobal ?*owl:allValuesFrom* = http://www.w3.org/2002/07/owl#allValuesFrom)
4 | (defglobal ?*owl:AnnotationProperty* = http://www.w3.org/2002/07/owl#AnnotationProperty)
5 | (defglobal ?*owl:backwardCompatibleWith* = http://www.w3.org/2002/07/owl#backwardCompatibleWith)
6 | (defglobal ?*owl:cardinality* = http://www.w3.org/2002/07/owl#cardinality)
7 | (defglobal ?*owl:Class* = http://www.w3.org/2002/07/owl#Class)
8 | (defglobal ?*owl:complementOf* = http://www.w3.org/2002/07/owl#complementOf)
9 | (defglobal ?*owl:DataRange* = http://www.w3.org/2002/07/owl#DataRange)
10 | (defglobal ?*owl:DatatypeProperty* = http://www.w3.org/2002/07/owl#DatatypeProperty)
11 | (defglobal ?*owl:DeprecatedClass* = http://www.w3.org/2002/07/owl#DeprecatedClass)
12 | (defglobal ?*owl:DeprecatedProperty* = http://www.w3.org/2002/07/owl#DeprecatedProperty)
13 | (defglobal ?*owl:differentFrom* = http://www.w3.org/2002/07/owl#differentFrom)
14 | (defglobal ?*owl:disjointWith* = http://www.w3.org/2002/07/owl#disjointWith)
15 | (defglobal ?*owl:distinctMembers* = http://www.w3.org/2002/07/owl#distinctMembers)
16 | (defglobal ?*owl:equivalentClass* = http://www.w3.org/2002/07/owl#equivalentClass)
17 | (defglobal ?*owl:equivalentProperty* = http://www.w3.org/2002/07/owl#equivalentProperty)
18 | (defglobal ?*owl:FunctionalProperty* = http://www.w3.org/2002/07/owl#FunctionalProperty)
19 | (defglobal ?*owl:hasValue* = http://www.w3.org/2002/07/owl#hasValue)
20 | (defglobal ?*owl:imports* = http://www.w3.org/2002/07/owl#imports)
21 | (defglobal ?*owl:incompatibleWith* = http://www.w3.org/2002/07/owl#incompatibleWith)
22 | (defglobal ?*owl:intersectionOf* = http://www.w3.org/2002/07/owl#intersectionOf)
23 | (defglobal ?*owl:InverseFunctionalProperty* = http://www.w3.org/2002/07/owl#InverseFunctionalProperty)
24 | (defglobal ?*owl:inverseOf* = http://www.w3.org/2002/07/owl#inverseOf)
25 | (defglobal ?*owl:maxCardinality* = http://www.w3.org/2002/07/owl#maxCardinality)
26 | (defglobal ?*owl:minCardinality* = http://www.w3.org/2002/07/owl#minCardinality)
27 | (defglobal ?*owl:Nothing* = http://www.w3.org/2002/07/owl#Nothing)
28 | (defglobal ?*owl:ObjectProperty* = http://www.w3.org/2002/07/owl#ObjectProperty)
29 | (defglobal ?*owl:oneOf* = http://www.w3.org/2002/07/owl#oneOf)
30 | (defglobal ?*owl:onProperty* = http://www.w3.org/2002/07/owl#onProperty)
31 | (defglobal ?*owl:Ontology* = http://www.w3.org/2002/07/owl#Ontology)
32 | (defglobal ?*owl:OntologyProperty* = http://www.w3.org/2002/07/owl#OntologyProperty)
33 | (defglobal ?*owl:priorVersion* = http://www.w3.org/2002/07/owl#priorVersion)
34 | (defglobal ?*owl:Restriction* = http://www.w3.org/2002/07/owl#Restriction)
35 | (defglobal ?*owl:sameAs* = http://www.w3.org/2002/07/owl#sameAs)
36 | (defglobal ?*owl:someValuesFrom* = http://www.w3.org/2002/07/owl#someValuesFrom)
37 | (defglobal ?*owl:SymmetricProperty* = http://www.w3.org/2002/07/owl#SymmetricProperty)
38 | (defglobal ?*owl:Thing* = http://www.w3.org/2002/07/owl#Thing)
39 | (defglobal ?*owl:TransitiveProperty* = http://www.w3.org/2002/07/owl#TransitiveProperty)
40 | (defglobal ?*owl:unionOf* = http://www.w3.org/2002/07/owl#unionOf)
41 | (defglobal ?*owl:versionInfo* = http://www.w3.org/2002/07/owl#versionInfo)
42 | (defglobal ?*owl:hasKey* = http://www.w3.org/2002/07/owl#hasKey)
43 | (defglobal ?*owl:onClass* = http://www.w3.org/2002/07/owl#onClass)
44 | (defglobal ?*owl:minQualifiedCardinality* = http://www.w3.org/2002/07/owl#minQualifiedCardinality)
45 | (defglobal ?*owl:maxQualifiedCardinality* = http://www.w3.org/2002/07/owl#maxQualifiedCardinality)
46 | (defglobal ?*owl:qualifiedCardinality* = http://www.w3.org/2002/07/owl#qualifiedCardinality)
47 | (defglobal ?*owl:propertyChainAxiom* = http://www.w3.org/2002/07/owl#propertyChainAxiom)
48 | (defglobal ?*owl:AllDisjointClasses* = http://www.w3.org/2002/07/owl#AllDisjointClasses)
49 | (defglobal ?*owl:members* = http://www.w3.org/2002/07/owl#members)
50 |
51 |
52 | ;RDF/RDFS
53 | (defglobal ?*rdfs:Resource* = http://www.w3.org/2000/01/rdf-schema#Resource)
54 | (defglobal ?*rdfs:Literal* = http://www.w3.org/2000/01/rdf-schema#Literal)
55 | (defglobal ?*rdf:XMLLiteral* = http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral)
56 | (defglobal ?*rdfs:Class* = http://www.w3.org/2000/01/rdf-schema#Class)
57 | (defglobal ?*rdf:Property* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Property)
58 | (defglobal ?*rdfs:Datatype* = http://www.w3.org/2000/01/rdf-schema#Datatype)
59 | (defglobal ?*rdf:Statement* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Statement)
60 | (defglobal ?*rdf:Bag* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Bag)
61 | (defglobal ?*rdf:Seq* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Seq)
62 | (defglobal ?*rdf:Alt* = http://www.w3.org/1999/02/22-rdf-syntax-ns#Alt)
63 | (defglobal ?*rdfs:Container* = http://www.w3.org/2000/01/rdf-schema#Container)
64 | (defglobal ?*rdfs:ContainerMembershipProperty* = http://www.w3.org/2000/01/rdf-schema#ContainerMembershipProperty)
65 | (defglobal ?*rdf:List* = http://www.w3.org/1999/02/22-rdf-syntax-ns#List)
66 | (defglobal ?*rdf:type* = http://www.w3.org/1999/02/22-rdf-syntax-ns#type)
67 | (defglobal ?*rdfs:subClassOf* = http://www.w3.org/2000/01/rdf-schema#subClassOf)
68 | (defglobal ?*rdfs:subPropertyOf* = http://www.w3.org/2000/01/rdf-schema#subPropertyOf)
69 | (defglobal ?*rdfs:domain* = http://www.w3.org/2000/01/rdf-schema#domain)
70 | (defglobal ?*rdfs:range* = http://www.w3.org/2000/01/rdf-schema#range)
71 | (defglobal ?*rdfs:label* = http://www.w3.org/2000/01/rdf-schema#label)
72 | (defglobal ?*rdfs:comment* = http://www.w3.org/2000/01/rdf-schema#comment)
73 | (defglobal ?*rdfs:member* = http://www.w3.org/2000/01/rdf-schema#member)
74 | (defglobal ?*rdf:first* = http://www.w3.org/1999/02/22-rdf-syntax-ns#first)
75 | (defglobal ?*rdf:rest* = http://www.w3.org/1999/02/22-rdf-syntax-ns#rest)
76 | (defglobal ?*rdf:nil* = http://www.w3.org/1999/02/22-rdf-syntax-ns#nil)
77 | (defglobal ?*rdfs:seeAlso* = http://www.w3.org/2000/01/rdf-schema#seeAlso)
78 | (defglobal ?*rdfs:isDefinedBy* = http://www.w3.org/2000/01/rdf-schema#isDefinedBy)
79 | (defglobal ?*rdf:value* = http://www.w3.org/1999/02/22-rdf-syntax-ns#value)
80 | (defglobal ?*rdf:subject* = http://www.w3.org/1999/02/22-rdf-syntax-ns#subject)
81 | (defglobal ?*rdf:predicate* = http://www.w3.org/1999/02/22-rdf-syntax-ns#predicate)
82 | (defglobal ?*rdf:object* = http://www.w3.org/1999/02/22-rdf-syntax-ns#object)
83 |
84 | ;Some xsd types
85 | (defglobal ?*xsd:int* = http://www.w3.org/2001/XMLSchema#int)
86 | (defglobal ?*xsd:float* = http://www.w3.org/2001/XMLSchema#float)
87 | (defglobal ?*xsd:short* = http://www.w3.org/2001/XMLSchema#short)
88 | (defglobal ?*xsd:byte* = http://www.w3.org/2001/XMLSchema#byte)
89 | (defglobal ?*xsd:boolean* = http://www.w3.org/2001/XMLSchema#boolean)
90 | (defglobal ?*xsd:string* = http://www.w3.org/2001/XMLSchema#string)
91 | (defglobal ?*xsd:nonNegativeInteger* = http://www.w3.org/2001/XMLSchema#nonNegativeInteger)
92 | (defglobal ?*xsd:Integer* = http://www.w3.org/2001/XMLSchema#Integer)
93 | (defglobal ?*xsd:integer* = http://www.w3.org/2001/XMLSchema#integer)
94 | (defglobal ?*xsd:anyURI* = http://www.w3.org/2001/XMLSchema#anyURI)
95 | (defglobal ?*xsd:positiveInteger* = http://www.w3.org/2001/XMLSchema#positiveInteger)
96 | (defglobal ?*xsd:nonPositiveInteger* = http://www.w3.org/2001/XMLSchema#nonPositiveInteger)
97 | (defglobal ?*xsd:dateTime* = http://www.w3.org/2001/XMLSchema#dateTime)
98 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/dctype.rdf:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | The DCMI Types namespace providing access to its content by means of an RDF Schema
5 | The Dublin Core Metadata Initiative
6 | The Dublin Core Types namespace provides URIs for the entries of the DCMI Type Vocabulary. Entries are declared using RDF Schema language to support RDF applications. The Schema will be updated according to dc-usage decisions.
7 | English
8 |
9 |
10 |
11 |
12 |
13 | 2000-07-11
14 | 2002-05-22
15 |
16 |
17 |
18 | The DCMI Type Vocabulary provides a general,
19 | cross-domain list of approved terms that may be used as values for the
20 | Resource Type element to identify the genre of a resource.
21 | 2000-07-11
22 |
23 |
24 | Collection
25 |
26 | A collection is an aggregation of items. The term collection means that the resource is described as a group; its parts may be separately described and navigated.
27 |
28 | 2000-07-11
29 |
30 |
31 | Dataset
32 |
33 | A dataset is information encoded in a defined structure (for example, lists, tables, and databases), intended to be useful for direct machine processing.
34 |
35 | 2000-07-11
36 |
37 |
38 | Event
39 |
40 | An event is a non-persistent, time-based
41 | occurrence. Metadata for an event provides descriptive information that
42 | is the basis for discovery of the purpose, location, duration, responsible agents, and links to related events and resources. The resource of type Event may not be retrievable if the described instantiation has expired or is yet to occur. Examples - exhibition, web-cast, conference, workshop, open-day, performance, battle, trial, wedding, tea-party, conflagration.
43 |
44 | 2000-07-11
45 |
46 |
47 | Image
48 |
49 | An image is a primarily symbolic visual representation other than text. For example - images and photographs of physical objects, paintings, prints, drawings, other images and graphics, animations and moving pictures, film, diagrams, maps, musical notation. Note that image may include both electronic and physical representations.
50 |
51 | 2000-07-11
52 |
53 |
54 | Interactive Resource
55 |
56 | An interactive resource is a resource which requires interaction from the user to be understood, executed, or experienced. For example - forms on web pages, applets, multimedia learning objects, chat services, virtual reality.
57 |
58 | 2000-07-11
59 |
60 |
61 | Software
62 |
63 | Software is a computer program in source or compiled form which may be available for installation non-transiently on another machine. For software which exists only to create an interactive environment, use interactive instead.
64 |
65 | 2000-07-11
66 |
67 |
68 | Service
69 |
70 | A service is a system that provides one or more functions of value to the end-user. Examples include: a photocopying service, a banking service, an authentication service, interlibrary loans, a Z39.50 or Web server.
71 |
72 | 2000-07-11
73 |
74 |
75 | Sound
76 |
77 | A sound is a resource whose content is primarily intended to be rendered as audio. For example - a music playback file format, an audio compact disc, and recorded speech or sounds.
78 |
79 | 2000-07-11
80 |
81 |
82 | Text
83 |
84 | A text is a resource whose content is primarily words for reading. For example - books, letters, dissertations, poems, newspapers, articles, archives of mailing lists. Note that facsimiles or images of texts are still of the genre text.
85 |
86 | 2000-07-11
87 |
88 |
89 |
--------------------------------------------------------------------------------
/csd.auth.gr/o-device/global.clp:
--------------------------------------------------------------------------------
1 |
2 | ;;; ######################################################################################
3 | ;;; Deftemplate definition for storing and manipulating the order of the classes
4 | ;;; in the is-a constraint of defclass definitions. In that way, O-DEVICE prevents the
5 | ;;; throwing of errors relevant to class precedence lists
6 | ;;; ######################################################################################
7 | (deftemplate strong-order
8 | (slot c1)
9 | (slot c2)
10 | )
11 |
12 | ;;; ######################################################################################
13 | ;;; System template for regulating the execution of rules
14 | ;;; ######################################################################################
15 | (deftemplate goal
16 | (slot name)
17 | )
18 |
19 | ;;; ######################################################################################
20 | ;;; Template for holding the COOL code of classes
21 | ;;; ######################################################################################
22 | (deftemplate DEFCLASS
23 | (slot code)
24 | )
25 |
26 | ;;; ######################################################################################
27 | ;;; Template for holding the namespace-to-prefix mapping that Jena computes for the set
28 | ;;; of the loaded ontologies
29 | ;;; ######################################################################################
30 | (deftemplate PrefixNsMap
31 | ;e.g. rdfs, owl, ...
32 | (slot prefix)
33 | ;e.g. xsd:, ...
34 | (slot namespace)
35 | )
36 |
37 | ;;; ######################################################################################
38 | ;;; Deftemplate definition for storing the state of O-DEVICE. If a class in CLIPS
39 | ;;; is generated dynamically, then the objects of this class cannot be matched in the
40 | ;;; conditions of rules, since the class has been defined after the definition of the
41 | ;;; corresponding object pattern. Therefore, the rules should be reloaded in order
42 | ;;; to incorporate further rule activations. This may cause an overhead to the
43 | ;;; perfromance of O-DEVICE and it has to do with the semantics of OWL that require
44 | ;;; sometimes to generate dynamically classes, e.g. in the case of an object that
45 | ;;; belongs simlultaneously to more than one class.
46 | ;;; ######################################################################################
47 | (deftemplate UPDATE
48 | (slot refresh)
49 | )
50 |
51 | ;;; ######################################################################################
52 | ;;; Deftemplate definition for storing the synamic rules that O-DEVICE generates.
53 | ;;; ######################################################################################
54 | (deftemplate rule
55 | ;rule type
56 | (slot type)
57 | ;rule name
58 | (slot name)
59 | ;rule definition
60 | (slot code)
61 | )
62 |
63 | ;;; ######################################################################################
64 | ;;; Deftemplate definition for storing in the form of CLIPS facts the ontology triples
65 | ;;; that the ARP Parser produces
66 | ;;; ######################################################################################
67 | (deftemplate triple
68 | ;the subject of the triple
69 | (slot subject)
70 | ;the predicate of the triples
71 | (slot predicate)
72 | ;the object of the triple
73 | (slot object)
74 | )
75 |
76 | ;;; ######################################################################################
77 | ;;; Deftemplate definition for collecting the information regarding the OWL classes.
78 | ;;; ######################################################################################
79 | (deftemplate CLASS
80 | ;the name of the class
81 | (slot name)
82 | ;direct superclasses (rdfs:subClassOf)
83 | (multislot subclass)
84 | ;intesection classes (owl:intersectionOf)
85 | (multislot intersection)
86 | ;equivalent classes (owl:equivalentClass)
87 | (multislot equivalent)
88 | ;complement of classes (owl:complementOf)
89 | (multislot complement)
90 | ;disjoint classes (owl:disjointWith)
91 | (multislot disjoint)
92 | ;union classes (owl:unionOf)
93 | (multislot union)
94 | ;owl:hasKey - only the named classes have keys
95 | (multislot hasKey)
96 | ;the properties that have this class as a domain
97 | (multislot slots)
98 | ;initially, all the classes are not delegators. The delegators are used
99 | ;for the mapping of OWL class equivalence, since subclass
100 | ;circles are forbitten in the oo model.
101 | (slot delegator (default FALSE))
102 | ;label (rdfs:label)
103 | (slot label)
104 | ;comment (rdfs:comment)
105 | (slot comment)
106 | ;if the fact has been mapped on a COOL class
107 | (slot materialized (default FALSE))
108 | )
109 |
110 | ;;; ######################################################################################
111 | ;;; Deftemplate definition for collecting the information regarding OWL restriction
112 | ;;; classes. The restriction classes are not mapped on actual COOL classes, but they
113 | ;;; are used in order to generate dynamically object classification rules.
114 | ;;; ######################################################################################
115 | (deftemplate RESTRICTION
116 | ;the name
117 | (slot name)
118 | ;the owl:onProperty value
119 | (slot onProperty)
120 | ;owl:onClass
121 | (slot onClass)
122 | ;owl:onDataRange
123 | (slot onDataRange)
124 | ;the restriction type (owl:cardinality, owl:someValuesFrom, etc)
125 | (slot restriction)
126 | ;the restriction value
127 | (slot value)
128 | ;potential restriction superclass (currently O-DEVICE ignores
129 | ;superclasses of restriction classes)
130 | (multislot subclass)
131 | ;potential equivalent classes (currently O-DEVICE ignores
132 | ;equivalent classes of restriction classes)
133 | (multislot equivalent)
134 | ;label
135 | (slot label)
136 | ;comment
137 | (slot comment)
138 | )
139 |
140 | ;;; ######################################################################################
141 | ;;; Deftemplate definition for collecting the information regarding OWL properties.
142 | ;;; ######################################################################################
143 | (deftemplate PROPERTY
144 | ;the property name
145 | (slot name)
146 | ;the type of the property (object, datatype, transitive, etc)
147 | (multislot type)
148 | ;the domain classes (rdfs:domain)
149 | (multislot domain)
150 | ;the range classes (rdfs:range)
151 | (multislot range)
152 | ;subproperties (rdfs:subPropertyOf)
153 | (multislot subproperty)
154 | ;equivalent properties (owl:equivalentProperty)
155 | (multislot equivalentProperty)
156 | ;inverse properties (owl:inverseOf)
157 | (multislot inverse)
158 | ;property chains
159 | (multislot propertyChain)
160 | ;label
161 | (slot label)
162 | ;comment
163 | (slot comment)
164 | )
165 |
166 | ;;; ######################################################################################
167 | ;;; Deftemplate definition for collecting the information regarding data ranges
168 | ;;; (owl:DataRange).
169 | ;;; ######################################################################################
170 | (deftemplate DATARANGE
171 | ;the name
172 | (slot name)
173 | ;the values that the data range contains
174 | (multislot oneOf)
175 | )
176 |
177 | ;;; ######################################################################################
178 | ;;; Deftemplate definition for collecting the information regarding disjoint classes
179 | ;;; (owl:AllDisjointClasses)
180 | ;;; ######################################################################################
181 | (deftemplate ALL_DISJOINT_CLASSES
182 | ;the name
183 | (slot name)
184 | ;the classes
185 | (multislot members)
186 | )
187 |
188 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/import.clp:
--------------------------------------------------------------------------------
1 | (defglobal
2 | ?*undef_rules* = (create$)
3 | ?*undef_functions* = (create$)
4 | )
5 |
6 | (deffunction backup-class-def (?class)
7 | (bind $?all-slots (delete-member$ (class-slots ?class) class-refs aliases))
8 | (bind $?slot-defs (create$))
9 | (while (> (length$ $?all-slots) 0)
10 | do
11 | (bind $?slot-types (slot-types ?class (nth$ 1 $?all-slots)))
12 | (if (is-multislot ?class (nth$ 1 $?all-slots))
13 | then
14 | (bind ?slot-field multislot)
15 | else
16 | (bind ?slot-field slot)
17 | )
18 | (bind $?slot-defs (create$ $?slot-defs "(" ?slot-field (nth$ 1 $?all-slots) "(" type $?slot-types ")" ")"))
19 | (bind $?all-slots (rest$ $?all-slots))
20 | )
21 | (assert (redefined-class
22 | (name ?class)
23 | (isa-slot (class-superclasses ?class))
24 | (slot-definitions $?slot-defs)
25 | (class-refs-defaults (slot-default-value ?class class-refs))
26 | (aliases-defaults (slot-default-value ?class aliases))
27 | ))
28 | )
29 |
30 | (deffunction backup-class-hierarchy (?class)
31 | (bind $?classes (create$ ?class (class-subclasses ?class inherit)))
32 | (bind ?end (length$ $?classes))
33 | (loop-for-count (?n 1 ?end)
34 | do
35 | (backup-class-def (nth$ ?n $?classes))
36 | )
37 | )
38 |
39 | (deffunction backup-class (?class)
40 | (bind ?filename (str-cat "backup-class-" (str-replace ?class "-" ":") "-instances.txt"))
41 | (save-instances ?filename visible inherit ?class)
42 | (assert (backup-instances ?filename))
43 | ;(do-for-all-instances ((?x ?class)) TRUE (send ?x delete))
44 | (backup-class-hierarchy ?class)
45 | (assert (class-to-undefine ?class))
46 | ;(undefclass ?class)
47 | )
48 |
49 | (deffunction undefine-classes ()
50 | (bind $?facts (get-template-specific-facts class-to-undefine (get-fact-list)))
51 | (bind ?end (length$ $?facts))
52 | (loop-for-count (?n 1 ?end)
53 | do
54 | (bind ?class (nth$ 1 (fact-slot-value (nth$ ?n $?facts) implied)))
55 | (if (class-existp ?class)
56 | then
57 | (do-for-all-instances ((?x ?class)) TRUE (send ?x delete))
58 | (undefclass ?class)
59 | )
60 | (retract (nth$ ?n $?facts))
61 | )
62 | )
63 |
64 | ;(deffunction undefine-functions ()
65 | ; (bind ?end (length$ ?*undef_functions*))
66 | ; (verbose "Undefining " ?end " functions" crlf)
67 | ; (loop-for-count (?n 1 ?end)
68 | ; do
69 | ; (verbose "Undefining function: " (nth$ ?n ?*undef_functions*) crlf)
70 | ; (undeffunction (nth$ ?n ?*undef_functions*))
71 | ; )
72 | ; TRUE
73 | ;)
74 |
75 | (deffunction undefine-functions ()
76 | (undeffunction load-rdf)
77 | (undeffunction load-namespaces)
78 | (undeffunction load-namespace)
79 | (undeffunction insert-triples)
80 | (undeffunction create-namespaces)
81 | (undeffunction scan_base)
82 | (undeffunction scan_namespaces)
83 | (undeffunction import-resource)
84 | (undeffunction create-aliases)
85 | (undeffunction find-all-super-properties)
86 | (undeffunction resource-make-instance)
87 | )
88 |
89 | (deffunction undefine-rules ()
90 | (bind ?end (length$ ?*undef_rules*))
91 | ;(verbose "Undefining " ?end " rules" crlf)
92 | (loop-for-count (?n 1 ?end)
93 | do
94 | ;(verbose "Undefining rule: " (nth$ ?n ?*undef_rules*) crlf)
95 | (undefrule (nth$ ?n ?*undef_rules*))
96 | )
97 | TRUE
98 | ; (undefrule create-instances-of-existing-classes)
99 | ; (undefrule changing-type-of-existing-instances)
100 | ; (undefrule create-instances-of-multiple-existing-classes)
101 | ; (undefrule create-instances-of-multiple-classes-1)
102 | ; (undefrule create-instances-of-multiple-classes-2)
103 | ; (undefrule put-instance-slots-resources)
104 | ; (undefrule put-instance-slots-literals)
105 | ; (undefrule property-inheritance-domains)
106 | ; (undefrule property-inheritance-ranges)
107 | ; (undefrule property-with-multiple-domains)
108 | ; (undefrule property-with-multiple-ranges)
109 | ; (undefrule create-non-existing-classes_create-candidate-class)
110 | ; (undefrule create-non-existing-classes_create-slots-type-Literal)
111 | ; (undefrule create-non-existing-classes_create-slots-type-Resource)
112 | ; (undefrule create-non-existing-classes_create-slots-type-no-range)
113 | ; (undefrule generate-non-existing-classes_create-create-final-class)
114 | ; (undefrule put-new-properties-no-domain)
115 | ; (undefrule put-new-properties-with-one-domain)
116 | ; (undefrule insert-new-property-no-domain-Literal)
117 | ; (undefrule insert-new-property-no-domain-Resource)
118 | ; (undefrule insert-new-property-no-domain-no-range)
119 | ; (undefrule insert-new-property-one-domain-Literal)
120 | ; (undefrule insert-new-property-one-domain-Resource)
121 | ; (undefrule insert-new-property-one-domain-no-range)
122 | ; (undefrule put-remaining-triples-container-membership-properties)
123 | ; (undefrule put-remaining-triples-properties)
124 | ; (undefrule put-remaining-triples-subjects-with-domain)
125 | ; (undefrule put-remaining-triples-subjects-no-domain)
126 | ; (undefrule put-remaining-triples-subjects-wrong-domain)
127 | ; (undefrule put-remaining-triples-objects-with-range)
128 | ; (undefrule put-remaining-triples-objects-no-range)
129 | ; (undefrule add-extra-superclass)
130 | ; (undefrule insert-extra-superclass)
131 | )
132 |
133 | (deffunction build-undefinitions ()
134 | (bind ?*undef_rules* (create$))
135 | (open (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp") ttt "r")
136 | (bind ?line (readline ttt))
137 | (while (neq ?line EOF)
138 | do
139 | ;(verbose "line: " ?line crlf)
140 | (bind ?pos (str-index defrule ?line))
141 | (if (integerp ?pos)
142 | then
143 | ;(verbose "pos: " ?pos crlf)
144 | (bind ?line (sub-string (+ ?pos 8) (length ?line) ?line))
145 | ;(verbose "new line: " ?line crlf)
146 | (bind ?pos (str-index " " ?line))
147 | ;(verbose "new pos: " ?pos crlf)
148 | (if (integerp ?pos)
149 | then
150 | (bind ?rule (sym-cat (sub-string 1 (- ?pos 1) ?line)))
151 | else
152 | (bind ?rule (sym-cat ?line))
153 | )
154 | ;(verbose "rule: " ?rule crlf)
155 | (bind ?*undef_rules* (create$ ?*undef_rules* ?rule))
156 | )
157 | (bind ?line (readline ttt))
158 | )
159 | (close ttt)
160 | )
161 |
162 | (deffunction import ()
163 | (build-undefinitions)
164 | (set-strategy mea)
165 | ;(bind ?*triple_counter* (length$ (get-template-specific-facts triple (get-fact-list))))
166 | (while (> ?*triple_counter* 0)
167 | do
168 | (bind ?no-of-triples-before (+ ?*triple_counter* 1))
169 | (bind ?no-of-triples-after ?*triple_counter*)
170 | (while (> ?no-of-triples-before ?no-of-triples-after)
171 | do
172 | (bind ?no-of-triples-before ?no-of-triples-after)
173 | (run-goal create-instances)
174 | (run-goal put-slot-values)
175 | (run-goal property-inheritance)
176 | (run-goal multiple-domains-ranges)
177 | (run-goal create-new-classes)
178 | (run-goal generate-new-classes)
179 | (bind ?no-of-triples-after ?*triple_counter*)
180 | )
181 | (run-goal put-new-properties)
182 | (bind ?redef-classes (length$ (get-template-specific-facts redefined-class (get-fact-list))))
183 | (if (> ?redef-classes 0)
184 | then
185 | ;(verbose "After 1st set of rules!" crlf)
186 | ;(undefrule *)
187 | (undefine-rules)
188 | ;(verbose "Undefined rules!" crlf)
189 | (undefine-functions)
190 | ;(verbose "Undefined functions!" crlf)
191 | (if (member$ rdf_classes (get-definstances-list))
192 | then
193 | (undefinstances rdf_classes)
194 | )
195 | ;(verbose "Undefined definstances!" crlf)
196 | (undefine-classes)
197 | ;(verbose "Undefined classes!" crlf)
198 | (load* (str-cat ?*R-DEVICE_PATH* "restore-classes.clp"))
199 | (run-goal restore-classes)
200 | ;(verbose "Before re-loading files" crlf)
201 | (load* (str-cat ?*R-DEVICE_PATH* "load-rdf.clp"))
202 | (load* (str-cat ?*R-DEVICE_PATH* "triple-transformation.clp"))
203 | ;(verbose "After re-loading files" crlf)
204 | (run-goal put-slot-values)
205 | )
206 | (run-goal put-remaining-triples)
207 | )
208 | TRUE
209 | )
210 |
211 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/types.clp:
--------------------------------------------------------------------------------
1 | (deffunction discover-slot-name (?pos $?cond-elem)
2 | (bind ?pos (- ?pos 1))
3 | (while (neq (nth$ ?pos $?cond-elem) "(")
4 | do
5 | (bind ?pos (- ?pos 1))
6 | )
7 | (nth$ (+ ?pos 1) $?cond-elem)
8 | )
9 |
10 | (deffunction discover-type (?var $?condition)
11 | (if (= (length$ $?condition) 0)
12 | then
13 | (create$)
14 | else
15 | (bind ?p2 (get-token $?condition))
16 | (bind $?cond-elem (subseq$ $?condition 1 ?p2))
17 | ;(bind $?rest-cond (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
18 | (if (or
19 | (eq (nth$ 2 $?cond-elem) not)
20 | (eq (nth$ 2 $?cond-elem) test))
21 | then
22 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
23 | else
24 | (if (or
25 | (eq (nth$ 2 $?cond-elem) and)
26 | (eq (nth$ 2 $?cond-elem) or))
27 | then
28 | (bind ?type (discover-type ?var (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1))))
29 | (if (not ?type)
30 | then
31 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
32 | else
33 | ?type
34 | )
35 | else
36 | (if (eq (nth$ 2 $?cond-elem) <-)
37 | then
38 | (bind $?cond-elem (subseq$ $?cond-elem 3 (length$ $?cond-elem)))
39 | else
40 | (if (eq (nth$ 4 $?cond-elem) name)
41 | then
42 | (bind $?cond-elem (delete$ $?cond-elem 3 6))
43 | )
44 | )
45 | (bind ?pos (member$ ?var $?cond-elem))
46 | (if (not ?pos)
47 | then
48 | (discover-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
49 | else
50 | (bind ?slot (discover-slot-name ?pos $?cond-elem))
51 | (if (eq (nth$ 2 $?cond-elem) object)
52 | then
53 | (bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem))
54 | else
55 | (bind ?class (nth$ 2 $?cond-elem))
56 | )
57 | (if (and (class-existp ?class) (slot-existp ?class ?slot))
58 | then
59 | (bind $?slot-types (slot-types ?class ?slot))
60 | (if (eq (nth$ 1 $?slot-types) INSTANCE-NAME)
61 | then
62 | (create$ INSTANCE-NAME (get-type-of ?class ?slot))
63 | else
64 | $?slot-types
65 | )
66 | else
67 | (if (and (eq (sub-string 1 3 ?class) "gen") (eq (sub-string (- (length ?slot) 3) (length ?slot) ?slot) "_obj"))
68 | then
69 | (create$ INSTANCE-NAME USER)
70 | else
71 | (create$)
72 | )
73 | )
74 | )
75 | )
76 | )
77 | )
78 | )
79 |
80 | (deffunction discover-ref-type (?var $?condition)
81 | (if (= (length$ $?condition) 0)
82 | then
83 | (create$)
84 | else
85 | (bind ?p2 (get-token $?condition))
86 | (bind $?cond-elem (subseq$ $?condition 1 ?p2))
87 | ;(bind $?rest-cond (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
88 | (if (or
89 | (eq (nth$ 2 $?cond-elem) not)
90 | (eq (nth$ 2 $?cond-elem) test))
91 | then
92 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
93 | else
94 | (if (or
95 | (eq (nth$ 2 $?cond-elem) and)
96 | (eq (nth$ 2 $?cond-elem) or))
97 | then
98 | (bind $?type (discover-ref-type ?var (subseq$ $?cond-elem 3 (- (length$ $?cond-elem) 1))))
99 | (if (= (length$ $?type) 0)
100 | then
101 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
102 | else
103 | $?type
104 | )
105 | else
106 | (if (or
107 | (and
108 | (eq (nth$ 1 $?cond-elem) ?var)
109 | (eq (nth$ 2 $?cond-elem) <-))
110 | (and
111 | (eq (nth$ 4 $?cond-elem) name)
112 | (eq (nth$ 5 $?cond-elem) ?var)))
113 | then
114 | ;(bind ?class (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem))
115 | (create$ INSTANCE-NAME (nth$ (+ (member$ is-a $?cond-elem) 1) $?cond-elem))
116 | else
117 | (discover-ref-type ?var (subseq$ $?condition (+ ?p2 1) (length$ $?condition)))
118 | )
119 | )
120 | )
121 | )
122 | )
123 |
124 | (deffunction guess-slot-def ($?condition-and-slot)
125 | ;(verbose "guess-slot-def - $?condition-and-slot: " $?condition-and-slot crlf)
126 | (bind $?condition (subseq$ $?condition-and-slot 1 (- (member$ $$$ $?condition-and-slot) 1)))
127 | (bind $?slot (subseq$ $?condition-and-slot (+ (member$ $$$ $?condition-and-slot) 1) (length$ $?condition-and-slot)))
128 | (bind $?value-expr (subseq$ $?slot 3 (- (length$ $?slot) 1)))
129 | (if (= (length$ $?value-expr) 1)
130 | then
131 | (bind ?value (nth$ 1 $?value-expr))
132 | (if (is-singlevar ?value)
133 | then
134 | (bind ?slot-field slot)
135 | else
136 | (if (is-multivar ?value)
137 | then
138 | (bind ?slot-field multislot)
139 | else
140 | (bind ?slot-field slot)
141 | )
142 | )
143 | else
144 | (if (eq (nth$ 1 $?value-expr) "(")
145 | then
146 | (if (and
147 | (is-aggregate-function (nth$ 2 $?value-expr))
148 | (is-var (nth$ 3 $?value-expr)))
149 | then
150 | (bind ?slot-field multislot)
151 | (bind ?value (nth$ 3 $?value-expr))
152 | else
153 | (bind ?slot-field multislot)
154 | (bind ?value (nth$ 2 $?value-expr))
155 | )
156 | )
157 | )
158 | (if (floatp ?value)
159 | then
160 | (bind $?type FLOAT)
161 | (bind $?ref-type (create$))
162 | else
163 | (if (integerp ?value)
164 | then
165 | (bind $?type INTEGER)
166 | (bind $?ref-type (create$))
167 | else
168 | (if (symbolp ?value)
169 | then
170 | (bind $?type SYMBOL)
171 | (bind $?ref-type (create$))
172 | else
173 | (if (is-var ?value)
174 | then
175 | (bind $?type (discover-type ?value $?condition))
176 | (if (= (length$ $?type) 0)
177 | then
178 | (bind $?type (discover-ref-type ?value $?condition))
179 | )
180 | (if (= (length$ $?type) 0)
181 | then
182 | (bind $?type "?VARIABLE")
183 | (bind $?ref-type (create$))
184 | else
185 | (if (eq (nth$ 1 $?type) INSTANCE-NAME)
186 | then
187 | ;(bind ?class (nth$ 2 $?type))
188 | ;(bind ?slot-name (nth$ 2 $?slot))
189 | (bind $?ref-type (create$ (nth$ 2 $?slot) (nth$ 2 $?type)))
190 | (bind $?type INSTANCE-NAME)
191 | else
192 | (bind $?ref-type (create$))
193 | )
194 | )
195 | else
196 | (bind $?type STRING)
197 | (bind $?ref-type (create$))
198 | )
199 | )
200 | )
201 | )
202 | (create$
203 | "(" ?slot-field (nth$ 2 $?slot) "(" type $?type ")" ")"
204 | ;(insert$ (replace$ $?slot 3 3 (create$ "(" type $?type ")")) 2 ?slot-field)
205 | $$$
206 | $?ref-type
207 | )
208 | )
209 |
210 | (deffunction guess-slot-defs ($?condition-and-slots)
211 | (bind $?condition (subseq$ $?condition-and-slots 1 (- (member$ $$$ $?condition-and-slots) 1)))
212 | (bind $?slots (subseq$ $?condition-and-slots (+ (member$ $$$ $?condition-and-slots) 1) (length$ $?condition-and-slots)))
213 | (if (= (length$ $?slots) 0)
214 | then
215 | (create$ $$$)
216 | else
217 | ;(bind ?p1 (member$ "(" $?slots))
218 | ;(bind ?p2 (member$ ")" $?slots))
219 | (bind ?p2 (get-token $?slots))
220 | ;(bind $?slot (subseq$ $?slots (member$ "(" $?slots) ?p2))
221 | (bind $?new-slot-and-ref (guess-slot-def (create$ $?condition $$$ (subseq$ $?slots (member$ "(" $?slots) ?p2))))
222 | ;(bind $?new-slot (subseq$ $?new-slot-and-ref 1 (- (member$ $$$ $?new-slot-and-ref) 1)))
223 | ;(bind $?new-reference-type (subseq$ $?new-slot-and-ref (+ (member$ $$$ $?new-slot-and-ref) 1) (length$ $?new-slot-and-ref)))
224 | ;(bind $?rest-slots (subseq$ $?slots (+ ?p2 1) (length$ $?slots)))
225 | (bind $?new-rest-slots-and-refs (guess-slot-defs (create$ $?condition $$$ (subseq$ $?slots (+ ?p2 1) (length$ $?slots)))))
226 | ;(bind $?new-rest-slots (subseq$ $?new-rest-slots-and-refs 1 (- (member$ $$$ $?new-rest-slots-and-refs) 1)))
227 | ;(bind $?new-rest-reference-types (subseq$ $?new-rest-slots-and-refs (+ (member$ $$$ $?new-rest-slots-and-refs) 1) (length$ $?new-rest-slots-and-refs)))
228 | (create$ (subseq$ $?new-slot-and-ref 1 (- (member$ $$$ $?new-slot-and-ref) 1)) (subseq$ $?new-rest-slots-and-refs 1 (- (member$ $$$ $?new-rest-slots-and-refs) 1)) $$$ (subseq$ $?new-slot-and-ref (+ (member$ $$$ $?new-slot-and-ref) 1) (length$ $?new-slot-and-ref)) (subseq$ $?new-rest-slots-and-refs (+ (member$ $$$ $?new-rest-slots-and-refs) 1) (length$ $?new-rest-slots-and-refs)))
229 | )
230 | )
231 |
232 | (deffunction discover-class-of-var (?class-expr $?condition)
233 | (bind ?pos (member$ ?class-expr $?condition))
234 | (if (integerp ?pos)
235 | then
236 | (if (eq (nth$ (- ?pos 2) $?condition) <-)
237 | then
238 | (bind ?oid (nth$ (- ?pos 3) $?condition))
239 | (if (not (is-var ?oid))
240 | then
241 | (if (instance-existp (symbol-to-instance-name ?oid))
242 | then
243 | (return (class (symbol-to-instance-name ?oid)))
244 | else
245 | (return ?class-expr)
246 | )
247 | else
248 | (bind $?types (discover-type ?oid $?condition))
249 | (if (eq (nth$ 1 $?types) INSTANCE-NAME)
250 | then
251 | (return (nth$ 2 $?types))
252 | else
253 | (return ?class-expr)
254 | )
255 | )
256 | else
257 | (return ?class-expr)
258 | )
259 | else
260 | (return ?class-expr)
261 | )
262 | )
263 |
--------------------------------------------------------------------------------
/clp-pvm/clp/array.clp:
--------------------------------------------------------------------------------
1 | ;class lib and msg handlers for arrays=(values of params) M.Bobak,ANL
2 | ;--------------------------
3 | ;-needs: util.clp
4 | ;--------------------------
5 | ;might have some array stuff accessible through PARAM handlers?
6 | ;lambda-fncs would still be nice (maybe tcl or scheme)-(has array,vect too)
7 | ;output to hdf format for viewing, trans this way?,can do quick mat.calcs
8 |
9 | ;==============================================================ARRAY
10 | (defclass ARRAY
11 | (is-a ACCESSIBLE)
12 | (role concrete)
13 | (pattern-match reactive)
14 | (slot count (type INTEGER) ;number of this type of instance made
15 | (create-accessor read-write) (storage shared))
16 | (slot fresh (default FALSE) ;if the array is newly filled
17 | (create-accessor read-write))
18 | ;----------------------stuff for the array 0 to 3 dim
19 | (slot type (default f) ;type of the array value (i/f/d/s)
20 | (create-accessor read-write) (visibility public))
21 | ; (multislot index (type INTEGER) (create-accessor read-write)) ;max array index
22 | (slot lang (type SYMBOL) (create-accessor read-write)) ;FORTRAN or C
23 | (slot x (type INTEGER) (default 1) ;1st dimension index
24 | (create-accessor read-write) (visibility public))
25 | (slot y (type INTEGER) (default 1) ;2nd dimension index
26 | (create-accessor read-write) (visibility public))
27 | (slot z (type INTEGER) (default 1) ;3rd dimension index
28 | (create-accessor read-write) (visibility public))
29 | (slot num (type INTEGER) (default 1) ;num of elts
30 | (create-accessor read-write) (visibility public))
31 | (slot size (type INTEGER) (default 1) ;num of elements * #bytes/element
32 | (create-accessor read-write) (visibility public)) ;can just calc
33 | (slot val_ptr (type INTEGER) ;long_int to point to value
34 | (create-accessor read-write) (visibility public))
35 | ;----------------------if array a seperate class fill these
36 | ;for viewing & matching, which can be done with (param)arrays
37 | ;w/deamons can get and set val_ptr ed space, and update get/put-time
38 | (slot value ;first value (usually only if 111)
39 | (create-accessor read-write) (visibility public))
40 | (multislot values ;first values (usually only if n11)
41 | (create-accessor read-write) (visibility public))
42 | )
43 | ;-----------------------------------------------------------GET-VALUE
44 | (defmessage-handler ARRAY get-value after () ;for debugging
45 | (printout t "[" (instance-name ?self) " v=" ?self:value "]"))
46 |
47 | (deffunction get-value (?p) ;or (slot-value ?p value)
48 | (if (slot-existp (class ?p) value) then (send ?p get-value)
49 | else (printout t "[WARNING:" ?p " does not have a value slot]")) )
50 | (deffunction gv (?p) (slot-value ?p value))
51 | (deffunction pv (?p ?v) (send ?p put-value ?v))
52 | ;if get rid of value slot have these fncs, then hndlrs too
53 | ;(deffunction get-value (?p) (first (slot-value ?p values)))
54 | ;(deffunction put-value (?p ?val) (replace$ (slot-value ?p values) 1 1 ?val))
55 |
56 | ;-------------------------------------------array INIT after
57 | (defmessage-handler ARRAY init after ()
58 | (printout t ?self ",")
59 | (send ?self incr count)
60 | (bind ?self:num (* ?self:x ?self:y ?self:z))
61 | (bind ?self:size (* ?self:num (typelen ?self:type)))
62 | (if (< ?self:val_ptr 999) then (bind ?self:val_ptr (imalloc ?self:size)))
63 | ; (if (or (and (instancep ?self:global-name) (neq ?self:global-name [nil]))
64 | ; (stringp ?self:global-name)) then
65 | ; (make-instance ?self:global-name of ARRAY
66 | ; (x ?self:x) (y ?self:y) (z ?self:z)
67 | ; (msgtag ?self:msgtag) (val_ptr ?self:val_ptr)))
68 | )
69 |
70 | ;in the end it might not have the same val_ptr/msgtag-for printing
71 |
72 | ;-------------------------------------------(array)MPRINT
73 | (defmessage-handler ARRAY mprint primary () ;for debugging
74 | (ptag (nnn ?self:msgtag)))
75 |
76 | ;-------------------------------------------(array)PUT-INDEX
77 | (defmessage-handler ARRAY put-index ($?indx) ;sets indecies
78 | (bind ?self:x (first-dflt ?indx 1))
79 | (bind ?self:y (second-dflt ?indx 1))
80 | (bind ?self:z (third-dflt ?indx 1)))
81 |
82 | ;=======================================================ARRAY STUFF
83 | ;'arrays' can be from 0 to 3 dimensions, (single= 1 1 1)
84 | ;-------------------------------------------------------Deref Handlers
85 | (defmessage-handler ARRAY deref primary ($?nums)
86 | (if (<> (length$ ?nums) 0) then (funcall deref ?self:type ?self:val_ptr ?nums)
87 | else (deref ?self:type ?self:val_ptr)))
88 | ;-------------------
89 | (defmessage-handler ARRAY deref-off primary (?offset $?nums)
90 | (if (> ?offset ?self:size) then
91 | (printout t "WARNING:offset too large " ?offset crlf) (return nil))
92 | (printout t "[deref-off " ?offset " makes " ?self:val_ptr " into " (+ ?self:val_ptr (* ?offset 4)) "," ?nums "]" crlf)
93 | (if (<> (length$ ?nums) 0)
94 | then (funcall deref ?self:type (+ ?self:val_ptr (* ?offset 4)) ?nums)
95 | else (deref ?self:type (+ ?self:val_ptr (* ?offset 4)))))
96 | ;right now type-size is hard-coded to 4
97 | ;-------------------
98 | (defmessage-handler ARRAY zero-to primary (?n)
99 | (loop-for-count (?i 0 ?self:num) do (send ?self deref-off ?i ?n)))
100 | ;-------------------
101 | (defmessage-handler ARRAY deref-off-n primary (?offset ?n)
102 | (bind ?top (+ ?offset ?n))
103 | (bind ?l (create$ ))
104 | (loop-for-count (?i 0 ?n) do
105 | (printout t "[" (send ?self deref-off (- ?top ?i)) "]")
106 | (insert$ ?l 1 (send ?self deref-off (- ?top ?i))))
107 | ?l)
108 | ;-------------------
109 | (deffunction add2 (?x ?y) (+ ?x ?y))
110 | (deffunction sub2 (?x ?y) (- ?x ?y))
111 | (deffunction div2 (?x ?y) (/ ?x ?y))
112 | (deffunction mul2 (?x ?y) (* ?x ?y))
113 |
114 | ;maybe ?fnc ?outarray $?array where they could be nums or array
115 | ;so array becomes a new wilder m.f.
116 | (defmessage-handler ARRAY deref-fnc2 primary (?fnc ?warray ?outarray $?off-n)
117 | (bind ?offset (first-dflt ?off-n 0))
118 | (bind ?n (second-dflt ?off-n ?self:num))
119 | (bind ?top (+ ?offset ?n))
120 | (loop-for-count (?i ?offset ?top) do
121 | (send ?outarray deref-off ?i
122 | (funcall ?fnc (send ?self deref-off ?i) (send ?warray deref-off ?i)))))
123 |
124 | ;(get-nprcpk of SUBROUTINE
125 | ; (sub "(send [rainc] deref-fnc2 add2 [rainnc] [nprcpk])"))
126 | ;then (call [get-nprcpk]) to calculate it (do this in bats) rain(n)c state-vars
127 | ;-------------------
128 | (defmessage-handler ARRAY check-ptr primary ()
129 | (if (< (nn ?self:val_ptr) 99) then
130 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return TRUE)
131 | else (return FALSE)))
132 |
133 | ;============================-----------------GET/PUT VALUE DEAMONS
134 | ;have a GET-value that does a get-value but gets it from the model 1st
135 | ;have a PUT-value that does a put-value then puts it into the model too
136 | ;--not needed in the same executable, as you are accessing the same space
137 | ;---------------------------------------------
138 | ;could just make value a multislot, or just have/use value, for now
139 | ;if just have values, can have get/put-value just access the 1st one <-*
140 |
141 | ;-------------------------PUT after
142 | (defmessage-handler ARRAY put-value after ($?val)
143 | (if (< (nn ?self:val_ptr) 99) then
144 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
145 | (if (> ?self:num 1) then
146 | (printout t crlf "[WARNING you are overwriting the 1st array element"))
147 | (bind ?self:put-time (elapse-time))
148 | (printout t "[" (instance-name ?self) " put-v " (send ?self deref) "]")
149 | (send ?self deref ?val)) ;what put in value slot, goes in val_ptr space
150 |
151 | (defmessage-handler ARRAY put-values after ($?vals)
152 | (if (< (nn ?self:val_ptr) 99) then
153 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
154 | (bind ?self:put-time (elapse-time))
155 | (send ?self deref ?vals)) ;what put in values slot, goes in val_ptr space
156 |
157 | ;-------------------------GET before
158 | (defmessage-handler ARRAY get-value before ()
159 | (if (< (nn ?self:val_ptr) 99) then
160 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
161 | (bind ?self:value (send ?self deref)) ;get value from val_ptr space, &cache
162 | (printout t "[" (instance-name ?self) " get-v " ?self:value "]")
163 | (bind ?self:get-time (elapse-time)))
164 |
165 | (defmessage-handler ARRAY get-values before ($?n)
166 | (if (< (nn ?self:val_ptr) 99) then
167 | (printout t crlf "[WARNING val_ptr=" ?self:val_ptr "]") (return nil))
168 | (bind ?self:values (send ?self deref-n (first-dflt ?n 1)))
169 | (bind ?self:get-time (elapse-time)))
170 | ;get values from val_ptr space, &cache
171 | ;;;;-------------------------------------------------------------
172 | ;remeber the C deref fnc only takes a ptr & if it gets a number it sets it
173 | ;so to pick another array loc a handler has to recompute the ptr
174 | ;;;;-------------------------------------------------------------
175 | ;/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\-array com code (might change)
176 | ;--------------------------
177 | ;-needs: util.clp & pvm.clp
178 | ;--------------------------
179 | ;=======================================array COMMUNICATION (pvm) packing
180 | ;can send stride to pk_tpn too
181 | ;--------------------------------------------(un)packing using the tpn C fnc
182 | ;write a tpn fnc that takes an offset---------actually just alter the old 1
183 | (defmessage-handler ARRAY pack-it primary ($?n-off) ;then stride & binary-flag
184 | (bind ?n (first-dflt ?n-off ?self:num))
185 | (bind ?off (second-dflt ?n-off 0))
186 | (bind ?stride (third-dflt ?n-off 1))
187 | (pk_tpn ?self:type ?self:val_ptr ?n ?off ?stride)
188 | (send ?self get-value))
189 |
190 | (defmessage-handler ARRAY upack-it primary ($?n-off)
191 | (bind ?n (first-dflt ?n-off ?self:num))
192 | (bind ?off (second-dflt ?n-off 0))
193 | (bind ?stride (third-dflt ?n-off 1))
194 | (pk_tpn (upcase ?self:type) ?self:val_ptr ?n ?off ?stride)
195 | ;(send ?self mprint) ;to have the FORTRAN model print out the arrays
196 | (make-fresh ?self)
197 | (send ?self get-value))
198 | ;--------------------------------------------(un)packing using the pvm_(u)pkbyte
199 | (defmessage-handler ARRAY pack-byte primary ($?s)
200 | (bind ?s (first-dflt ?s ?self:size))
201 | (printout t "[pack-byte " ?self:val_ptr ", " ?s "]")
202 | (pkbyte ?self:val_ptr ?s)
203 | (send ?self get-value))
204 |
205 | (defmessage-handler ARRAY upack-byte primary ($?s)
206 | (bind ?s (first-dflt ?s ?self:size))
207 | ;a version of unpkbyte that takes a ptr rather than returning 1
208 | (printout t "[upkbyte " ?self:val_ptr " " ?s " " ?self:size "]")
209 | (upkbyte ?self:val_ptr ?s)
210 | (make-fresh ?self)
211 | (send ?self get-value))
212 | ;--------------------------------------------------------------------
213 | ;think about making array's xyz write-once (unless want to realloc)
214 | ; but would be better to just make a new one and transfer the data
215 | ;;;;-------------------------------------------------------------EOF
216 |
--------------------------------------------------------------------------------
/csd.auth.gr/R-DEVICE/test/dc.rdf:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | Dublin Core Metadata Element Set, Version 1.1: Reference Description
5 |
6 |
7 | The Dublin Core Element Set v1.1 namespace providing access to it's content by means of an RDF Schema
8 | The Dublin Core Metadata Initiative
9 | The Dublin Core Element Set v1.1 namespace provides URIs for the Dublin Core Elements v1.1. Entries are declared using RDF Schema language to support RDF applications.
10 | English
11 | 1999-07-02
12 | 2002-05-22
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 | Title
21 | A name given to the resource.
22 | Typically, a Title will be a name by which the resource is formally known.
23 |
24 | 1999-07-02
25 |
26 |
27 | Contributor
28 | An entity responsible for making contributions to the content of the resource.
29 | Examples of a Contributor include a person, an organisation, or a service. Typically, the name of a Contributor should be used to indicate the entity.
30 |
31 | 1999-07-02
32 |
33 |
34 | Creator
35 | An entity primarily responsible for making the content of the resource.
36 | Examples of a Creator include a person, an organisation, or a service. Typically, the name of a Creator should be used to indicate the entity.
37 |
38 | 1999-07-02
39 |
40 |
41 | Publisher
42 | An entity responsible for making the resource available.
43 | Examples of a Publisher include a person, an organisation, or a service. Typically, the name of a Publisher should be used to indicate the entity.
44 |
45 | 1999-07-02
46 |
47 |
48 | Subject and Keywords
49 | The topic of the content of the resource.
50 |
51 | Typically, a Subject will be expressed as keywords, key phrases or classification codes that describe a topic of the resource. Recommended best practice is to select a value from a controlled vocabulary or formal classification scheme.
52 |
53 | 1999-07-02
54 |
55 |
56 | Description
57 | An account of the content of the resource.
58 | Description may include but is not limited to: an abstract, table of contents, reference to a graphical representation of content or a free-text account of the content.
59 |
60 | 1999-07-02
61 |
62 |
63 | Date
64 | A date associated with an event in the life cycle of the resource.
65 | Typically, Date will be associated with the creation or availability of the resource. Recommended best practice for encoding the date value is defined in a profile of ISO 8601 [W3CDTF] and follows the YYYY-MM-DD format.
66 |
67 | 1999-07-02
68 |
69 |
70 | Resource Type
71 | The nature or genre of the content of the resource.
72 | Type includes terms describing general categories, functions, genres, or aggregation levels for content. Recommended best practice is to select a value from a controlled vocabulary (for example, the list of Dublin Core Types). To describe the physical or digital manifestation of the resource, use the FORMAT element.
73 |
74 |
75 | 1999-07-02
76 |
77 |
78 | Format
79 | The physical or digital manifestation of the
80 | resource.
81 | Typically, Format may include the media-type or dimensions of the resource. Format may be used to determine the software, hardware or other equipment needed to display or operate the resource. Examples of dimensions include size and duration. Recommended best practice is to select a value from a controlled vocabulary (for example, the list of Internet Media Types defining computer media formats).
82 |
83 | 1999-07-02
84 |
85 |
86 | Resource Identifier
87 | An unambiguous reference to the resource within a given context.
88 | Recommended best practice is to identify the resource by means of a string or number conforming to a formal identification system. Example formal identification systems include the Uniform Resource Identifier (URI) (including the Uniform Resource Locator (URL)), the Digital Object Identifier (DOI) and the International Standard Book Number (ISBN).
89 |
90 | 1999-07-02
91 |
92 |
93 | Language
94 | A language of the intellectual content of the resource.
95 | Recommended best practice is to use RFC 3066 [RFC30 66], which, in conjunction with ISO 639 [ISO639], defines two- and three-letter primary language tags with optional subtags. Examples include "en" or "eng" for English, "akk" for Akkadian, and "en-GB" for English used in the United Kingdom.
96 |
97 | 1999-07-02
98 | 2001-05-21
99 |
100 |
101 |
102 | Relation
103 | A reference to a related resource.
104 | Recommended best practice is to reference the resource by means of a string or number conforming to a formal identification system.
105 |
106 | 1999-07-02
107 |
108 |
109 | Source
110 | A Reference to a resource from which the present resource is derived.
111 | The present resource may be derived from the Source resource in whole or in part. Recommended best practice is to reference the resource by means of a string or number conforming to a formal identification system.
112 |
113 | 1999-07-02
114 |
115 |
116 | Coverage
117 | The extent or scope of the content of the resource.
118 | Coverage will typically include spatial location (a place name or geographic coordinates), temporal period (a period label, date, or date range) or jurisdiction (such as a named administrative entity). Recommended best practice is to select a value from a controlled vocabulary (for example, the Thesaurus of Geographic Names [TGN]) and that, where appropriate, named places or time periods be used in preference to numeric identifiers such as sets of coordinates or date ranges.
119 |
120 | 1999-07-02
121 |
122 |
123 | Rights Management
124 | Information about rights held in and over the resource.
125 | Typically, a Rights element will contain a rights management statement for the resource, or reference a service providing such information. Rights information often encompasses Intellectual Property Rights (IPR), Copyright, and various Property Rights. If the Rights element is absent, no assumptions can be made about the status of these and other rights with respect to the resource.
126 |
127 | 1999-07-02
128 |
129 |
130 |
--------------------------------------------------------------------------------